diff -Nru coq-doc-8.6/boot/dune coq-doc-8.15.0/boot/dune --- coq-doc-8.6/boot/dune 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/boot/dune 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,9 @@ +; This library must have no dependencies except config, as it is a +; dependency for most Coq command line tools. +(library + (name boot) + (public_name coq-core.boot) + (synopsis "Coq Enviroment and Paths facilities") + ; until ocaml/dune#4892 fixed + ; (private_modules util) + (libraries coq-core.config)) diff -Nru coq-doc-8.6/boot/env.ml coq-doc-8.15.0/boot/env.ml --- coq-doc-8.6/boot/env.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/boot/env.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,95 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* + let prelude = "theories/Init/Prelude.vo" in + Util.check_file_else + ~dir:Coq_config.coqlibsuffix + ~file:prelude + (fun () -> + if Sys.file_exists (Filename.concat Coq_config.coqlib prelude) + then Coq_config.coqlib + else fail ())) + +(* Build layout uses coqlib = coqcorelib *) +let guess_coqcorelib lib = + if Sys.file_exists (Path.relative lib "plugins") + then lib + else Path.relative lib "../coq-core" + +(* Should we fail on double initialization? That seems a way to avoid + mis-use for example when we pass command line arguments *) +let init () = + let lib = guess_coqlib () in + let core = Util.getenv_else "COQCORELIB" + (fun () -> guess_coqcorelib lib) in + { core ; lib } + +let init () = + let { core; lib } = init () in + (* debug *) + if false then Format.eprintf "core = %s@\n lib = %s@\n%!" core lib; + { core; lib } + +let env_ref = ref None + +let init () = + match !env_ref with + | None -> + let env = init () in + env_ref := Some env; env + | Some env -> env + +let set_coqlib lib = + let env = { lib; core = guess_coqcorelib lib } in + env_ref := Some env + +let coqlib { lib; _ } = lib +let corelib { core; _ } = core +let plugins { core; _ } = Path.relative core "plugins" +let stdlib { lib; _ } = Path.relative lib "theories" +let user_contrib { lib; _ } = Path.relative lib "user-contrib" +let tool { core; _ } tool = Path.(relative (relative core "tools") tool) +let revision { core; _ } = Path.relative core "revision" + +let native_cmi { core; _ } lib = + let install_path = Path.relative core lib in + if Sys.file_exists install_path then + install_path + else + (* Dune build layout, we need to improve this *) + let obj_dir = Format.asprintf ".%s.objs" lib in + Filename.(concat (concat (concat core lib) obj_dir) "byte") diff -Nru coq-doc-8.6/boot/env.mli coq-doc-8.15.0/boot/env.mli --- coq-doc-8.6/boot/env.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/boot/env.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,107 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* string -> t + + (** We should gradually add some more functions to handle common dirs + here such the theories directories or share files. Abstracting it + hereere does allow to use system-specific functionalities *) + + (** [exists file] checks if [file] exists *) + val exists : t -> bool + + (** String representation *) + val to_string : t -> string + +end + +(** Coq runtime enviroment, including location of Coq's stdlib *) +type t + +(** [init ()] will initialize the Coq environment. *) +val init : unit -> t + +(** [stdlib directory] *) +val stdlib : t -> Path.t + +(** [plugins directory] *) +val plugins : t -> Path.t + +(** [user contrib directory] *) +val user_contrib : t -> Path.t + +(** [tool-specific directory] *) +val tool : t -> string -> Path.t + +(** .cmi files needed for native compilation *) +val native_cmi : t -> string -> Path.t + +(** The location of the revision file *) +val revision : t -> Path.t + +(** coq-core/lib directory, not sure if to keep this *) +val corelib : t -> Path.t + +(** coq/lib directory, not sure if to keep this *) +val coqlib : t -> Path.t + +(** Internal, should be set automatically by passing cmdline args to + init; note that this will set both [coqlib] and [corelib] for now. *) +val set_coqlib : string -> unit diff -Nru coq-doc-8.6/boot/path.ml coq-doc-8.15.0/boot/path.ml --- coq-doc-8.6/boot/path.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/boot/path.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,12 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* Some(name,value)) + with _ -> None + +let with_ic file f = + let ic = open_in file in + try + let rc = f ic in + close_in ic; + rc + with e -> close_in ic; raise e + +let getenv_from_file name = + let base = Filename.dirname Sys.executable_name in + try + with_ic (base ^ "/coq_environment.txt") (fun ic -> + let rec find () = + let l = input_line ic in + match parse_env_line l with + | Some(n,v) when n = name -> v + | _ -> find () + in + find ()) + with + | Sys_error s -> raise Not_found + | End_of_file -> raise Not_found + + +let system_getenv name = + try Sys.getenv name with Not_found -> getenv_from_file name + +let getenv_else s dft = try system_getenv s with Not_found -> dft () + +(** Add a local installation suffix (unless the suffix is itself + absolute in which case the prefix does not matter) *) +let use_suffix prefix suffix = + if String.length suffix > 0 && suffix.[0] = '/' + then suffix + else Filename.concat prefix suffix + +let canonical_path_name p = + let current = Sys.getcwd () in + try + Sys.chdir p; + let p' = Sys.getcwd () in + Sys.chdir current; + p' + with Sys_error _ -> + (* We give up to find a canonical name and just simplify it... *) + Filename.concat current p + +let coqbin = + canonical_path_name (Filename.dirname Sys.executable_name) + +(** The following only makes sense when executables are running from + source tree (e.g. during build or in local mode). *) +let coqroot = + Filename.dirname coqbin + +(** [check_file_else ~dir ~file oth] checks if [file] exists in + the installation directory [dir] given relatively to [coqroot], + which maybe has been relocated. + If the check fails, then [oth ()] is evaluated. + Using file system equality seems well enough for this heuristic *) +let check_file_else ~dir ~file oth = + let path = use_suffix coqroot dir in + if Sys.file_exists (Filename.concat path file) then path else oth () diff -Nru coq-doc-8.6/CHANGES coq-doc-8.15.0/CHANGES --- coq-doc-8.6/CHANGES 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/CHANGES 1970-01-01 00:00:00.000000000 +0000 @@ -1,3267 +0,0 @@ -Changes from V8.6beta1 to V8.6 -============================== - -Kernel - -- Fixed critical bug #5248 in VM long multiplication on 32-bit - architectures. Was there only since 8.6beta1, so no stable release impacted. - -Other bug fixes in universes, type class shelving,... - -Changes from V8.5 to V8.6beta1 -============================== - -Kernel - -- A new, faster state-of-the-art universe constraint checker. - -Specification language - -- Giving implicit arguments explicitly to a constant with multiple - choices of implicit arguments does not break any more insertion of - further maximal implicit arguments. -- Ability to put any pattern in binders, prefixed by quote, e.g. - "fun '(a,b) => ...", "λ '(a,(b,c)), ...", "Definition foo '(x,y) := ...". - It expands into a "let 'pattern := ..." - -Tactics - -- Flag "Bracketing Last Introduction Pattern" is now on by default. -- Flag "Regular Subst Tactic" is now on by default: it respects the - initial order of hypothesis, it contracts cycles, it unfolds no - local definitions (common source of incompatibilities, fixable by - "Unset Regular Subst Tactic"). -- New flag "Refolding Reduction", now disabled by default, which turns - on refolding of constants/fixpoints (as in cbn) during the reductions - done during type inference and tactic retyping. Can be extremely - expensive. When set off, this recovers the 8.4 behaviour of unification - and type inference. Potential source of incompatibility with 8.5 developments - (the option is set on in Compat/Coq85.v). -- New flag "Shrink Abstract" that minimalizes proofs generated by the abstract - tactical w.r.t. variables appearing in the body of the proof. - On by default and deprecated. Minor source of incompatibility - for code relying on the precise arguments of abstracted proofs. -- Serious bugs are fixed in tactic "double induction" (source of - incompatibilities as soon as the inductive types have dependencies in - the type of their constructors; "double induction" remains however - deprecated). -- In introduction patterns of the form (pat1,...,patn), n should match - the exact number of hypotheses introduced (except for local definitions - for which pattern can be omitted, as in regular pattern-matching). -- Tactic scopes in Ltac like constr: and ltac: now require parentheses around - their argument. -- Every generic argument type declares a tactic scope of the form "name:(...)" - where name is the name of the argument. This generalizes the constr: and ltac: - instances. -- When in strict mode (i.e. in a Ltac definition), if the "intro" tactic is - given a free identifier, it is not bound in subsequent tactics anymore. - In order to introduce a binding, use e.g. the "fresh" primitive instead - (potential source of incompatibilities). -- New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac. -- New goal selectors. Sets of goals can be selected by listing integers - ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24. -- For uniformity with "destruct"/"induction" and for a more natural - behavior, "injection" can now work in place by activating option - "Structural Injection". In this case, hypotheses are also put in the - context in the natural left-to-right order and the hypothesis on - which injection applies is cleared. -- Tactic "contradiction" (hence "easy") now also solve goals with - hypotheses of the form "~True" or "t<>t" (possible source of - incompatibilities because of more successes in automation, but - generally a more intuitive strategy). -- Option "Injection On Proofs" was renamed "Keep Proof Equalities". When - enabled, injection and inversion do not drop equalities between objects - in Prop. Still disabled by default. -- New tactics "notypeclasses refine" and "simple notypeclasses refine" that - disallow typeclass resolution when typechecking their argument, for use - in typeclass hints. -- Integration of LtacProf, a profiler for Ltac. -- Reduction tactics now accept more fine-grained flags: iota is now a shorthand - for the new flags match, fix and cofix. -- The ssreflect subterm selection algorithm is now accessible to tactic writers - through the ssrmatching plugin. -- When used as an argument of an ltac function, "auto" without "with" - nor "using" clause now correctly uses only the core hint database by - default. - -Hints - -- Revised the syntax of [Hint Cut] to follow standard notation for regexps. -- Hint Mode now accepts "!" which means that the mode matches only if the - argument's head is not an evar (it goes under applications, casts, and - scrutinees of matches and projections). -- Hints can now take an optional user-given pattern, used only by - [typeclasses eauto] with the [Filtered Unification] option on. - -Typeclasses - -- Many new options and new engine based on the proof monad. The - [typeclasses eauto] tactic is now a multi-goal, multi-success tactic. - See reference manual for more information. It is planned to - replace auto and eauto in the following version. The 8.5 resolution - engine is still available to help solve compatibility issues. - -Program - -- The "Shrink Obligations" flag now applies to all obligations, not only - those solved by the automatic tactic. -- "Shrink Obligations" is on by default and deprecated. Minor source of - incompatibility for code relying on the precise arguments of - obligations. - -Notations - -- "Bind Scope" can once again bind "Funclass" and "Sortclass". - -General infrastructure - -- New configurable warning system which can be controlled with the vernacular - command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In - particular, the default is now that warnings are printed by coqc. -- In asynchronous mode, Coq is now capable of recovering from errors and - continue processing the document. - -Tools - -- coqc accepts a -o option to specify the output file name -- coqtop accepts --print-version to print Coq and OCaml versions in - easy to parse format -- Setting [Printing Dependent Evars Line] can be unset to disable the - computation associated with printing the "dependent evars: " line in - -emacs mode -- Removed the -verbose-compat-notations flag and the corresponding Set - Verbose Compat vernacular, since these warnings can now be silenced or - turned into errors using "-w". - -XML protocol - -- message format has changed, see dev/doc/changes.txt for more details. - -Many bug fixes, minor changes and documentation improvements are not mentioned -here. - -Changes from V8.5pl2 to V8.5pl3 -=============================== - -Critical bugfix - -- #4876: Guard checker incompleteness when using primitive projections - -Other bugfixes - -- #4780: Induction with universe polymorphism on was creating ill-typed terms. -- #4673: regression in setoid_rewrite, unfolding let-ins for type unification. -- #4754: Regression in setoid_rewrite, allow postponed unification problems to remain. -- #4769: Anomaly with universe polymorphic schemes defined inside sections. -- #3886: Program: duplicate obligations of mutual fixpoints. -- #4994: Documentation typo. -- #5008: Use the "md5" command on OpenBSD. -- #5007: Do not assume the "TERM" environment variable is always set. -- #4606: Output a break before a list only if there was an empty line. -- #5001: metas not cleaned properly in clenv_refine_in. -- #2336: incorrect glob data for module symbols (bug #2336). -- #4832: Remove extraneous dot in error message. -- Anomaly in printing a unification error message. -- #4947: Options which take string arguments are not backwards compatible. -- #4156: micromega cache files are now hidden files. -- #4871: interrupting par:abstract kills coqtop. -- #5043: [Admitted] lemmas pick up section variables. -- Fix name of internal refine ("simple refine"). -- #5062: probably a typo in Strict Proofs mode. -- #5065: Anomaly: Not a proof by induction. -- Restore native compiler optimizations, they were disabled since 8.5! -- #5077: failure on typing a fixpoint with evars in its type. -- Fix recursive notation bug. -- #5095: non relevant too strict test in let-in abstraction. -- Ensuring that the evar name is preserved by "rename". -- #4887: confusion between using and with in documentation of firstorder. -- Bug in subst with let-ins. -- #4762: eauto weaker than auto. -- Remove if_then_else (was buggy). Use tryif instead. -- #4970: confusion between special "{" and non special "{{" in notations. -- #4529: primitive projections unfolding. -- #4416: Incorrect "Error: Incorrect number of goals". -- #4863: abstract in typeclass hint fails. -- #5123: unshelve can impact typeclass resolution -- Fix a collision about the meta-variable ".." in recursive notations. -- Fix printing of info_auto. -- #3209: Not_found due to an occur-check cycle. -- #5097: status of evars refined by "clear" in ltac: closed wrt evars. -- #5150: Missing dependency of the test-suite subsystems in prerequisite. -- Fix a bug in error printing of unif constraints -- #3941: Do not stop propagation of signals when Coq is busy. -- #4822: Incorrect assertion in cbn. -- #3479 parsing of "{" and "}" when a keyword starts with "{" or "}". -- #5127: Memory corruption with the VM. -- #5102: bullets parsing broken by calls to parse_entry. - -Various documentation improvements - - -Changes from V8.5pl1 to V8.5pl2 -=============================== - -Critical bugfix -- Checksums of .vo files dependencies were not correctly checked. -- Unicode-to-ASCII translation was not injective, leading in a soundness bug in - the native compiler. - -Other bugfixes - -- #4097: more efficient occur-check in presence of primitive projections -- #4398: type_scope used consistently in "match goal". -- #4450: eauto does not work with polymorphic lemmas -- #4677: fix alpha-conversion in notations needing eta-expansion. -- Fully preserve initial order of hypotheses in "Regular Subst Tactic" mode. -- #4644: a regression in unification. -- #4725: Function (Error: Conversion test raised an anomaly) and Program - (Error: Cannot infer this placeholder of type) -- #4747: Problem building Coq 8.5pl1 with OCaml 4.03.0: Fatal warnings -- #4752: CoqIDE crash on files not ended by ".v". -- #4777: printing inefficiency with implicit arguments -- #4818: "Admitted" fails due to undefined universe anomaly after calling - "destruct" -- #4823: remote counter: avoid thread race on sockets -- #4841: -verbose flag changed semantics in 8.5, is much harder to use -- #4851: [nsatz] cannot handle duplicated hypotheses -- #4858: Anomaly: Uncaught exception Failure("hd"). Please report. in variant - of nsatz -- #4880: [nsatz_compute] generates invalid certificates if given redundant - hypotheses -- #4881: synchronizing "Declare Implicit Tactic" with backtrack. -- #4882: anomaly with Declare Implicit Tactic on hole of type with evars -- Fix use of "Declare Implicit Tactic" in refine. - triggered by CoqIDE -- #4069, #4718: congruence fails when universes are involved. - -Universes -- Disallow silently dropping universe instances applied to variables - (forward compatible) -- Allow explicit universe instances on notations, when they can apply - to the head reference of their expansion. - -Build infrastructure -- New update on how to find camlp5 binary and library at configure time. - -Changes from V8.5 to V8.5pl1 -============================ - -Critical bugfix -- The subterm relation for the guard condition was incorrectly defined on - primitive projections (#4588) - -Plugin development tools -- add a .merlin target to the makefile - -Various performance improvements (time, space used by .vo files) - -Other bugfixes - -- Fix order of arguments to Big.compare_case in ExtrOcamlZBigInt.v -- Added compatibility coercions from Specif.v which were present in Coq 8.4. -- Fixing a source of inefficiency and an artificial dependency in the printer in the congruence tactic. -- Allow to unset the refinement mode of Instance in ML -- Fixing an incorrect use of prod_appvect on a term which was not a product in setoid_rewrite. -- Add -compat 8.4 econstructor tactics, and tests -- Add compatibility Nonrecursive Elimination Schemes -- Fixing the "No applicable tactic" non informative error message regression on apply. -- Univs: fix get_current_context (bug #4603, part I) -- Fix a bug in Program coercion code -- Fix handling of arity of definitional classes. -- #4630: Some tactics are 20x slower in 8.5 than 8.4. -- #4627: records with no declared arity can be template polymorphic. -- #4623: set tactic too weak with universes (regression) -- Fix incorrect behavior of CS resolution -- #4591: Uncaught exception in directory browsing. -- CoqIDE is more resilient to initialization errors. -- #4614: "Fully check the document" is uninterruptable. -- Try eta-expansion of records only on non-recursive ones -- Fix bug when a sort is ascribed to a Record -- Primitive projections: protect kernel from erroneous definitions. -- Fixed bug #4533 with previous Keyed Unification commit -- Win: kill unreliable hence do not waitpid after kill -9 (Close #4369) -- Fix strategy of Keyed Unification -- #4608: Anomaly "output_value: abstract value (outside heap)". -- #4607: do not read native code files if native compiler was disabled. -- #4105: poor escaping in the protocol between CoqIDE and coqtop. -- #4596: [rewrite] broke in the past few weeks. -- #4533 (partial): respect declared global transparency of projections in unification.ml -- #4544: Backtrack on using full betaiota reduction during keyed unification. -- #4540: CoqIDE bottom progress bar does not update. -- Fix regression from 8.4 in reflexivity -- #4580: [Set Refine Instance Mode] also used for Program Instance. -- #4582: cannot override notation [ x ]. MAY CREATE INCOMPATIBILITIES, see #4683. -- STM: Print/Extraction have to be skipped if -quick -- #4542: CoqIDE: STOP button also stops workers -- STM: classify some variants of Instance as regular `Fork nodes. -- #4574: Anomaly: Uncaught exception Invalid_argument("splay_arity"). -- Do not give a name to anonymous evars anymore. See bug #4547. -- STM: always stock in vio files the first node (state) of a proof -- STM: not delegate proofs that contain Vernac(Module|Require|Import), #4530 -- Don't fail fatally if PATH is not set. -- #4537: Coq 8.5 is slower in typeclass resolution. -- #4522: Incorrect "Warning..." on windows. -- #4373: coqdep does not know about .vio files. -- #3826: "Incompatible module types" is uninformative. -- #4495: Failed assertion in metasyntax.ml. -- #4511: evar tactic can create non-typed evars. -- #4503: mixing universe polymorphic and monomorphic variables and definitions in sections is unsupported. -- #4519: oops, global shadowed local universe level bindings. -- #4506: Anomaly: File "pretyping/indrec.ml", line 169, characters 14-20: Assertion failed. -- #4548: Coqide crashes when going back one command - -Changes from V8.5beta3 to V8.5 -============================== - -Tools - -- Flag "-compat 8.4" now loads Coq.Compat.Coq84. The standard way of - putting Coq in v8.4 compatibility mode is to pass the command line flag - "-compat 8.4". It can be followed by "-require Coq.Compat.AdmitAxiom" - if the 8.4 behavior of admit is needed, in which case it uses an axiom. - -Specification language - -- Syntax "$(tactic)$" changed to "ltac:(tactic)". - -Tactics - -- Syntax "destruct !hyp" changed to "destruct (hyp)", and similarly - for induction (rare source of incompatibilities easily solvable by - removing parentheses around "hyp" when not for the purpose of keeping - the hypothesis). -- Syntax "p/c" for on-the-fly application of a lemma c before - introducing along pattern p changed to p%c1..%cn. The feature and - syntax are in experimental stage. -- "Proof using" does not clear unused section variables. -- Tactic "refine" has been changed back to the 8.4 behavior of shelving subgoals - that occur in other subgoals. The "refine" tactic of 8.5beta3 has been - renamed "simple refine"; it does not shelve any subgoal. -- New tactical "unshelve tac" which grab existential variables put on - the tactic shelve by the execution of "tac". - -Changes from V8.5beta2 to V8.5beta3 -=================================== - -Vernacular commands - -- New command "Redirect" to redirect the output of a command to a file. -- New command "Undelimit Scope" to remove the delimiter of a scope. -- New option "Strict Universe Declaration", set by default. It enforces the - declaration of all polymorphic universes appearing in a definition when - introducing it. -- New command "Show id" to show goal named id. -- Option "Virtual Machine" removed. - -Tactics - -- New flag "Regular Subst Tactic" which fixes "subst" in situations where - it failed to substitute all substitutable equations or failed to simplify - cycles, or accidentally unfolded local definitions (flag is off by default). -- New flag "Loose Hint Behavior" to handle hints loaded but not imported in a - special way. It accepts three distinct flags: - * "Lax", which is the default one, sets the old behavior, i.e. a non-imported - hint behaves the same as an imported one. - * "Warn" outputs a warning when a non-imported hint is used. Note that this is - an over-approximation, because a hint may be triggered by an eauto run that - will eventually fail and backtrack. - * "Strict" changes the behavior of an unloaded hint to the one of the fail - tactic, allowing to emulate the hopefully future import-scoped hint mechanism. -- New compatibility flag "Universal Lemma Under Conjunction" which - let tactics working under conjunctions apply sublemmas of the form - "forall A, ... -> A". -- New compatibility flag "Bracketing Last Introduction Pattern" which can be - set so that the last disjunctive-conjunctive introduction pattern given to - "intros" automatically complete the introduction of its subcomponents, as the - the disjunctive-conjunctive introduction patterns in non-terminal position - already do. -- New flag "Shrink Abstract" that minimalizes proofs generated by the abstract - tactical w.r.t. variables appearing in the body of the proof. - -Program - -- The "Shrink Obligations" flag now applies to all obligations, not only those -solved by the automatic tactic. -- Importing Program no longer overrides the "exists" tactic (potential source - of incompatibilities). -- Hints costs are now correctly taken into account (potential source of - incompatibilities). -- Documented the Hint Cut command that allows control of the - proof-search during typeclass resolution (see reference manual). - -API - -- Some functions from pretyping/typing.ml and their derivatives were potential - source of evarmap leaks, as they dropped their resulting evarmap. The - situation was clarified by renaming them according to a unsafe_* scheme. Their - sound variant is likewise renamed to their old name. The following renamings - were made. - * Typing.type_of -> unsafe_type_of - * Typing.e_type_of -> type_of - * A new e_type_of function that matches the e_ prefix policy - * Tacmach.pf_type_of -> pf_unsafe_type_of - * A new safe pf_type_of function. - All uses of unsafe_* functions should be eventually eliminated. - -Tools - -- Added an option -w to control the output of coqtop warnings. -- Configure now takes an optional -native-compiler (yes|no) flag replacing - -no-native-compiler. The new flag is set to no by default under Windows. -- Flag -no-native-compiler was removed and became the default for coqc. If - precompilation of files for native conversion test is desired, use - -native-compiler. -- The -compile command-line option now takes the full path of the considered - file, including the ".v" extension, and outputs a warning if such an extension - is lacking. -- The -require and -load-vernac-object command-line options now take a logical - path of a given library rather than a physical path, thus they behave like - Require [Import] path. -- The -vm command-line option has been removed. - -Standard Library - - - There is now a Coq.Compat.Coq84 library, which sets the various compatibility - options and does a few redefinitions to make Coq behave more like Coq v8.4. - The standard way of putting Coq in v8.4 compatibility mode is to pass the command - line flags "-require Coq.Compat.Coq84 -compat 8.4". - -Changes from V8.5beta1 to V8.5beta2 -=================================== - -Logic - -- The VM now supports inductive types with up to 8388851 non-constant - constructors and up to 8388607 constant ones. - -Specification language - -- Syntax "$(tactic)$" changed to "ltac: tactic". - -Tactics - -- A script using the admit tactic can no longer be concluded by either - Qed or Defined. In the first case, Admitted can be used instead. In - the second case, a subproof should be used. -- The easy tactic and the now tactical now have a more predictable - behavior, but they might now discharge some previously unsolved goals. - -Extraction - -- Definitions extracted to Haskell GHC should no longer randomly - segfault when some Coq types cannot be represented by Haskell types. -- Definitions can now be extracted to Json for post-processing. - -Tools - -- Option -I -as has been removed, and option -R -as has been - deprecated. In both cases, option -R can be used instead. -- coq_makefile now generates double-colon rules for rules such as clean. - -API - -- The interface of [change] has changed to take a [change_arg], which - can be built from a [constr] using [make_change_arg]. - -Changes from V8.4 to V8.5beta1 -============================== - -Logic - -- Primitive projections for records allow for a compact representation - of projections, without parameters and avoid the behavior of defined - projections that can unfold to a case expression. To turn the use of - native projections on, use [Set Primitive Projections]. Record, - Class and Structure types defined while this option is set will be - defined with primitive projections instead of the usual encoding as - a case expression. For compatibility, when p is a primitive - projection, @p can be used to refer to the projection with explicit - parameters, i.e. [@p] is definitionally equal to [λ params r. r.(p)]. - Records with primitive projections have eta-conversion, the - canonical form being [mkR pars (p1 t) ... (pn t)]. -- New universe polymorphism (see reference manual) -- New option -type-in-type to collapse the universe hierarchy (this makes the - logic inconsistent). -- The guard condition for fixpoints is now a bit stricter. Propagation - of subterm value through pattern matching is restricted according to - the return predicate. Restores compatibility of Coq's logic with the - propositional extensionality axiom. May create incompatibilities in - recursive programs heavily using dependent types. -- Trivial inductive types are no longer defined in Type but in Prop, which - leads to a non-dependent induction principle being generated in place of - the dependent one. To recover the old behavior, explicitly define your - inductive types in Set. - -Vernacular commands - -- A command "Variant" allows to define non-recursive variant types. -- The command "Record foo ..." does not generate induction principles - (foo_rect, foo_rec, foo_ind) anymore by default (feature wish - #2693). The command "Variant foo ..." does not either. A flag - "Set/Unset Nonrecursive Elimination Schemes" allows changing this. - The tactic "induction" on a "Record" or a "Variant" is now actually - doing "destruct". -- The "Open Scope" command can now be given also a delimiter (e.g. Z). -- The "Definition" command now allows the "Local" modifier, allowing - for non-importable definitions. The same goes for "Axiom" and "Parameter". -- Section-specific commands such as "Let" (resp. "Variable", "Hypothesis") used - out of a section now behave like the corresponding "Local" command, i.e. - "Local Definition" (resp. "Local Parameter", "Local Axiom"). (potential source - of rare incompatibilities). -- The "Let" command can now define local (co)fixpoints. -- Command "Search" has been renamed into "SearchHead". The command - name "Search" now behaves like former "SearchAbout". The latter name - is deprecated. -- "Search", "About", "SearchHead", "SearchRewrite" and "SearchPattern" - now search for hypothesis (of the current goal by default) first. - They now also support the goal selector prefix to specify another - goal to search: e.g. "n:Search id". This is also true for - SearchAbout although it is deprecated. -- The coq/user-contrib directory and the XDG directories are no longer - recursively added to the load path, so files from installed libraries - now need to be fully qualified for the "Require" command to find them. - The tools/update-require script can be used to convert a development. -- A new Print Strategies command allows visualizing the opacity status - of the whole engine. -- The "Locate" command now searches through all sorts of qualified namespaces of - Coq: terms, modules, tactics, etc. The old behavior of the command can be - retrieved using the "Locate Term" command. -- New "Derive" command to help writing program by derivation. -- New "Refine Instance Mode" option that allows to deactivate the generation of - obligations in incomplete typeclass instances, raising an error instead. -- "Collection" command to name sets of section hypotheses. Named collections - can be used in the syntax of "Proof using" to assert which section variables - are used in a proof. -- The "Optimize Proof" command can be placed in the middle of a proof to - force the compaction of the data structure used to represent the ongoing - proof (evar map). This may result in a lower memory footprint and speed up - the execution of the following tactics. -- "Optimize Heap" command to tell the OCaml runtime to perform a major - garbage collection step and heap compaction. -- "Instance" no longer treats the {|...|} syntax specially; it handles it - in the same way as other commands, e.g. "Definition". Use the {...} - syntax (no pipe symbols) to recover the old behavior. - -Specification Language - -- Slight changes in unification error messages. -- Added a syntax $(...)$ that allows putting tactics in terms (may - break user notations using "$(", fixable by inserting a space or - rewriting the notation). -- Constructors in pattern-matching patterns now respect the same rules - regarding implicit arguments as in applicative position. The old - behavior can be recovered by the command "Set Asymmetric - Patterns". As a side effect, notations for constructors explicitly - mentioning non-implicit parameters can now be used in patterns. - Considering that the pattern language is already rich enough, binding - local definitions is however now forbidden in patterns (source of - incompatibilities for local definitions that delta-reduce to a constructor). -- Type inference algorithm now granting opacity of constants. This might also - affect behavior of tactics (source of incompatibilities, solvable by - re-declaring transparent constants which were set opaque). -- Existential variables are now referred to by an identifier and the - relevant part of their instance is displayed by default. They can be - reparsed. The naming policy is yet unstable and subject to changes - in future releases. - -Tactics - -- New tactic engine allowing dependent subgoals, fully backtracking - (also known as multiple success) tactics, as well as tactics which - can consider multiple goals together. In the new tactic engine, - instantiation information of existential variables is always - propagated to tactics, removing the need to manually use the - "instantiate" tactics to mark propagation points. - * New tactical (a+b) inserts a backtracking point. When (a+b);c fails - during the execution of c, it can backtrack and try b instead of a. - * New tactical (once a) removes all the backtracking points from a - (i.e. it selects the first success of a). - * Tactic "constructor" is now fully backtracking. In case of - incompatibilities (e.g. combinatoric explosion), the former - behavior of "constructor" can be retrieved by using instead - "[> once constructor ..]". Thanks to backtracking, undocumented - "constructor " syntax is now equivalent to - "[> once (constructor; tac) ..]". - * New "multimatch" variant of "match" tactic which backtracks to - new branches in case of a later failure. The "match" tactic is - equivalent to "once multimatch". - * New selector "all:" such that "all:tac" applies tactic "tac" to - all the focused goals, instead of just the first one as is the - default. - * A corresponding new option Set Default Goal Selector "all" makes - the tactics in scripts be applied to all the focused goal by default - * New selector "par:" such that "par:tac" applies the (terminating) - tactic "tac" to all the focused goal in parallel. The number of worker - can be selected with -async-proofs-tac-j and also limited using the - coqworkmgr utility. - * New tactics "revgoals", "cycle" and "swap" to reorder goals. - * The semantics of recursive tactics (introduced with "Ltac t := ..." - or "let rec t := ... in ...") changed slightly as t is now - applied to every goal, not each goal independently. In particular - it may be applied when no goals are left. This may cause tactics - such as "let rec t := constructor;t" to loop indefinitely. The - simple fix is to rewrite the recursive calls as follows: - "let rec t := constructor;[t..]" which recovers the earlier behavior - (source of rare incompatibilities). - * New tactic language feature "numgoals" to count number of goals. It is - accompanied by a "guard" tactic which fails if a Boolean test over - integers does not pass. - * New tactical "[> ... ]" to apply tactics to individual goals. - * New tactic "gfail" which works like "fail" except it will also - fail if every goal has been solved. - * The refine tactic is changed not to use an ad hoc typing algorithm - to generate subgoals. It also uses the dependent subgoal feature - to generate goals to materialize every existential variable which - is introduced by the refinement (source of incompatibilities). - * A tactic shelve is introduced to manage the subgoals which may be - solved by unification: shelve removes every goal it is applied to - from focus. These goals can later be called back into focus by the - Unshelve command. - * A variant shelve_unifiable only removes those goals which appear - as existential variables in other goals. To emulate the old - refine, use "refine c;shelve_unifiable". This can still cause - incompatibilities in rare occasions. - * New "give_up" tactic to skip over a goal. A proof containing - given up goals cannot be closed with "Qed", but only with "Admitted". -- The implementation of the admit tactic has changed: no axiom is - generated for the admitted sub proof. "admit" is now an alias for - "give_up". Code relying on this specific behavior of "admit" - can be made to work by: - * Adding an "Axiom" for each admitted subproof. - * Adding a single "Axiom proof_admitted : False." and the Ltac definition - "Ltac admit := case proof_admitted.". -- Matching using "lazymatch" was fundamentally modified. It now behaves - like "match" (immediate execution of the matching branch) but without - the backtracking mechanism in case of failure. -- New "tryif t then u else v" tactical which executes "u" in case of success - of "t" and "v" in case of failure. -- New conversion tactic "native_compute": evaluates the goal (or an hypothesis) - with a call-by-value strategy, using the OCaml native compiler. Useful on - very intensive computations. -- New "cbn" tactic, a well-behaved simpl. -- Repeated identical calls to omega should now produce identical proof terms. -- Tactics btauto, a reflexive Boolean tautology solver. -- Tactic "tauto" was exceptionally able to destruct other connectives - than the binary connectives "and", "or", "prod", "sum", "iff". This - non-uniform behavior has been fixed (bug #2680) and tauto is - slightly weaker (possible source of incompatibilities). On the - opposite side, new tactic "dtauto" is able to destruct any - record-like inductive types, superseding the old version of "tauto". -- Similarly, "intuition" has been made more uniform and, where it now - fails, "dintuition" can be used (possible source of incompatibilities). -- New option "Unset Intuition Negation Unfolding" for deactivating automatic - unfolding of "not" in intuition. -- Tactic notations can now be defined locally to a module (use "Local" prefix). -- Tactic "red" now reduces head beta-iota redexes (potential source of - rare incompatibilities). -- Tactic "hnf" now reduces inner beta-iota redexes - (potential source of rare incompatibilities). -- Tactic "intro H" now reduces beta-iota redexes if these hide a product - (potential source of rare incompatibilities). -- In Ltac matching on patterns of the form "_ pat1 ... patn" now - behaves like if matching on "?X pat1 ... patn", i.e. accepting "_" - to be instantiated by an applicative term (experimental at this - stage, potential source of incompatibilities). -- In Ltac matching on goal, types of hypotheses are now interpreted in - the %type scope (possible source of incompatibilities). -- "change ... in ..." and "simpl ... in ..." now properly consider nested - occurrences (possible source of incompatibilities since this alters - the numbering of occurrences), but do not support nested occurrences. -- Tactics simpl, vm_compute and native_compute can be given a notation string - to a constant as argument. -- When given a reference as argument, simpl, vm_compute and - native_compute now strictly interpret it as the head of a pattern - starting with this reference. -- The "change p with c" tactic semantics changed, now type-checking - "c" at each matching occurrence "t" of the pattern "p", and - converting "t" with "c". -- Now "appcontext" and "context" behave the same. The old buggy behavior of - "context" can be retrieved at parse time by setting the - "Tactic Compat Context" flag (possible source of incompatibilities). -- New introduction pattern p/c which applies lemma c on the fly on the - hypothesis under consideration before continuing with introduction pattern p. -- New introduction pattern [= x1 .. xn] applies "injection as [x1 .. xn]" - on the fly if injection is applicable to the hypothesis under consideration - (idea borrowed from Georges Gonthier). Introduction pattern [=] applies - "discriminate" if a discriminable equality. -- New introduction patterns * and ** to respectively introduce all forthcoming - dependent variables and all variables/hypotheses dependent or not. -- Tactic "injection c as ipats" now clears c if c refers to an - hypothesis and moves the resulting equations in the hypotheses - independently of the number of ipats, which has itself to be less - than the number of new hypotheses (possible source of incompatibilities; - former behavior obtainable by "Unset Injection L2R Pattern Order"). -- Tactic "injection" now automatically simplifies subgoals - "existT n p = existT n p'" into "p = p'" when "n" is in an inductive type for - which a decidable equality scheme has been generated with "Scheme Equality" - (possible source of incompatibilities). -- New tactic "rewrite_strat" for generalized rewriting with user-defined - strategies, subsuming autorewrite. -- Injection can now also deduce equality of arguments of sort Prop, by using - the option "Set Injection On Proofs" (disabled by default). Also improved the - error messages. -- Tactic "subst id" now supports id occurring in dependent local definitions. -- Bugs fixed about intro-pattern "*" might lead to some rare incompatibilities. -- New tactical "time" to display time spent executing its argument. -- Tactics referring or using a constant dependent in a section variable which - has been cleared or renamed in the current goal context now fail - (possible source of incompatibilities solvable by avoiding clearing - the relevant hypotheses). -- New construct "uconstr:c" and "type_term c" to build untyped terms. -- Binders in terms defined in Ltac (either "constr" or "uconstr") can - now take their names from identifiers defined in Ltac. As a - consequence, a name cannot be used in a binder "constr:(fun x => - ...)" if an Ltac variable of that name already exists and does not - contain an identifier. Source of occasional incompatibilities. -- The "refine" tactic now accepts untyped terms built with "uconstr" - so that terms with holes can be constructed piecewise in Ltac. -- New bullets --, ++, **, ---, +++, ***, ... made available. -- More informative messages when wrong bullet is used. -- Bullet suggestion when a subgoal is solved. -- New tactic "enough", symmetric to "assert", but with subgoals - swapped, as a more friendly replacement of "cut". -- In destruct/induction, experimental modifier "!" prefixing the - hypothesis name to tell not erasing the hypothesis. -- Bug fixes in "inversion as" may occasionally lead to incompatibilities. -- Behavior of introduction patterns -> and <- made more uniform - (hypothesis is cleared, rewrite in hypotheses and conclusion and - erasing the variable when rewriting a variable). -- New experimental option "Set Standard Proposition Elimination Names" - so that case analysis or induction on schemes in Type containing - propositions now produces "H"-based names. -- Tactics from plugins are now active only when the corresponding module - is imported (source of incompatibilities, solvable by adding an "Import"; - in the particular case of Omega, use "Require Import OmegaTactic"). -- Semantics of destruct/induction has been made more regular in some - edge cases, possibly leading to incompatibilities: - - new goals are now opened when the term does not match a subterm of - the goal and has unresolved holes, while in 8.4 these holes were - turned into existential variables - - when no "at" option is given, the historical semantics which - selects all subterms syntactically identical to the first subterm - matching the given pattern is used - - non-dependent destruct/induction on an hypothesis with premises in - an inductive type with indices is fixed - - residual local definitions are now correctly removed. -- The rename tactic may now replace variables in parallel. -- A new "Info" command replaces the "info" tactical discontinued in - v8.4. It still gives informative results in many cases. -- The "info_auto" tactic is known to be broken and does not print a - trace anymore. Use "Info 1 auto" instead. The same goes for - "info_trivial". On the other hand "info_eauto" still works fine, - while "Info 1 eauto" prints a trivial trace. -- When using a lemma of the prototypical form "forall A, {a:A & P a}", - "apply" and "apply in" do not instantiate anymore "A" with the - current goal and use "a" as the proof, as they were sometimes doing, - now considering that it is a too powerful decision. - -Program - -- "Solve Obligations using" changed to "Solve Obligations with", - consistent with "Proof with". -- Program Lemma, Definition now respect automatic introduction. -- Program Lemma, Definition, etc.. now interpret "->" like Lemma and - Definition as a non-dependent arrow (potential source of - incompatibility). -- Add/document "Set Hide Obligations" (to hide obligations in the final - term inside an implicit argument) and "Set Shrink Obligations" (to - minimize dependencies of obligations defined by tactics). - -Notations - -- The syntax "x -> y" is now declared at level 99. In particular, it has - now a lower priority than "<->": "A -> B <-> C" is now "A -> (B <-> C)" - (possible source of incompatibilities) -- Notations accept term-providing tactics using the $(...)$ syntax. -- "Bind Scope" can no longer bind "Funclass" and "Sortclass". -- A notation can be given a (compat "8.x") annotation, making it behave - like a "only parsing" notation, but the annotation may lead to eventually - issue warnings or errors in further versions when this notation is used. -- More systematic insertion of spaces as a default for printing - notations ("format" still available to override the default). -- In notations, a level modifier referring to a non-existent variable is - now considered an error rather than silently ignored. - -Tools - -- Option -I now only adds directories to the ml path. -- Option -Q behaves as -R, except that the logical path of any loaded file has - to be fully qualified. -- Option -R no longer adds recursively to the ml path; only the root - directory is added. (Behavior with respect to the load path is - unchanged.) -- Option -nois prevents coq/theories and coq/plugins to be recursively - added to the load path. (Same behavior as with coq/user-contrib.) -- coqdep accepts a -dumpgraph option generating a dot file. -- Makefiles generated through coq_makefile have three new targets "quick" - "checkproofs" and "vio2vo", allowing respectively to asynchronously compile - the files without playing the proof scripts, asynchronously checking - that the quickly generated proofs are correct and generating the object - files from the quickly generated proofs. -- The XML plugin was discontinued and removed from the source. -- A new utility called coqworkmgr can be used to limit the number of - concurrent workers started by independent processes, like make and CoqIDE. - This is of interest for users of the par: goal selector. - -Interfaces - -- CoqIDE supports asynchronous edition of the document, ongoing tasks and - errors are reported in the bottom right window. The number of workers - taking care of processing proofs can be selected with -async-proofs-j. -- CoqIDE highlights in yellow "unsafe" commands such as axiom - declarations, and tactics like "give_up". -- CoqIDE supports Proof General like key bindings; - to activate the PG mode go to Edit -> Preferences -> Editor. - For the documentation see Help -> Help for PG mode. -- CoqIDE automatically retracts the locked area when one edits the - locked text. -- CoqIDE search and replace got regular expressions power. See the - documentation of OCaml's Str module for the supported syntax. -- Many CoqIDE windows, including the query one, are now detachable to - improve usability on multi screen work stations. -- Coqtop/coqc outputs highlighted syntax. Colors can be configured thanks - to the COQ_COLORS environment variable, and their current state can - be displayed with the -list-tags command line option. -- Third party user interfaces can install their main loop in $COQLIB/toploop - and call coqtop with the -toploop flag to select it. - -Internal Infrastructure - -- Many reorganizations in the ocaml source files. For instance, - many internal a.s.t. of Coq are now placed in mli files in - a new directory intf/, for instance constrexpr.mli or glob_term.mli. - More details in dev/doc/changes. -- The file states/initial.coq does not exist anymore. Instead, coqtop - initially does a "Require" of Prelude.vo (or nothing when given - the options -noinit or -nois). -- The format of vo files has slightly changed: cf final comments in - checker/cic.mli. -- The build system does not produce anymore programs named coqtop.opt - and a symbolic link to coqtop. Instead, coqtop is now directly - an executable compiled with the best OCaml compiler available. - The bytecode program coqtop.byte is still produced. Same for other - utilities. -- Some options of the ./configure script slightly changed: - * The -coqrunbyteflags and its blank-separated argument is replaced - by option -vmbyteflags which expects a comma-separated argument. - * The -coqtoolsbyteflags option is discontinued, see -no-custom instead. - -Miscellaneous - -- ML plugins now require a "DECLARE PLUGIN \"foo\"" statement. The "foo" name - must be exactly the name of the ML module that will be loaded through a - "Declare ML \"foo\"" command. - -Changes from V8.4beta2 to V8.4 -============================== - -Vernacular commands - -- The "Reset" command is now supported again in files given to coqc or Load. -- "Show Script" now indents again the displayed scripts. It can also work - correctly across Load'ed files if the option "Unset Atomic Load" is used. -- "Open Scope" can now be given the delimiter (e.g. Z) instead of the full - scope name (e.g. Z_scope). - -Notations - -- Most compatibility notations of the standard library are now tagged as - (compat xyz), where xyz is a former Coq version, for instance "8.3". - These notations behave as (only parsing) notations, except that they may - triggers warnings (or errors) when used while Coq is not in a corresponding - -compat mode. -- To activate these compatibility warnings, use "Set Verbose Compat Notations" - or the command-line flag -verbose-compat-notations. -- For a strict mode without these compatibility notations, use - "Unset Compat Notations" or the command-line flag -no-compat-notations. - -Tactics - -- An annotation "eqn:H" or "eqn:?" can be added to a "destruct" - or "induction" to make it generate equations in the spirit of "case_eq". - The former syntax "_eqn" is discontinued. -- The name of the hypothesis introduced by tactic "remember" can be - set via the new syntax "remember t as x eqn:H" (wish #2489). - -Libraries - -- Reals: changed definition of PI, no more axiom about sin(PI/2). -- SetoidPermutation: a notion of permutation for lists modulo a setoid equality. -- BigN: fixed the ocaml code doing the parsing/printing of big numbers. -- List: a couple of lemmas added especially about no-duplication, partitions. -- Init: Removal of the coercions between variants of sigma-types and - subset types (possible source of incompatibility). - -Changes from V8.4beta to V8.4beta2 -================================== - -Vernacular commands - -- Commands "Back" and "BackTo" are now handling the proof states. They may - perform some extra steps of backtrack to avoid states where the proof - state is unavailable (typically a closed proof). -- The commands "Suspend" and "Resume" have been removed. -- A basic Show Script has been reintroduced (no indentation). -- New command "Set Parsing Explicit" for deactivating parsing (and printing) - of implicit arguments (useful for teaching). -- New command "Grab Existential Variables" to transform the unresolved evars - at the end of a proof into goals. - -Tactics - -- Still no general "info" tactical, but new specific tactics info_auto, - info_eauto, info_trivial which provides information on the proofs found - by auto/eauto/trivial. Display of these details could also be activated by - "Set Info Auto"/"Set Info Eauto"/"Set Info Trivial". -- Details on everything tried by auto/eauto/trivial during a proof search - could be obtained by "debug auto", "debug eauto", "debug trivial" or by a - global "Set Debug Auto"/"Set Debug Eauto"/"Set Debug Trivial". -- New command "r string" in Ltac debugger that interprets "idtac - string" in Ltac code as a breakpoint and jumps to its next use. -- Tactics from the Dp plugin (simplify, ergo, yices, cvc3, z3, cvcl, - harvey, zenon, gwhy) have been removed, since Why2 has not been - maintained for the last few years. The Why3 plugin should be a suitable - replacement in most cases. - -Libraries - -- MSetRBT: a new implementation of MSets via Red-Black trees (initial - contribution by Andrew Appel). -- MSetAVL: for maximal sharing with the new MSetRBT, the argument order - of Node has changed (this should be transparent to regular MSets users). - -Module System - -- The names of modules (and module types) are now in a fully separated - namespace from ordinary definitions: "Definition E:=0. Module E. End E." - is now accepted. - -CoqIDE - -- Coqide now supports the "Restart" command, and "Undo" (with a warning). - Better support for "Abort". - -Changes from V8.3 to V8.4beta -============================= - -Logic - -- Standard eta-conversion now supported (dependent product only). -- 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". -- 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 - -- New proof engine. -- Scripts can now be structured thanks to bullets - * + and to subgoal - delimitation via { }. Note: for use with Proof General, a cvs version of - Proof General no older than mid-July 2011 is currently required. -- Support for tactical "info" is suspended. -- Support for command "Show Script" is suspended. -- New tactics constr_eq, is_evar and has_evar for use in Ltac (DOC TODO). -- 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 incompatibilities). -- 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 non 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). -- In an ltac 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. -- The behavior of "simpl" can be tuned using the "Arguments" vernacular. - In particular constants can be marked so that they are always/never unfolded - by "simpl", or unfolded only when a set of arguments evaluates to a - constructor. Last one can mark a constant so that it is unfolded only if the - simplified term does not expose a match in head position. - -Vernacular commands - -- 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 "_subproof" "Private_". -- 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). -- Command "Proof" accept a new modifier "using" to force generalization - over a given list of section variables at section ending (DOC TODO). -- New command "Arguments" generalizing "Implicit Arguments" and - "Arguments Scope" and that also allows to rename the parameters of a - definition and to tune the behavior of the tactic "simpl". - -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 (DOC TODO). -- 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. - -Libraries - -- 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: - * "= 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 uses the - "Backtrack" command similarly to Proof General. -- 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. - -Tools - -- 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. -- Major changes to coq_makefile: - * 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 -========================= - -Rewriting tactics - -- Tactic "rewrite" now supports rewriting on ad hoc equalities such as eq_true. -- "Hint Rewrite" now checks that the lemma looks like an equation. -- New tactic "etransitivity". -- Support for heterogeneous equality (JMeq) in "injection" and "discriminate". -- Tactic "subst" now supports heterogeneous equality and equality - proofs that are dependent (use "simple subst" for preserving compatibility). -- Added support for Leibniz-rewriting of dependent hypotheses. -- Renamed "Morphism" into "Proper" and "respect" into "proper_prf" - (possible source of incompatibility). A partial fix is to define - "Notation Morphism R f := (Proper (R%signature) f)." -- New tactic variants "rewrite* by" and "autorewrite*" that rewrite - respectively the first and all matches whose side-conditions are - solved. -- "Require Import Setoid" does not export all of "Morphisms" and - "RelationClasses" anymore (possible source of incompatibility, fixed - by importing "Morphisms" too). -- Support added for using Chung-Kil Hur's Heq library for rewriting over - heterogeneous equality (courtesy of the library's author). -- Tactic "replace" supports matching terms with holes. - -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, 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. -- Tactic "firstorder" now supports the combination of its "using" and - "with" options. -- New "Hint Resolve ->" (or "<-") for declaring iff's as oriented - 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 - by computation of Groebner bases. - -Other tactics - -- Tactic "discriminate" now performs intros before trying to discriminate an - hypothesis of the goal (previously it applied intro only if the goal - had the form t1<>t2) (exceptional source of incompatibilities - former - behavior can be obtained by "Unset Discriminate Introduction"). -- 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 - variables and "**" for introducing all quantified variables and hypotheses. -- 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. -- New tactic "decide lemma with hyp" for rewriting decidability lemmas - when one knows which side is true. -- Improved support of dependent goals over objects in dependent types for - "destruct" (rare source of incompatibility that can be avoided by unsetting - option "Dependent Propositions Elimination"). -- Tactic "exists", "eexists", "destruct" and "edestruct" supports iteration - using comma-separated arguments. -- Tactic names "case" and "elim" now support clauses "as" and "in" and become - then synonymous of "destruct" and "induction" respectively. -- A new tactic name "exfalso" for the use of 'ex-falso quodlibet' principle. - This tactic is simply a shortcut for "elimtype False". -- Made quantified hypotheses get the name they would have if introduced in - the context (possible but rare source of incompatibilities). -- When applying a component of a conjunctive lemma, "apply in" (and - sequences of "apply in") now leave the side conditions of the lemmas - uniformly after the main goal (possible source of rare incompatibilities). -- In "simpl c" and "change c with d", c can be a pattern. -- Tactic "revert" now preserves let-in's making it the exact inverse of - "intro". -- New tactics "clear dependent H" and "revert dependent H" that - clears (resp. reverts) H and all the hypotheses that depend on H. -- Ltac's pattern-matching now supports matching metavariables that - depend on variables bound upwards in the pattern. - -Tactic definitions - -- Ltac definitions support Local option for non-export outside modules. -- Support for parsing non-empty lists with separators in tactic notations. -- New command "Locate Ltac" to get the full name of an Ltac definition. - -Notations - -- Record syntax "{|x=...; y=...|}" now works inside patterns too. -- Abbreviations from non-imported module now invisible at printing time. -- Abbreviations now use implicit arguments and arguments scopes for printing. -- Abbreviations to pure names now strictly behave like the name they refer to - (make redirections of qualified names easier). -- Abbreviations for applied constant now propagate the implicit arguments - and arguments scope of the underlying reference (possible source of - incompatibilities generally solvable by changing such abbreviations from - e.g. "Notation foo' := (foo x)" to "Notation foo' y := (foo x (y:=y))"). -- The "where" clause now supports multiple notations per defined object. -- Recursive notations automatically expand one step on the left for better - factorization; recursion notations inner separators now ensured being tokens. -- Added "Reserved Infix" as a specific shortcut of the corresponding - "Reserved Notation". -- Open/Close Scope command supports Global option in sections. - -Specification language - -- New support for local binders in the syntax of Record/Structure fields. -- Fixpoint/CoFixpoint now support building part or all of bodies using tactics. -- Binders given before ":" in lemmas and in definitions built by tactics are - now automatically introduced (possible source of incompatibility that can - be resolved by invoking "Unset Automatic Introduction"). -- New support for multiple implicit arguments signatures per reference. - -Module system - -- Include Type is now deprecated since Include now accept both modules and - module types. -- Declare ML Module supports Local option. -- The sharing between non-logical object and the management of the - name-space has been improved by the new "Delta-equivalence" on - qualified name. -- The include operator has been extended to high-order structures -- Sequences of Include can be abbreviated via new syntax "<+". -- A module (or module type) can be given several "<:" signatures. -- Interactive proofs are now permitted in module type. Functors can hence - be declared as Module Type and be used later to type themselves. -- A functor application can be prefixed by a "!" to make it ignore any - "Inline" annotation in the type of its argument(s) (for examples of - use of the new features, see libraries Structures and Numbers). -- Coercions are now active only when modules are imported (use "Set Automatic - Coercions Import" to get the behavior of the previous versions of Coq). - -Extraction - -- When using (Recursive) Extraction Library, the filenames are directly the - Coq ones with new appropriate extensions : we do not force anymore - uncapital first letters for Ocaml and capital ones for Haskell. -- The extraction now tries harder to avoid code transformations that can be - dangerous for the complexity. In particular many eta-expansions at the top - of functions body are now avoided, clever partial applications will likely - be preserved, let-ins are almost always kept, etc. -- In the same spirit, auto-inlining is now disabled by default, except for - induction principles, since this feature was producing more frequently - weird code than clear gain. The previous behavior can be restored via - "Set Extraction AutoInline". -- Unicode characters in identifiers are now transformed into ascii strings - that are legal in Ocaml and other languages. -- Harsh support of module extraction to Haskell and Scheme: module hierarchy - 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. -- 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 - extraction, even if these arguments don't fit the usual elimination - principles of extraction, for instance the length n of a vector. -- Files ExtrOcaml*.v in plugins/extraction try to provide a library of common - extraction commands: mapping of basics types toward Ocaml's counterparts, - conversions from/to int and big_int, or even complete mapping of nat,Z,N - to int or big_int, or mapping of ascii to char and string to char list - (in this case recognition of ascii constants is hard-wired in the extraction). - -Program - -- Streamlined definitions using well-founded recursion and measures so - 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 - 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 - source of incompatibility). - -Type classes - -- Declaring axiomatic type class instances in Module Type should be now - done via new command "Declare Instance", while the syntax "Instance" - now always provides a concrete instance, both in and out of Module Type. -- 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, - anonymous instances, declarations giving terms, better handling of - sections and [Context]. - -Vernacular commands - -- New command "Timeout ." interprets a command and a timeout - interrupts the interpretation after seconds. -- New command "Compute ." is a shortcut for "Eval vm_compute in ". -- New command "Fail ." interprets a command and is successful iff - the command fails on an error (but not an anomaly). Handy for tests and - illustration of wrong commands. -- Most commands referring to constant (e.g. Print or About) now support - referring to the constant by a notation string. -- New option "Boolean Equality Schemes" to make generation of boolean - equality automatic for datatypes (together with option "Decidable - Equality Schemes", this replaces deprecated option "Equality Scheme"). -- Made support for automatic generation of case analysis schemes available - to user (governed by option "Set Case Analysis Schemes"). -- New command "(Global?) Generalizable [All|No] Variable(s)? ident(s)?" to - declare which identifiers are generalizable in `{} and `() binders. -- New command "Print Opaque Dependencies" to display opaque constants in - addition to all variables, parameters or axioms a theorem or - definition relies on. -- New command "Declare Reduction := ", allowing to write - later "Eval in ...". This command accepts a Local variant. -- Syntax of Implicit Type now supports more than one block of variables of - a given type. -- Command "Canonical Structure" now warns when it has no effects. -- Commands of the form "Set X" or "Unset X" now support "Local" and "Global" - prefixes. - -Library - -- Use "standard" Coq names for the properties of eq and identity - (e.g. refl_equal is now eq_refl). Support for compatibility is provided. -- The function Compare_dec.nat_compare is now defined directly, - instead of relying on lt_eq_lt_dec. The earlier version is still - available under the name nat_compare_alt. -- Lemmas in library Relations and Reals have been homogenized a bit. -- The implicit argument of Logic.eq is now maximally inserted, allowing - to simply write "eq" instead of "@eq _" in morphism signatures. -- Wrongly named lemmas (Zlt_gt_succ and Zlt_succ_gt) fixed (potential source - of incompatibilities) -- List library: - - Definitions of list, length and app are now in Init/Datatypes. - Support for compatibility is provided. - - Definition of Permutation is now in Sorting/Permtation.v - - Some other light revisions and extensions (possible source - 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 - Mergesort.v; - - former notion of permutation up to setoid from Permutation.v is - deprecated and moved to PermutSetoid.v; - - heapsort from Heap.v of worst-case complexity O(n*n) is deprecated; - - new file Sorted.v for some definitions of being sorted. -- Structure library. This new library is meant to contain generic - structures such as types with equalities or orders, either - in Module version (for now) or Type Classes (still to do): - - DecidableType.v and OrderedType.v: initial notions for FSets/FMaps, - left for compatibility but considered as deprecated. - - Equalities.v and Orders.v: evolutions of the previous files, - with fine-grain Module architecture, many variants, use of - Equivalence and other relevant Type Classes notions. - - OrdersTac.v: a generic tactic for solving chains of (in)equalities - over variables. See {Nat,N,Z,P}OrderedType.v for concrete instances. - - GenericMinMax.v: any ordered type can be equipped with min and max. - We derived here all the generic properties of these functions. -- MSets library: an important evolution of the FSets library. - "MSets" stands for Modular (Finite) Sets, by contrast with a forthcoming - library of Class (Finite) Sets contributed by S. Lescuyer which will be - integrated with the next release of Coq. The main features of MSets are: - - The use of Equivalence, Proper and other Type Classes features - easing the handling of setoid equalities. - - The interfaces are now stated in iff-style. Old specifications - are now derived properties. - - The compare functions are now pure, and return a "comparison" value. - Thanks to the CompSpec inductive type, reasoning on them remains easy. - - Sets structures requiring invariants (i.e. sorted lists) are - built first as "Raw" sets (pure objects and separate proofs) and - attached with their proofs thanks to a generic functor. "Raw" sets - have now a proper interface and can be manipulated directly. - Note: No Maps yet in MSets. The FSets library is still provided - for compatibility, but will probably be considered as deprecated in the - next release of Coq. -- Numbers library: - - The abstract layer (NatInt, Natural/Abstract, Integer/Abstract) has - been simplified and enhance thanks to new features of the module - system such as Include (see above). It has been extended to Euclidean - division (three flavors for integers: Trunc, Floor and Math). - - The arbitrary-large efficient numbers (BigN, BigZ, BigQ) has also - been reworked. They benefit from the abstract layer improvements - (especially for div and mod). Note that some specifications have - slightly changed (compare, div, mod, shift{r,l}). Ring/Field should - work better (true recognition of constants). - -Tools - -- Option -R now supports binding Coq root read-only. -- New coqtop/coqc option -beautify to reformat .v files (usable - e.g. to globally update notations). -- New tool beautify-archive to beautify a full archive of developments. -- New coqtop/coqc option -compat X.Y to simulate the general behavior - of previous versions of Coq (provides e.g. support for 8.2 compatibility). - -Coqdoc - -- List have been revamped. List depth and scope is now determined by - an "offside" whitespace rule. -- Text may be italicized by placing it in _underscores_. -- The "--index " flag changes the filename of the index. -- The "--toc-depth " flag limits the depth of headers which are - included in the table of contents. -- The "--lib-name " flag prints " Foo" instead of - "Library Foo" where library titles are called for. The - "--no-lib-name" flag eliminates the extra title. -- New option "--parse-comments" to allow parsing of regular "(* *)" - comments. -- New option "--plain-comments" to disable interpretation inside comments. -- New option "--interpolate" to try and typeset identifiers in Coq escapings - using the available globalization information. -- New option "--external url root" to refer to external libraries. -- Links to section variables and notations now supported. - -Internal infrastructure - -- To avoid confusion with the repository of user's contributions, - the subdirectory "contrib" has been renamed into "plugins". - On platforms supporting ocaml native dynlink, code located there - is built as loadable plugins for coqtop. -- An experimental build mechanism via ocamlbuild is provided. - From the top of the archive, run ./configure as usual, and - then ./build. Feedback about this build mechanism is most welcome. - Compiling Coq on platforms such as Windows might be simpler - this way, but this remains to be tested. -- The Makefile system has been simplified and factorized with - the ocamlbuild system. In particular "make" takes advantage - of .mllib files for building .cma/.cmxa. The .vo files to - compile are now listed in several vo.itarget files. - -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 - found that satisfies the structural decreasing condition. -- 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 - arguments in terms. -- Sort of Record/Structure, Inductive and CoInductive defaults to Type - if omitted. -- (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, - 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 - all arguments are in Prop is now considered to be a singleton - type. It consequently supports all eliminations to Prop, Set and Type. - As a consequence, Acc_rect has now a more direct proof [possible source - of easily fixed incompatibility in case of manual definition of a recursor - in a recursive singleton inductive type]. - -Vernacular commands - -- Added option Global to "Arguments Scope" for section surviving. -- Added option "Unset Elimination Schemes" to deactivate the automatic - generation of elimination schemes. -- 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 - 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 - of the boolean equality when possible. -- 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 - 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. -- New command "Strategy" to control the expansion of constants during - conversion tests. It generalizes commands Opaque and Transparent by - introducing a range of levels. Lower levels are assigned to constants - that should be expanded first. -- New options Global and Local to Opaque and Transparent. -- New command "Print Assumptions" to display all variables, parameters - or axioms a theorem or definition relies on. -- "Add Rec LoadPath" now provides references to libraries using partially - qualified names (this holds also for coqtop/coqc option -R). -- SearchAbout supports negated search criteria, reference to logical objects - by their notation, and more generally search of subterms. -- "Declare ML Module" now allows to import .cmxs files when Coq is - compiled in native code with a version of OCaml that supports native - Dynlink (>= 3.11). -- Specific sort constraints on Record now taken into account. -- "Print LoadPath" supports a path argument to filter the display. - -Libraries - -- Several parts of the libraries are now in Type, in particular FSets, - 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 - in Numbers/Natural/Abstract and Numbers/Integer/Abstract - * 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 - for unbounded natural numbers and Numbers/Integer/BigZ for unbounded - 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 - 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 - 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 - 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). - * 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 - 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, - 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. - * More uniformity in implementations of sets and maps: they all use - 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 - lightweight now. In particular, minor changes in some functions - has allowed to fully separate the proofs of operational - correctness from the proofs of well-balancing: well-balancing is - critical for efficiency, but not anymore for proving that these - trees implement our interfaces, hence we have moved these proofs - into appendix files FSetFullAVL and FMapFullAVL. Moreover, a few - functions like union and compare have been modified in order to be - 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 - 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 - 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 - 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 - a better power function). -- 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 - 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). -- Changes in Reals: - * Most statement in "sigT" (including the - completeness axiom) are now in "sig" (in case of incompatibility, - use proj1_sig instead of projT1, sig instead of sigT, etc). - * More uniform naming scheme (identifiers in French moved to English, - consistent use of 0 -- zero -- instead of O -- letter O --, etc). - * Lemma on prod_f_SO is now on prod_f_R0. - * Useless hypothesis of ln_exists1 dropped. - * New Rlogic.v states a few logical properties about R axioms. - * RIneq.v extended and made cleaner. -- Slight restructuration of the Logic library regarding choice and classical - logic. Addition of files providing intuitionistic axiomatizations of - descriptions: Epsilon.v, Description.v and IndefiniteDescription.v. -- 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 - transitive closure added and some bound variables renamed (exceptional - risk of incompatibilities). -- Syntax for binders in terms (e.g. for "exists") supports anonymous names. - -Notations, coercions, implicit arguments and type inference - -- More automation in the inference of the return clause of dependent - pattern-matching problems. -- Experimental allowance for omission of the clauses easily detectable as - impossible in pattern-matching problems. -- Improved inference of implicit arguments. -- New options "Set Maximal Implicit Insertion", "Set Reversible Pattern - Implicit", "Set Strongly Strict Implicit" and "Set Printing Implicit - Defensive" for controlling inference and use of implicit arguments. -- New modifier in "Implicit Arguments" to force an implicit argument to - be maximally inserted. -- New modifier of "Implicit Arguments" to enrich the set of implicit arguments. -- New options Global and Local to "Implicit Arguments" for section - surviving or non export outside module. -- Level "constr" moved from 9 to 8. -- Structure/Record now printed as Record (unless option Printing All is set). -- Support for parametric notations defining constants. -- Insertion of coercions below product types refrains to unfold - constants (possible source of incompatibility). -- New support for fix/cofix in notations. - -Tactic Language - -- Second-order pattern-matching now working in Ltac "match" clauses - (syntax for second-order unification variable is "@?X"). -- Support for matching on let bindings in match context using syntax - "H := body" or "H := body : type". -- Ltac accepts integer arguments (syntax is "ltac:nnn" for nnn an integer). -- The general sequence tactical "expr_0 ; [ expr_1 | ... | expr_n ]" - is extended so that at most one expr_i may have the form "expr .." - or just "..". Also, n can be different from the number of subgoals - generated by expr_0. In this case, the value of expr (or idtac in - case of just "..") is applied to the intermediate subgoals to make - the number of tactics equal to the number of subgoals. -- A name used as the name of the parameter of a lemma (like f in - "apply f_equal with (f:=t)") is now interpreted as a ltac variable - if such a variable exists (this is a possible source of - incompatibility and it can be fixed by renaming the variables of a - ltac function into names that do not clash with the lemmas - parameter names used in the tactic). -- New syntax "Ltac tac ::= ..." to rebind a tactic to a new expression. -- "let rec ... in ... " now supported for expressions without explicit - parameters; interpretation is lazy to the contrary of "let ... in ..."; - hence, the "rec" keyword can be used to turn the argument of a - "let ... in ..." into a lazy one. -- Patterns for hypotheses types in "match goal" are now interpreted in - type_scope. -- A bound variable whose name is not used elsewhere now serves as - metavariable in "match" and it gets instantiated by an identifier - (allow e.g. to extract the name of a statement like "exists x, P x"). -- New printing of Ltac call trace for better debugging. - -Tactics - -- New tactics "apply -> term", "apply <- term", "apply -> term in - ident", "apply <- term in ident" for applying equivalences (iff). -- Slight improvement of the hnf and simpl tactics when applied on - expressions with explicit occurrences of match or fix. -- New tactics "eapply in", "erewrite", "erewrite in". -- 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 - in unfold. -- The "with" arguments are now typed using informations from the current goal: - allows support for coercions and more inference of implicit arguments. -- Application of "f_equal"-style lemmas works better. -- Tactics elim, case, destruct and induction now support variants eelim, - ecase, edestruct and einduction. -- Tactics destruct and induction now support the "with" option and the - "in" clause option. If the option "in" is used, an equality is added - to remember the term to which the induction or case analysis applied - (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. - 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 - is still legal but equivalent to intros ?a ?b. - * intro pattern "(A & ... & Y & Z)" synonym to "(A,....,(Y,Z)))))" - 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 - "rewrite A" are not concerned by the "rewrite B,C". - * "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 - happen at the n-th exact occurrence of the first successful matching of - 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. -- Introduction patterns better respect the structure of context in presence of - 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 - 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 - "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; - 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)". -- New tactic "instantiate" (without argument). -- Tactic firstorder "with" and "using" options have their meaning swapped for - consistency with auto/eauto (source of incompatibility). -- 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 - 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 - now obsolete. -- 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. - 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 - independently 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 - contributions (subsumed by "firstorder"). - -Program - -- Moved useful tactics in theories/Program and documented them. -- 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 - "let" in Programs). -- 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 - 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 - 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 - 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. -- New command " Print Classes " and " Print Instances some_class " to - 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 - n-ary heterogeneous predicates. - -Setoid rewriting - -- Complete (and still experimental) rewrite of the tactic - based on typeclasses. The old interface and semantics are - almost entirely respected, except: - - - Import Setoid is now mandatory to be able to call setoid_replace - and declare morphisms. - - - "-->", "++>" and "==>" are now right associative notations - declared at level 55 in scope signature_scope. - 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 - 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 - let-bound variables. When called through [rewrite], the semantics are - unchanged though. - - - [Add Morphism term : id] has different semantics when used with - parametric morphism: it will try to find a relation on the parameters - too. The behavior has also changed with respect to default relations: - the most recently declared Setoid/Relation will be used, the documentation - explains how to customize this behavior. - - - Parametric Relation and Morphism are declared differently, using the - new [Add Parametric] commands, documented in the manual. - - - 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 - as before. Scripts which introduced variables explicitely will not break. - - - The order of subgoals when doing [setoid_rewrite] with side-conditions - is always the same: first the new goal, then the conditions. - -- New standard library modules Classes.Morphisms declares - standard morphisms on refl/sym/trans relations. - 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 - setoid_replace tactics and some support for the "Add *" interface, - notably the tactic applied automatically before each "Add Morphism" - proof. - -- User-defined subrelations are supported, as well as higher-order morphisms - 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 - 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. -- The command Extract Inductive has now a syntax for infix notations. This - 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 - possible if several branches are identical. For instance, functions - 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. - -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 - of a proof. -- Undoing non-tactic commands in CoqIDE works faster. -- New CoqIDE menu for activating display of various implicit informations. -- Added the possibility to choose the location of tabs in coqide: - (in Edit->Preferences->Misc) -- New Open and Save As dialogs in CoqIDE which filter *.v files. - -Tools - -- New stand-alone .vo files verifier "coqchk". -- 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 - supported, which makes typesetting trivial in the generated documentation. - Support for hyperlinking and indexing developments in the tex output - has been implemented as well. - -Miscellaneous - -- Coq installation provides enough files so that Ocaml's extensions need not - the Coq sources to be compiled (this assumes O'Caml 3.10 and Camlp5). -- New commands "Set Whelp Server" and "Set Whelp Getter" to customize the - Whelp search tool. -- Syntax of "Test Printing Let ref" and "Test Printing If ref" changed into - "Test Printing Let for ref" and "Test Printing If for ref". -- An overhauled build system (new Makefiles); see dev/doc/build-system.txt. -- Add -browser option to configure script. -- Build a shared library for the C part of Coq, and use it by default on - non-(Windows or MacOS) systems. Bytecode executables are now pure. The - behaviour is configurable with -coqrunbyteflags, -coqtoolsbyteflags and - -custom configure options. -- Complexity tests can be skipped by setting the environment variable - COQTEST_SKIPCOMPLEXITY. - -Changes from V8.1gamma to V8.1 -============================== - -Bug fixes - -- Many bugs have been fixed (cf coq-bugs web page) - -Tactics - -- New tactics ring, ring_simplify and new tactic field now able to manage - power to a positive integer constant. Tactic ring on Z and R, and - 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 - (see documentation). - -Libraries - -- New file ConstructiveEpsilon.v defining an epsilon operator and - proving the axiom of choice constructively for a countable domain - and a decidable predicate. - -Changes from V8.1beta to V8.1gamma -================================== - -Syntax - -- changed parsing precedence of let/in and fun constructions of Ltac: - let x := t in e1; e2 is now parsed as let x := t in (e1;e2). - -Language and commands - -- Added sort-polymorphism for definitions in Type (but finally abandonned). -- Support for implicit arguments in the types of parameters in - (co-)fixpoints and (co-)inductive declarations. -- Improved type inference: use as much of possible general information. - before applying irreversible unification heuristics (allow e.g. to - infer the predicate in "(exist _ 0 (refl_equal 0) : {n:nat | n=0 })"). -- Support for Miller-Pfenning's patterns unification in type synthesis - (e.g. can infer P such that P x y = phi(x,y)). -- Support for "where" clause in cofixpoint definitions. -- New option "Set Printing Universes" for making Type levels explicit. - -Tactics - -- Improved implementation of the ring and field tactics. For compatibility - reasons, the previous tactics are renamed as legacy ring and legacy field, - but should be considered as deprecated. -- New declarative mathematical proof language. -- 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). -- 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. -- New ltac tactic "remember" to abstract over a subterm and keep an equality -- Support for Miller-Pfenning's patterns unification in apply/rewrite/... - (may lead to few incompatibilities - generally now useless tactic calls). - -Bug fixes - -- Fix for notations involving basic "match" expressions. -- Numerous other bugs solved (a few fixes may lead to incompatibilities). - - -Changes from V8.0 to V8.1beta -============================= - -Logic - -- Added sort-polymorphism on inductive families -- Allowance for recursively non uniform parameters in inductive types - -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 - only one of the arguments has an inductive type -- Added disjunctive patterns in match-with patterns -- Support for primitive interpretation of string literals -- Extended support for Unicode ranges - -Vernacular commands - -- Added "Print Ltac qualid" to print a user defined tactic. -- Added "Print Rewrite HintDb" to print the content of a DB used by - autorewrite. -- Added "Print Canonical Projections". -- Added "Example" as synonym of "Definition". -- Added "Proposition" and "Corollary" as extra synonyms of "Lemma". -- New command "Whelp" to send requests to the Helm database of proofs - formalized in the Calculus of Inductive Constructions. -- Command "functional induction" has been re-implemented from the new - "Function" command. - -Ltac and tactic syntactic extensions - -- New primitive "external" for communication with tool external to Coq -- 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 - 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. -- Added entry constr_may_eval for tactic extensions. -- Low-priority term printer made available in ML-written tactic extensions. -- "Tactic Notation" extended to allow notations of tacticals. - -Tactics - -- New implementation and generalization of [setoid_]* (setoid_rewrite, - setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite). - New syntax for declaring relations and morphisms (old syntax still working - with minor modifications, but deprecated). -- 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 - 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 - 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 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". -- Added "autorewrite with ... in hyp [using ...]". -- Tactic "replace" now accepts a "by" tactic clause. -- Added "clear - id" to clear all hypotheses except the ones depending in id. -- The argument of Declare Left Step and Declare Right Step is now a term - (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, - [ 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 - ~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 - 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 - "(nat -> nat) -> nat" works). -- New introduction patterns "->" and "<-" for immediate rewriting of - introduced hypotheses. -- Introduction patterns coming after non trivial introduction patterns now - force full introduction of the first pattern (e.g. "intros [[|] p]" on - "nat->nat->nat" now behaves like "intros [[|?] p]") -- Added "eassumption". -- Added option 'using lemmas' to auto, trivial and eauto. -- Tactic "congruence" is now complete for its intended scope (ground - equalities and inequalities with constructors). Furthermore, it - tries to equates goal and hypotheses. -- New tactic "rtauto" solves pure propositional logic and gives a - reflective version of the available proof. -- Numbering of "pattern", "unfold", "simpl", ... occurrences in "match - with" made consistent with the printing of the return clause after - the term to match in the "match-with" construct (use "Set Printing All" - to see hidden occurrences). -- 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 - (file Tactics.v): - * f_equal : instead of using the different f_equalX lemmas - * 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 - * revert : revert H is generalize H; clear H. - -Extraction - -- All type parts should now disappear instead of sometimes producing _ - (for instance in Map.empty). -- 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. - -Modules - -- Added "Locate Module qualid" to get the full path of a module. -- Module/Declare Module syntax made more uniform. -- Added syntactic sugar "Declare Module Export/Import" and - "Module Export/Import". -- Added syntactic sugar "Module M(Export/Import X Y: T)" and - "Module Type M(Export/Import X Y: T)" - (only for interactive definitions) -- Construct "with" generalized to module paths: - T with (Definition|Module) M1.M2....Mn.l := l'. - -Notations - -- Option "format" aware of recursive notations. -- Added insertion of spaces by default in recursive notations w/o separators. -- No more automatic printing box in case of user-provided printing "format". -- New notation "exists! x:A, P" for unique existence. -- Notations for specific numerals now compatible with generic notations of - numerals (e.g. "1" can be used to denote the unit of a group without - hiding 1%nat) - -Libraries - -- New library on String and Ascii characters (contributed by L. Thery). -- New library FSets+FMaps of finite sets and maps. -- New library QArith on rational numbers. -- Small extension of Zmin.V, new Zmax.v, new Zminmax.v. -- Reworking and extension of the files on classical logic and - description principles (possible incompatibilities) -- Few other improvements in ZArith potentially exceptionally breaking the - compatibility (useless hypothesys of Zgt_square_simpl and - Zlt_square_simpl removed; fixed names mentioning letter O instead of - 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 - 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 - the allowance for recursively non uniform parameters (possible - source of incompatibilities: explicit pattern-matching on these - types may require to remove the occurrence associated to their - recursively non uniform parameter). -- Coq.List.In_dec has been set transparent (this may exceptionally break - 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 - 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 - 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 - this obsolete Intmap. - -Tools - -- New semantics for coqtop options ("-batch" expects option "-top dir" - for loading vernac file that contains definitions). -- Tool coq_makefile now removes custom targets that are file names in - "make clean" -- New environment variable COQREMOTEBROWSER to set the command invoked - to start the remote browser both in Coq and coqide. Standard syntax: - "%s" is the placeholder for the URL. - - -Changes from V8.0beta to V8.0 -============================= - -Vernacular commands - -- New option "Set Printing All" to deactivate all high-level forms of - printing (implicit arguments, coercions, destructing let, - if-then-else, notations, projections) -- "Functional Scheme" and "Functional Induction" extended to polymorphic - types and dependent types -- Notation now allows recursive patterns, hence recovering parts of the - fonctionalities of pre-V8 Grammar/Syntax commands -- Command "Print." discontinued. -- Redundant syntax "Implicit Arguments On/Off" discontinued - -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; - this may cause incompatibilities for files translated using coq 8.0beta - -Interpretation scopes - -- Delimiting key %bool for bool_scope added -- Import no more needed to activate argument scopes from a module - -Tactics and the tactic Language - -- Semantics of "assert" is now consistent with the reference manual -- New tactics stepl and stepr for chaining transitivity steps -- Tactic "replace ... with ... in" added -- Intro patterns now supported in Ltac (parsed with prefix "ipattern:") - -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 - (cf chapter 13 in the reference manual) - -User contributions - -- User contributions have been updated to the new syntax - -Bug fixes - -- Many bugs have been fixed (cf coq-bugs web page) - -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 few syntactic changes for vernacular commands -- A smart automatic translator translating V8.0 files in old syntax to - files valid for V8.0 - -Syntax extensions - -- "Grammar" for terms disappears -- "Grammar" for tactics becomes "Tactic Notation" -- "Syntax" disappears -- Introduction of a notion of interpretation scope allowing to use the - same notations in various contexts without using specific delimiters - (e.g the same expression "4<=3+x" is interpreted either in "nat", - "positive", "N" (previously "entier"), "Z", "R", depending on which - interpretation scope is currently open) [see documentation for details] -- Notation now mandatorily requires a precedence and associativity - (default was to set precedence to 1 and associativity to none) - -Revision of the standard library - -- 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") -- Order and names of arguments of basic lemmas on nat, Z, positive and R - have been made uniform. -- Notions of Coq initial state are declared with (strict) implicit arguments -- eq merged with eqT: old eq disappear, new eq (written =) is old eqT - and new eqT is syntactic sugar for new eq (notation == is an alias - for = and is written as it, exceptional source of incompatibilities) -- Similarly, ex, ex2, all, identity are merged with exT, exT2, allT, identityT -- Arithmetical notations for nat, positive, N, Z, R, without needing - any backquote or double-backquotes delimiters. -- In Lists: new concrete notations; argument of nil is now implicit -- All changes in the library are taken in charge by the translator - -Semantical changes during translation - -- Recursive keyword set by default (and no longer needed) in Tactic Definition -- Set Implicit Arguments is strict by default in new syntax -- reductions in hypotheses of the form "... in H" now apply to the type - also if H is a local definition -- etc - -Gallina - -- New syntax of the form "Inductive bool : Set := true, false : bool." for - enumerated types -- Experimental syntax of the form p.(fst) for record projections - (activable with option "Set Printing Projections" which is - recognized by the translator) - -Known problems of the automatic translation - -- iso-latin-1 characters are no longer supported: move your files to - 7-bits ASCII or unicode before translation (swith to unicode is - automatically done if a file is loaded and saved again by coqide) -- Renaming in ZArith: incompatibilities in Coq user contribs due to - merging names INZ, from Reals, and inject_nat. -- Renaming and new lemmas in ZArith: may clash with names used by users -- Restructuration of ZArith: replace requirement of specific modules - in ZArith by "Require Import ZArith_base" or "Require Import ZArith" -- Some implicit arguments must be made explicit before translation: typically - for "length nil", the implicit argument of length must be made explicit -- Grammar rules, Infix notations and V7.4 Notations must be updated wrt the - 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 -======================================== - -Logic - -- Set now predicative by default -- New option -impredicative-set to set Set impredicative -- The standard library doesn't need impredicativity of Set and is - compatible with the classical axioms which contradict Set impredicativity - -Syntax for arithmetic - -- Notation "=" and "<>" in Z and R are no longer implicitly in Z or R - (with possible introduction of a coercion), use ...=... or - ...<>... instead -- Locate applied to a simple string (e.g. "+") searches for all - notations containing this string - -Vernacular commands - -- "Declare ML Module" now allows to import .cma files. This avoids to use a - bunch of "Declare ML Module" statements when using several ML files. -- "Set Printing Width n" added, allows to change the size of width printing. -- "Implicit Variables Type x,y:t" (new syntax: "Implicit Types x y:t") - assigns default types for binding variables. -- Declarations of Hints and Notation now accept a "Local" flag not to - be exported outside the current file even if not in section -- "Print Scopes" prints all notations -- New command "About name" for light printing of type, implicit arguments, etc. -- New command "Admitted" to declare incompletely proven statement as axioms -- New keyword "Conjecture" to declare an axiom intended to be provable -- SearchAbout can now search for lemmas referring to more than one constant - and on substrings of the name of the lemma -- "Print Implicit" displays the implicit arguments of a constant -- Locate now searches for all names having a given suffix -- New command "Functional Scheme" for building an induction principle - from a function defined by case analysis and fix. - -Commands - -- new coqtop/coqc option -dont-load-proofs not to load opaque proofs in memory - -Implicit arguments - -- Inductive in sections declared with implicits now "discharged" with - implicits (like constants and variables) -- Implicit Arguments flags are now synchronous with reset -- New switch "Unset/Set Printing Implicits" (new syntax: "Unset/Set Printing - Implicit") to globally control printing of implicits - -Grammar extensions - -- Many newly supported UTF-8 encoded unicode blocks - - Greek letters (0380-03FF), Hebrew letters (U05D0-05EF), letter-like - symbols (2100-214F, that includes double N,Z,Q,R), prime - signs (from 2080-2089) and characters from many written languages - are valid in identifiers - - mathematical operators (2200-22FF), supplemental mathematical - operators (2A00-2AFF), miscellaneous technical (2300-23FF that - includes sqrt symbol), miscellaneous symbols (2600-26FF), arrows - (2190-21FF and 2900-297F), invisible mathematical operators (from - 2080-2089), ... are valid symbols - -Library - -- New file about the factorial function in Arith -- 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 -- Restructuration in ZArith library - - "true_sub" used in Zplus now a definition, not a local one (source - of incompatibilities in proof referring to true_sub, may need extra Unfold) - - Some lemmas about minus moved from fast_integer to Arith/Minus.v - (le_minus, lt_mult_left) (theoretical source of incompatibilities) - - 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 - 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, - Zle_0_plus), (Zplus_assoc_l, Zplus_assoc), (Zmult_one, Zmult_1_n), - (Zmult_assoc_l, Zmult_assoc), (Zmult_minus_distr, Zmult_Zminus_distr_l) - (add_un_double_moins_un_xO, is_double_moins_un), - (Rlt_monotony_rev,Rlt_monotony_contra) (source of incompatibilities) -- Few minor changes (no more implicit arguments in - Zmult_Zminus_distr_l and Zmult_Zminus_distr_r, lemmas moved from - Zcomplements to other files) (rare source of incompatibilities) -- New lemmas provided by users added - -Tactic language - -- Fail tactic now accepts a failure message -- Idtac tactic now accepts a message -- New primitive tactic "FreshId" (new syntax: "fresh") to generate new names -- Debugger prints levels of calls - -Tactics - -- Replace can now replace proofs also -- Fail levels are now decremented at "Match Context" blocks only and - if the right-hand-side of "Match term With" are tactics, these - tactics are never evaluated immediately and do not induce - backtracking (in contrast with "Match Context") -- Quantified names now avoid global names of the current module (like - Intro names did) [source of rare incompatibilities: 2 changes in the set of - user contribs] -- NewDestruct/NewInduction accepts intro patterns as introduction names -- NewDestruct/NewInduction now work for non-inductive type using option "using" -- A NewInduction naming bug for inductive types with functional - arguments (e.g. the accessibility predicate) has been fixed (source - of incompatibilities) -- Symmetry now applies to hypotheses too -- Inversion now accept option "as [ ... ]" to name the hypotheses -- Contradiction now looks also for contradictory hypotheses stating ~A and A - (source of incompatibility) -- "Contradiction c" try to find an hypothesis in context which - contradicts the type of c -- Ring applies to new library NArith (require file NArithRing) -- Field now works on types in Set -- Auto with reals now try to replace le by ge (Rge_le is no longer an - immediate hint), resulting in shorter proofs -- Instantiate now works in hyps (syntax : Instantiate in ...) -- Some new tactics : EConstructor, ELeft, Eright, ESplit, EExists -- New tactic "functional induction" to perform case analysis and - induction following the definition of a function. -- Clear now fails when trying to remove a local definition used by - a constant appearing in the current goal - -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. - -Bugs - -- see coq-bugs server for the complete list of fixed bugs - -Miscellaneous - -- Implicit parameters of inductive types definition now taken into - account for infering other implicit arguments - -Incompatibilities - -- Persistence of true_sub (4 incompatibilities in Coq user contributions) -- Variable names of some constants changed for a better uniformity (2 changes - in Coq user contributions) -- Naming of quantified names in goal now avoid global names (2 occurrences) -- NewInduction naming for inductive types with functional arguments - (no incompatibility in Coq user contributions) -- Contradiction now solve more goals (source of 2 incompatibilities) -- Merge of eq and eqT may exceptionally result in subgoals now - solved automatically -- Redundant pairs of ZArith lemmas may have different names: it may - 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 - "Coqlib.gen_constant_modules Coqlib.zarith_base_modules" instead - -Changes from V7.3.1 to V7.4 -=========================== - -Symbolic notations - -- Introduction of a notion of scope gathering notations in a consistent set; - a notation sets has been developed for nat, Z and R (undocumented) -- New command "Notation" for declaring notations simultaneously for - parsing and printing (see chap 10 of the reference manual) -- 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 - 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 - initial segment of an other one, Grammar does not work, use Notation - -Library - -- Lemmas in Set from Compare_dec.v (le_lt_dec, ...) and Wf_nat.v - (lt_wf_rec, ...) are now transparent. This may be source of - incompatibilities. -- Syntactic Definitions Fst, Snd, Ex, All, Ex2, AllT, ExT, ExT2, - ProjS1, ProjS2, Error, Value and Except are turned to - notations. They now must be applied (incompatibilities only in - unrealistic cases). -- More efficient versions of Zmult and times (30% faster) -- Reals: the library is now divided in 6 parts (Rbase, Rfunctions, - SeqSeries, Rtrigo, Ranalysis, Integration). New tactics: Sup and - RCompute. See Reals.v for details. - -Modules - -- Beta version, see doc chap 2.5 for commands and chap 5 for theory - -Language - -- Inductive definitions now accept ">" in constructor types to declare - the corresponding constructor as a coercion. -- Idem for assumptions declarations and constants when the type is mentionned. -- The "Coercion" and "Canonical Structure" keywords now accept the - same syntax as "Definition", i.e. "hyps :=c (:t)?" or "hyps :t". -- Theorem-like declaration now accepts the syntax "Theorem thm [x:t;...] : u". -- Remark's and Fact's now definitively behave as Theorem and Lemma: when - sections are closed, the full name of a Remark or a Fact has no longer a - section part (source of incompatibilities) -- Opaque Local's (i.e. built by tactics and ended by Qed), do not - survive section closing any longer; as a side-effect, Opaque Local's - now appear in the local context of proofs; their body is hidden - though (source of incompatibilities); use one of Remark/Fact/Lemma/Theorem - instead to simulate the old behaviour of Local (the section part of - the name is not kept though) - -ML tactic and vernacular commands - -- "Grammar tactic" and "Grammar vernac" of type "ast" are no longer - supported (only "Grammar tactic simple_tactic" of type "tactic" - remains available). -- Concrete syntax for ML written vernacular commands and tactics is - now declared at ML level using camlp4 macros TACTIC EXTEND et VERNAC - COMMAND EXTEND. -- "Check n c" now "n:Check c", "Eval n ..." now "n:Eval ..." -- "Proof with T" (* no documentation *) -- SearchAbout id - prints all theorems which contain id in their type - -Tactic definitions - -- Static globalisation of identifiers and global references (source of - incompatibilities, especially, Recursive keyword is required for - mutually recursive definitions). -- New evaluation semantics: no more partial evaluation at definition time; - evaluation of all Tactic/Meta Definition, even producing terms, expect - a proof context to be evaluated (especially "()" is no longer needed). -- Debugger now shows the nesting level and the reasons of failure - -Tactics - -- Equality tactics (Rewrite, Reflexivity, Symmetry, Transitivity) now - understand JM equality -- Simpl and Change now apply to subterms also -- "Simpl f" reduces subterms whose head constant is f -- Double Induction now referring to hypotheses like "Intros until" -- "Inversion" now applies also on quantified hypotheses (naming as - for Intros until) -- NewDestruct now accepts terms with missing hypotheses -- NewDestruct and NewInduction now accept user-provided elimination scheme -- NewDestruct and NewInduction now accept user-provided introduction names -- Omega could solve goals such as ~`x=y` but failed when the - hypothesis was unfolded to `x < y` -> False. This is fixed. In addition, - 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 - 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) -- LinearIntuition (* no documentation *) -- Unfold expects a correct evaluable argument -- Clear expects existing hypotheses - -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, - thanks to automatic inserting of Obj.magic. -- Experimental extraction of Coq new modules to Ocaml modules. - -Proof rendering in natural language - -- Export of theories to XML for publishing and rendering purposes now - includes proof-trees (see http://www.cs.unibo.it/helm) - -Miscellaneous - -- Printing Coercion now used through the standard keywords Set/Add, Test, Print -- "Print Term id" is an alias for "Print id" -- New switch "Unset/Set Printing Symbols" to control printing of - symbolic notations -- Two new variants of implicit arguments are available - - "Unset/Set Contextual Implicits" tells to consider implicit also the - arguments inferable from the context (e.g. for nil or refl_eq) - - "Unset/Set Strict Implicits" tells to consider implicit only the - arguments that are inferable in any case (i.e. arguments that occurs - as argument of rigid constants in the type of the remaining arguments; - e.g. the witness of an existential is not strict since it can vanish when - applied to a predicate which does not use its argument) - -Incompatibilities - -- "Grammar tactic ... : ast" and "Grammar vernac ... : ast" are no - 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 - 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 - renaming allows also to solve incompatibilites related to now - forbidden calls to the tactic Clear) -- Remark and Fact have no longer (very) long names (use Local instead in case - of name conflict) - -Bugs - -- Improved localisation of errors in Syntactic Definitions -- Induction principle creation failure in presence of let-in fixed (#238) -- Inversion bugs fixed (#212 and #220) -- Omega bug related to Set fixed (#180) -- Type-checking inefficiency of nested destructuring let-in fixed (#216) -- Improved handling of let-in during holes resolution phase (#239) - -Efficiency - -- Implementation of a memory sharing strategy reducing memory - requirements by an average ratio of 3. - -Changes from V7.3 to V7.3.1 -=========================== - -Bug fixes - - - Corrupted Field tactic and Match Context tactic construction fixed - - Checking of names already existing in Assert added (PR#182) - - Invalid argument bug in Exact tactic solved (PR#183) - - Colliding bound names bug fixed (PR#202) - - Wrong non-recursivity test for Record fixed (PR#189) - - Out of memory/seg fault bug related to parametric inductive fixed (PR#195) - - Setoid_replace/Setoid_rewrite bug wrt "==" fixed - -Misc - - - Ocaml version >= 3.06 is needed to compile Coq from sources - - Simplification of fresh names creation strategy for Assert, Pose and - LetTac (PR#192) - -Changes from V7.2 to V7.3 -========================= - -Language - -- Slightly improved compilation of pattern-matching (slight source of - incompatibilities) -- Record's now accept anonymous fields "_" which does not build projections -- Changes in the allowed elimination sorts for certain class of inductive - definitions : an inductive definition without constructors - of Sort Prop can be eliminated on sorts Set and Type A "singleton" - inductive definition (one constructor with arguments in the sort Prop - like conjunction of two propositions or equality) can be eliminated - directly on sort Type (In V7.2, only the sorts Prop and Set were allowed) - -Tactics - -- New tactic "Rename x into y" for renaming hypotheses -- New tactics "Pose x:=u" and "Pose u" to add definitions to local context -- Pattern now working on partially applied subterms -- Ring no longer applies irreversible congruence laws of mult but - better applies congruence laws of plus (slight source of incompatibilities). -- Field now accepts terms to be simplified as arguments (as for Ring). This - extension has been also implemented using the toplevel tactic language. -- 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 - 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 - of incompatibilities) - -Bugs - -- "Intros H" now working like "Intro H" trying first to reduce if not a product -- Forward dependencies in Cases now taken into account -- Known bugs related to Inversion and let-in's fixed -- Bug unexpected Delta with let-in now fixed - -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). - -Standard library - -- Some additions in [ZArith]: three files (Zcomplements.v, Zpower.v - and Zlogarithms.v) moved from plugins/omega in order to be more - visible, one Zsgn function, more induction principles (Wf_Z.v and - tail of Zcomplements.v), one more general Euclid theorem -- Peano_dec.v and Compare_dec.v now part of Arith.v - -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) - -User Contributions - -- CongruenceClosure (congruence closure decision procedure) - [Pierre Corbineau, ENS Cachan] -- 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 - [Laurent Thery, INRIA Sophia Antipolis] -- Chinese has been rewritten using Z from ZArith as datatype - ZChinese is the new version, Chinese the obsolete one - [Pierre Letouzey, LRI Orsay] - -Incompatibilities - -- Ring: exceptional incompatibilities (1 above 650 in submitted user - contribs, leading to a simplification) -- Intuition: does not unfold any definition except "<->" and "~" -- Cases: removal of some extra Cases in configurations of the form - "Cases ... of C _ => ... | _ D => ..." (effects on 2 definitions of - submitted user contributions necessitating the removal of now superfluous - proof steps in 3 different proofs) -- Match Context, in case of incompatibilities because of a now non - trapped error (e.g. Not_found or Failure), use instead tactic Fail - to force Match Context trying the next clause -- Inversion: better simplification and discrimination may occasionally - lead to less subgoals and/or hypotheses and different naming of hypotheses -- Unification done by Apply/Elim has been changed and may exceptionally lead - to incompatible instantiations -- Peano_dec.v and Compare_dec.v parts of Arith.v make Auto more - powerful if these files were not already required (1 occurrence of - this in submitted user contribs) - -Changes from V7.1 to V7.2 -========================= - -Language - -- Automatic insertion of patterns for local definitions in the type of - the constructors of an inductive types (for compatibility with V6.3 - 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 - equipped with the remaining fields in e, i.e. ? is instantiated by e - -Tactics - -- New tactic "ClearBody H" to clear the body of definitions in local context -- New tactic "Assert H := c" for forward reasoning -- Slight improvement in naming strategy for NewInduction/NewDestruct -- Intuition/Tauto do not perform useless unfolding and work up to conversion - -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. - -Standard library - -- 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 -- New directory [Sorting] with a proof of heapsort (dragged from 6.3.1 lib) -- In [Reals], more lemmas in Rbase.v, new lemmas on square, square root and - trigonometric functions (R_sqr.v - Rtrigo.v); a complementary approach - and new theorems about continuity and derivability in Ranalysis.v; some - properties in plane geometry such as translation, rotation or similarity - in Rgeom.v; finite sums and Chasles property in Rsigma.v - -Bugs - -- Confusion between implicit args of locals and globals of same base name fixed -- Various incompatibilities wrt inference of "?" in V6.3.1 fixed -- Implicits in infix section variables bug fixed -- Known coercions bugs fixed - -- Apply "universe anomaly" bug fixed -- NatRing now working -- "Discriminate 1", "Injection 1", "Simplify_eq 1" now working -- NewInduction bugs with let-in and recursively dependent hypotheses fixed -- Syntax [x:=t:T]u now allowed as mentioned in documentation - -- Bug with recursive inductive types involving let-in fixed -- Known pattern-matching bugs fixed -- Known Cases elimination predicate bugs fixed -- Improved errors messages for pattern-matching and projections -- Better error messages for ill-typed Cases expressions - -Incompatibilities - -- New naming strategy for NewInduction/NewDestruct may affect 7.1 compatibility -- Extra parentheses may exceptionally be needed in tactic definitions. -- Coq extensions written in Ocaml need to be updated (see dev/changements.txt - for a description of the main changes in the interface files of V7.2) -- New behaviour of Intuition/Tauto may exceptionally lead to incompatibilities - ----------------------------------------------------------------------------- -Changes from V6.3.1 and V7.0 to V7.1 -==================================== - -Notes: - -- items followed by (**) are important sources of incompatibilities -- items followed by (*) may exceptionally be sources of incompatibilities -- items followed by (+) have been introduced in version 7.0 - - -Main novelties -============== - -References are to Coq V7.1 reference manual - -- New primitive let-in construct (see sections 1.2.8 and ) -- Long names (see sections 2.6 and 2.7) -- New high-level tactic language (see chapter 10) -- Improved search facilities (see section 5.2) -- New extraction algorithm managing the Type level (see chapter 17) -- New rewriting tactic for arbitrary equalities (see chapter 19) -- New tactic Field to decide equalities on commutative fields (see 7.11) -- New tactic Fourier to solve linear inequalities on reals numbers (see 7.11) -- New tactics for induction/case analysis in "natural" style (see 7.7) -- Deep restructuration of the code (safer, simpler and more efficient) -- Export of theories to XML for publishing and rendering purposes - (see http://www.cs.unibo.it/helm) - - -Details of changes -================== - -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) - - -Language: long names --------------------- - -- Each construction has a unique absolute names built from a base - name, the name of the module in which they are defined (Top if in - coqtop), and possibly an arbitrary long sequence of directory (e.g. - "Coq.Lists.PolyList.flat_map" where "Coq" means that "flat_map" is part - of Coq standard library, "Lists" means it is defined in the Lists - library and "PolyList" means it is in the file Polylist) (+) - -- Constructions can be referred by their base name, or, in case of - conflict, by a "qualified" name, where the base name is prefixed - by the module name (and possibly by a directory name, and so - on). A fully qualified name is an absolute name which always refer - to the construction it denotes (to preserve the visibility of - all constructions, no conflict is allowed for an absolute name) (+) - -- Long names are available for modules with the possibility of using - the directory name as a component of the module full name (with - option -R to coqtop and coqc, or command Add LoadPath) (+) - -- Improved conflict resolution strategy (the Unix PATH model), - allowing more constructions to be referred just by their base name - - -Language: miscellaneous ------------------------ - -- The names of variables for Record projections _and_ for induction principles - (e.g. sum_ind) is now based on the first letter of their type (main - source of incompatibility) (**)(+) - -- Most typing errors have now a precise location in the source (+) - -- Slightly different mechanism to solve "?" (*)(+) - -- More arguments may be considered implicit at section closing (*)(+) - -- Bug with identifiers ended by a number greater than 2^30 fixed (+) - -- New visibility discipline for Remark, Fact and Local: Remark's and - Fact's now survive at the end of section, but are only accessible using a - qualified names as soon as their strength expires; Local's disappear and - are moved into local definitions for each construction persistent at - section closing - - -Language: Cases ---------------- - -- Cases no longer considers aliases inferable from dependencies in types (*)(+) - -- A redundant clause in Cases is now an error (*) - - -Reduction ---------- - -- New reduction flags "Zeta" and "Evar" in Eval Compute, for inlining of - local definitions and instantiation of existential variables - -- Delta reduction flag does not perform Zeta and Evar reduction any more (*) - -- Constants declared as opaque (using Qed) can no longer become - transparent (a constant intended to be alternatively opaque and - transparent must be declared as transparent (using Defined)); a risk - exists (until next Coq version) that Simpl and Hnf reduces opaque - constants (*) - - -New tactics ------------ - -- New set of tactics to deal with types equipped with specific - equalities (a.k.a. Setoids, e.g. nat equipped with eq_nat) [by C. Renard] - -- New tactic Assert, similar to Cut but expected to be more user-friendly - -- New tactic NewDestruct and NewInduction intended to replace Elim - and Induction, Case and Destruct in a more user-friendly way (see - restrictions in the reference manual) - -- New tactic ROmega: an experimental alternative (based on reflexion) to Omega - [by P. Crégut] - -- New tactic language Ltac (see reference manual) (+) - -- New versions of Tauto and Intuition, fully rewritten in the new Ltac - language; they run faster and produce more compact proofs; Tauto is - fully compatible but, in exchange of a better uniformity, Intuition - is slightly weaker (then use Tauto instead) (**)(+) - -- New tactic Field to decide equalities on commutative fields (as a - special case, it works on real numbers) (+) - -- New tactic Fourier to solve linear inequalities on reals numbers - [by L. Pottier] (+) - -- New tactics dedicated to real numbers: DiscrR, SplitRmult, SplitAbsolu (+) - - -Changes in existing tactics ---------------------------- - -- Reduction tactics in local definitions apply only to the body - -- New syntax of the form "Compute in Type of H." to require a reduction on - the types of local definitions - -- Inversion, Injection, Discriminate, ... apply also on the - quantified premises of a goal (using the "Intros until" syntax) - -- Decompose has been fixed but hypotheses may get different names (*)(+) - -- Tauto now manages uniformly hypotheses and conclusions of the form - "t=t" which all are considered equivalent to "True". Especially, - Tauto now solves goals of the form "H : ~ t = t |- A". - -- The "Let" tactic has been renamed "LetTac" and is now based on the - primitive "let-in" (+) - -- Elim can no longer be used with an elimination schema different from - the one defined at definition time of the inductive type. To overload - an elimination schema, use "Elim using " - (*)(+) - -- Simpl no longer unfolds the recursive calls of a mutually defined - fixpoint (*)(+) - -- Intro now fails if the hypothesis name already exists (*)(+) - -- "Require Prolog" is no longer needed (i.e. it is available by default) (*)(+) - -- Unfold now fails on a non unfoldable identifier (*)(+) - -- Unfold also applies on definitions of the local context - -- AutoRewrite now deals only with the main goal and it is the purpose of - Hint Rewrite to deal with generated subgoals (+) - -- Redundant or incompatible instantiations in Apply ... with ... are now - correctly managed (+) - - -Efficiency ----------- - -- Excessive memory uses specific to V7.0 fixed - -- Sizes of .vo files vary a lot compared to V6.3 (from -30% to +300% - depending on the developments) - -- An improved reduction strategy for lazy evaluation - -- A more economical mechanism to ensure logical consistency at the Type level; - warning: this is experimental and may produce "universes" anomalies - (please report) - - -Concrete syntax of constructions --------------------------------- - -- Only identifiers starting with "_" or a letter, and followed by letters, - digits, "_" or "'" are allowed (e.g. "$" and "@" are no longer allowed) (*) - -- A multiple binder like (a:A)(a,b:(P a))(Q a) is no longer parsed as - (a:A)(a0:(P a))(b:(P a))(Q a0) but as (a:A)(a0:(P a))(b:(P a0))(Q a0) (*)(+) - -- A dedicated syntax has been introduced for Reals (e.g ``3+1/x``) (+) - -- Pretty-printing of Infix notations fixed. (+) - - -Parsing and grammar extension ------------------------------ - -- More constraints when writing ast - - - "{...}" and the macros $LIST, $VAR, etc. now expect a metavariable - (an identifier starting with $) (*) - - identifiers should starts with a letter or "_" and be followed - by letters, digits, "_" or "'" (other characters are still - supported but it is not advised to use them) (*)(+) - -- Entry "command" in "Grammar" and quotations (<<...>> stuff) is - renamed "constr" as in "Syntax" (+) - -- New syntax "[" sentence_1 ... sentence_n"]." to group sentences (useful - for Time and to write grammar rules abbreviating several commands) (+) - -- The default parser for actions in the grammar rules (and for - patterns in the pretty-printing rules) is now the one associated to - the grammar (i.e. vernac, tactic or constr); no need then for - quotations as in <:vernac:<...>>; to return an "ast", the grammar - must be explicitly typed with tag ": ast" or ": ast list", or if a - syntax rule, by using <<...>> in the patterns (expression inside - these angle brackets are parsed as "ast"); for grammars other than - vernac, tactic or constr, you may explicitly type the action with - tags ": constr", ": tactic", or ":vernac" (**)(+) - -- Interpretation of names in Grammar rule is now based on long names, - which allows to avoid problems (or sometimes tricks;) related to - overloaded names (+) - - -New commands ------------- - -- New commands "Print XML All", "Show XML Proof", ... to show or - export theories to XML to be used with Helm's publishing and rendering - tools (see http://www.cs.unibo.it/helm) (by Claudio Sacerdoti Coen) (+) - -- New commands to manually set implicit arguments (+) - - - "Implicits ident." to activate the implicit arguments mode just for ident - - "Implicits ident [num1 num2 ...]." to explicitly give which - arguments have to be considered as implicit - -- New SearchPattern/SearchRewrite (by Yves Bertot) (+) - -- New commands "Debug on"/"Debug off" to activate/deactivate the tactic - language debugger (+) - -- New commands to map physical paths to logical paths (+) - - Add LoadPath physical_dir as logical_dir - - Add Rec LoadPath physical_dir as logical_dir - - -Changes in existing commands ----------------------------- - -- Generalization of the usage of qualified identifiers in tactics - and commands about globals, e.g. Decompose, Eval Delta; - Hints Unfold, Transparent, Require - -- Require synchronous with Reset; Require's scope stops at Section ending (*) - -- For a module indirectly loaded by a "Require" but not exported, - the command "Import module" turns the constructions defined in the - module accessible by their short name, and activates the Grammar, - Syntax, Hint, ... declared in the module (+) - -- The scope of the "Search" command can be restricted to some modules (+) - -- Final dot in command (full stop/period) must be followed by a blank - (newline, tabulation or whitespace) (+) - -- Slight restriction of the syntax for Cbv Delta: if present, option [-myconst] - must immediately follow the Delta keyword (*)(+) - -- SearchIsos currently not supported - -- Add ML Path is now implied by Add LoadPath (+) - -- New names for the following commands (+) - - AddPath -> Add LoadPath - Print LoadPath -> Print LoadPath - DelPath -> Remove LoadPath - AddRecPath -> Add Rec LoadPath - Print Path -> Print Coercion Paths - - Implicit Arguments On -> Set Implicit Arguments - Implicit Arguments Off -> Unset Implicit Arguments - - Begin Silent -> Set Silent - End Silent -> Unset Silent. - - -Tools ------ - -- coqtop (+) - - - Two executables: coqtop.byte and coqtop.opt (if supported by the platform) - - coqtop is a link to the more efficient executable (coqtop.opt if present) - - option -full is obsolete (+) - -- do_Makefile renamed into coq_makefile (+) - -- New option -R to coqtop and coqc to map a physical directory to a logical - one (+) - -- coqc no longer needs to create a temporary file - -- No more warning if no initialization file .coqrc exists - - -Extraction ----------- - -- New algorithm for extraction able to deal with "Type" (+) - (by J.-C. Filliâtre and P. Letouzey) - - -Standard library ----------------- - -- New library on maps on integers (IntMap, contributed by Jean Goubault) - -- New lemmas about integer numbers [ZArith] - -- New lemmas and a "natural" syntax for reals [Reals] (+) - -- Exc/Error/Value renamed into Option/Some/None (*) - - -New user contributions ----------------------- - -- Constructive complex analysis and the Fundamental Theorem of Algebra [FTA] - (Herman Geuvers, Freek Wiedijk, Jan Zwanenburg, Randy Pollack, - Henk Barendregt, Nijmegen) - -- A new axiomatization of ZFC set theory [Functions_in_ZFC] - (C. Simpson, Sophia-Antipolis) - -- Basic notions of graph theory [GRAPHS-BASICS] (Jean Duprat, Lyon) - -- A library for floating-point numbers [Float] (Laurent Théry, Sylvie Boldo, - Sophia-Antipolis) - -- Formalisation of CTL and TCTL temporal logic [CtlTctl] (Carlos - Daniel Luna,Montevideo) - -- Specification and verification of the Railroad Crossing Problem - in CTL and TCTL [RailroadCrossing] (Carlos Daniel Luna,Montevideo) - -- 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) - -- Correctness proofs of the following imperative algorithms: - 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) - -- Correctness proof of Stalmarck tautology checker algorithm - [Stalmarck] (Laurent Théry, Pierre Letouzey, Sophia-Antipolis) diff -Nru coq-doc-8.6/checker/analyze.ml coq-doc-8.15.0/checker/analyze.ml --- coq-doc-8.6/checker/analyze.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/analyze.ml 2022-01-13 11:55:53.000000000 +0000 @@ -4,6 +4,7 @@ let prefix_small_int = 0x40 let prefix_small_string = 0x20 +[@@@ocaml.warning "-32"] let code_int8 = 0x00 let code_int16 = 0x01 let code_int32 = 0x02 @@ -24,7 +25,14 @@ let code_infixpointer = 0x11 let code_custom = 0x12 let code_block64 = 0x13 +let code_shared64 = 0x14 +let code_string64 = 0x15 +let code_double_array64_big = 0x16 +let code_double_array64_little = 0x17 +let code_custom_len = 0x18 +let code_custom_fixed = 0x19 +[@@@ocaml.warning "-37"] type code_descr = | CODE_INT8 | CODE_INT16 @@ -46,15 +54,72 @@ | CODE_INFIXPOINTER | CODE_CUSTOM | CODE_BLOCK64 +| CODE_SHARED64 +| CODE_STRING64 +| CODE_DOUBLE_ARRAY64_BIG +| CODE_DOUBLE_ARRAY64_LITTLE +| CODE_CUSTOM_LEN +| CODE_CUSTOM_FIXED -let code_max = 0x13 +let code_max = 0x19 let magic_number = "\132\149\166\190" (** Memory reification *) +module LargeArray : +sig + type 'a t + val empty : 'a t + val length : 'a t -> int + val make : int -> 'a -> 'a t + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit +end = +struct + + let max_length = Sys.max_array_length + + type 'a t = 'a array array * 'a array + (** Invariants: + - All subarrays of the left array have length [max_length]. + - The right array has length < [max_length]. + *) + + let empty = [||], [||] + + let length (vl, vr) = + (max_length * Array.length vl) + Array.length vr + + let make n x = + let k = n / max_length in + let r = n mod max_length in + let vl = Array.init k (fun _ -> Array.make max_length x) in + let vr = Array.make r x in + (vl, vr) + + let get (vl, vr) n = + let k = n / max_length in + let r = n mod max_length in + let len = Array.length vl in + if k < len then vl.(k).(r) + else if k == len then vr.(r) + else invalid_arg "index out of bounds" + + let set (vl, vr) n x = + let k = n / max_length in + let r = n mod max_length in + let len = Array.length vl in + if k < len then vl.(k).(r) <- x + else if k == len then vr.(r) <- x + else invalid_arg "index out of bounds" + +end + type repr = | RInt of int +| Rint64 of Int64.t +| RFloat64 of float | RBlock of (int * int) (* tag × len *) | RString of string | RPointer of int @@ -68,6 +133,8 @@ type obj = | Struct of int * data array (* tag × data *) +| Int64 of Int64.t (* Primitive integer *) +| Float64 of float (* Primitive float *) | String of string module type Input = @@ -80,7 +147,7 @@ module type S = sig type input - val parse : input -> (data * obj array) + val parse : input -> (data * obj LargeArray.t) end module Make(M : Input) = @@ -101,11 +168,11 @@ input_binary_int chan let input_char chan = Char.chr (input_byte chan) +let input_string len chan = String.init len (fun _ -> input_char chan) let parse_header chan = let () = current_offset := 0 in - let magic = String.create 4 in - let () = for i = 0 to 3 do magic.[i] <- input_char chan done in + let magic = input_string 4 chan in let length = input_binary_int chan in let objects = input_binary_int chan in let size32 = input_binary_int chan in @@ -204,12 +271,46 @@ in (tag, len) -let input_string len chan = - let ans = String.create len in - for i = 0 to pred len do - ans.[i] <- input_char chan; - done; - ans +let input_cstring chan : string = + let buff = Buffer.create 17 in + let rec loop () = + match input_char chan with + | '\o000' -> Buffer.contents buff + | c -> Buffer.add_char buff c |> loop + in loop () + +let input_intL chan : int64 = + let i = input_byte chan in + let j = input_byte chan in + let k = input_byte chan in + let l = input_byte chan in + let m = input_byte chan in + let n = input_byte chan in + let o = input_byte chan in + let p = input_byte chan in + let ( lsl ) x y = Int64.(shift_left (of_int x) y) in + let ( lor ) = Int64.logor in + (i lsl 56) lor (j lsl 48) lor (k lsl 40) lor (l lsl 32) lor + (m lsl 24) lor (n lsl 16) lor (o lsl 8) lor (Int64.of_int p) + +let input_double_big chan : float = + Int64.float_of_bits (input_intL chan) + +let input_double_little chan : float = + let i = input_byte chan in + let j = input_byte chan in + let k = input_byte chan in + let l = input_byte chan in + let m = input_byte chan in + let n = input_byte chan in + let o = input_byte chan in + let p = input_byte chan in + let ( lsl ) x y = Int64.(shift_left (of_int x) y) in + let ( lor ) = Int64.logor in + let bits = + (p lsl 56) lor (o lsl 48) lor (n lsl 40) lor (m lsl 32) lor + (l lsl 24) lor (k lsl 16) lor (j lsl 8) lor (Int64.of_int i) in + Int64.float_of_bits bits let parse_object chan = let data = input_byte chan in @@ -251,22 +352,34 @@ RString (input_string len chan) | CODE_CODEPOINTER -> let addr = input_int32u chan in - for i = 0 to 15 do ignore (input_byte chan); done; + for _i = 0 to 15 do ignore (input_byte chan); done; RCode addr + | CODE_CUSTOM + | CODE_CUSTOM_FIXED -> + begin match input_cstring chan with + | "_j" -> Rint64 (input_intL chan) + | s -> Printf.eprintf "Unhandled custom code: %s" s; assert false + end + | CODE_DOUBLE_BIG -> + RFloat64 (input_double_big chan) + | CODE_DOUBLE_LITTLE -> + RFloat64 (input_double_little chan) | CODE_DOUBLE_ARRAY32_LITTLE - | CODE_DOUBLE_BIG - | CODE_DOUBLE_LITTLE | CODE_DOUBLE_ARRAY8_BIG | CODE_DOUBLE_ARRAY8_LITTLE | CODE_DOUBLE_ARRAY32_BIG | CODE_INFIXPOINTER - | CODE_CUSTOM -> - Printf.eprintf "Unhandled code %04x\n%!" data; assert false + | CODE_SHARED64 + | CODE_STRING64 + | CODE_DOUBLE_ARRAY64_BIG + | CODE_DOUBLE_ARRAY64_LITTLE + | CODE_CUSTOM_LEN + -> Printf.eprintf "Unhandled code %04x\n%!" data; assert false let parse chan = let (magic, len, _, _, size) = parse_header chan in let () = assert (magic = magic_number) in - let memory = Array.make size (Struct ((-1), [||])) in + let memory = LargeArray.make size (Struct ((-1), [||])) in let current_object = ref 0 in let fill_obj = function | RPointer n -> @@ -277,7 +390,7 @@ data, None | RString s -> let data = Ptr !current_object in - let () = memory.(!current_object) <- String s in + let () = LargeArray.set memory !current_object (String s) in let () = incr current_object in data, None | RBlock (tag, 0) -> @@ -287,12 +400,22 @@ | RBlock (tag, len) -> let data = Ptr !current_object in let nblock = Array.make len (Atm (-1)) in - let () = memory.(!current_object) <- Struct (tag, nblock) in + let () = LargeArray.set memory !current_object (Struct (tag, nblock)) in let () = incr current_object in data, Some nblock | RCode addr -> let data = Fun addr in data, None + | Rint64 i -> + let data = Ptr !current_object in + let () = LargeArray.set memory !current_object (Int64 i) in + let () = incr current_object in + data, None + | RFloat64 f -> + let data = Ptr !current_object in + let () = LargeArray.set memory !current_object (Float64 f) in + let () = incr current_object in + data, None in let rec fill block off accu = @@ -318,8 +441,8 @@ module IChannel = struct type t = in_channel - let input_byte = Pervasives.input_byte - let input_binary_int = Pervasives.input_binary_int + let input_byte = input_byte + let input_binary_int = input_binary_int end module IString = @@ -348,3 +471,36 @@ let parse_channel = PChannel.parse let parse_string s = PString.parse (s, ref 0) + +let instantiate (p, mem) = + let len = LargeArray.length mem in + let ans = LargeArray.make len (Obj.repr 0) in + (* First pass: initialize the subobjects *) + for i = 0 to len - 1 do + let obj = match LargeArray.get mem i with + | Struct (tag, blk) -> Obj.new_block tag (Array.length blk) + | Int64 i -> Obj.repr i + | Float64 f -> Obj.repr f + | String str -> Obj.repr str + in + LargeArray.set ans i obj + done; + let get_data = function + | Int n -> Obj.repr n + | Ptr p -> LargeArray.get ans p + | Atm tag -> Obj.new_block tag 0 + | Fun _ -> assert false (* We shouldn't serialize closures *) + in + (* Second pass: set the pointers *) + for i = 0 to len - 1 do + match LargeArray.get mem i with + | Struct (_, blk) -> + let obj = LargeArray.get ans i in + for k = 0 to Array.length blk - 1 do + Obj.set_field obj k (get_data blk.(k)) + done + | Int64 _ + | Float64 _ + | String _ -> () + done; + get_data p diff -Nru coq-doc-8.6/checker/analyze.mli coq-doc-8.15.0/checker/analyze.mli --- coq-doc-8.6/checker/analyze.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/analyze.mli 2022-01-13 11:55:53.000000000 +0000 @@ -1,3 +1,4 @@ +(** Representation of data allocated on the OCaml heap. *) type data = | Int of int | Ptr of int @@ -6,10 +7,24 @@ type obj = | Struct of int * data array (* tag × data *) +| Int64 of Int64.t (* Primitive integer *) +| Float64 of float (* Primitive float *) | String of string -val parse_channel : in_channel -> (data * obj array) -val parse_string : string -> (data * obj array) +module LargeArray : +sig + type 'a t + val empty : 'a t + val length : 'a t -> int + val make : int -> 'a -> 'a t + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit +end +(** A data structure similar to arrays but allowing to overcome the 2^22 length + limitation on 32-bit architecture. *) + +val parse_channel : in_channel -> (data * obj LargeArray.t) +val parse_string : string -> (data * obj LargeArray.t) (** {6 Functorized version} *) @@ -18,6 +33,7 @@ type t val input_byte : t -> int (** Input a single byte *) + val input_binary_int : t -> int (** Input a big-endian 31-bits signed integer *) end @@ -26,10 +42,13 @@ module type S = sig type input - val parse : input -> (data * obj array) + val parse : input -> (data * obj LargeArray.t) (** Return the entry point and the reification of the memory out of a marshalled structure. *) end module Make (M : Input) : S with type input = M.t (** Functorized version of the previous code. *) + +val instantiate : data * obj LargeArray.t -> Obj.t +(** Create the OCaml object out of the reified representation. *) diff -Nru coq-doc-8.6/checker/checker.ml coq-doc-8.15.0/checker/checker.ml --- coq-doc-8.6/checker/checker.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/checker.ml 2022-01-13 11:55:53.000000000 +0000 @@ -1,25 +1,25 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* =len then dirs else let pos = try - String.index_from s n '.' + String.index_from s n '.' with Not_found -> len in let dir = String.sub s n (pos-n) in @@ -41,25 +41,24 @@ [] -> Check.default_root_prefix | dir -> DirPath.make (List.map Id.of_string dir) let path_of_string s = - match parse_dir s with + if Filename.check_suffix s ".vo" then PhysicalFile s + else match parse_dir s with [] -> invalid_arg "path_of_string" - | l::dir -> {dirpath=dir; basename=l} + | l::dir -> LogicalFile {dirpath=dir; basename=l} -let ( / ) = Filename.concat - -let get_version_date () = +let get_version () = try - let ch = open_in (Envars.coqlib () / "revision") in + let env = Boot.Env.init () in + let revision = Boot.Env.(Path.to_string (revision env)) in + let ch = open_in revision in let ver = input_line ch in let rev = input_line ch in let () = close_in ch in - (ver,rev) - with _ -> (Coq_config.version,Coq_config.date) + Printf.sprintf "%s (%s)" ver rev + with _ -> Coq_config.version let print_header () = - let (ver,rev) = (get_version_date ()) in - Printf.printf "Welcome to Chicken %s (%s)\n" ver rev; - flush stdout + Printf.printf "Welcome to Chicken %s\n%!" (get_version ()) (* Adding files to Coq loadpath *) @@ -74,7 +73,7 @@ let convert_string d = try Id.of_string d with CErrors.UserError _ -> - if_verbose Feedback.msg_warning + Flags.if_verbose Feedback.msg_warning (str "Directory " ++ str d ++ str " cannot be used as a Coq identifier (skipped)"); raise Exit @@ -94,30 +93,27 @@ else Feedback.msg_warning (str "Cannot open " ++ str unix_path) -(* By the option -include -I or -R of the command line *) +(* By the option -R/-Q of the command line *) let includes = ref [] -let push_include (s, alias) = includes := (s,alias,false) :: !includes -let push_rec_include (s, alias) = includes := (s,alias,true) :: !includes +let push_include (s, alias) = includes := (s,alias) :: !includes -let set_default_include d = - push_include (d, Check.default_root_prefix) let set_include d p = let p = dirpath_of_string p in push_include (d,p) -let set_rec_include d p = - let p = dirpath_of_string p in - push_rec_include(d,p) (* Initializes the LoadPath *) let init_load_path () = - let coqlib = Envars.coqlib () in - let user_contrib = coqlib/"user-contrib" in + let coqenv = Boot.Env.init () in + (* the to_string casting won't be necessary once Boot handles + include paths *) + let plugins = Boot.Env.plugins coqenv |> Boot.Path.to_string in + let theories = Boot.Env.stdlib coqenv |> Boot.Path.to_string in + let user_contrib = Boot.Env.user_contrib coqenv |> Boot.Path.to_string in let xdg_dirs = Envars.xdg_dirs in let coqpath = Envars.coqpath in - let plugins = coqlib/"plugins" in (* NOTE: These directories are searched from last to first *) (* first standard library *) - add_rec_path ~unix_path:(coqlib/"theories") ~coq_root:(Names.DirPath.make[coq_root]); + add_rec_path ~unix_path:theories ~coq_root:(Names.DirPath.make[coq_root]); (* then plugins *) add_rec_path ~unix_path:plugins ~coq_root:(Names.DirPath.make [coq_root]); (* then user-contrib *) @@ -130,30 +126,35 @@ List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Check.default_root_prefix) coqpath; (* then current directory *) add_path ~unix_path:"." ~coq_root:Check.default_root_prefix; - (* additional loadpath, given with -I -include -R options *) + (* additional loadpath, given with -R/-Q options *) List.iter - (fun (unix_path, coq_root, reci) -> - if reci then add_rec_path ~unix_path ~coq_root else add_path ~unix_path ~coq_root) + (fun (unix_path, coq_root) -> add_rec_path ~unix_path ~coq_root) (List.rev !includes); includes := [] -let set_debug () = Flags.debug := true +let impredicative_set = ref false +let set_impredicative_set () = impredicative_set := true -let impredicative_set = ref Cic.PredicativeSet -let set_impredicative_set () = impredicative_set := Cic.ImpredicativeSet -let engage () = Safe_typing.set_engagement (!impredicative_set) +let indices_matter = ref false +let make_senv () = + let senv = Safe_typing.empty_environment in + let senv = Safe_typing.set_impredicative_set !impredicative_set senv in + let senv = Safe_typing.set_indices_matter !indices_matter senv in + let senv = Safe_typing.set_VM false senv in + let senv = Safe_typing.set_allow_sprop true senv in (* be smarter later *) + Safe_typing.set_native_compiler false senv -let admit_list = ref ([] : section_path list) +let admit_list = ref ([] : object_file list) let add_admit s = admit_list := path_of_string s :: !admit_list -let norec_list = ref ([] : section_path list) +let norec_list = ref ([] : object_file list) let add_norec s = norec_list := path_of_string s :: !norec_list -let compile_list = ref ([] : section_path list) +let compile_list = ref ([] : object_file list) let add_compile s = compile_list := path_of_string s :: !compile_list @@ -161,16 +162,14 @@ We no longer use [Arg.parse], in order to use share [Usage.print_usage] between coqtop and coqc. *) -let compile_files () = - Check.recheck_library +let compile_files senv = + Check.recheck_library senv ~norec:(List.rev !norec_list) ~admit:(List.rev !admit_list) ~check:(List.rev !compile_list) let version () = - Printf.printf "The Coq Proof Checker, version %s (%s)\n" - Coq_config.version Coq_config.date; - Printf.printf "compiled on %s\n" Coq_config.compile_date; + Printf.printf "The Coq Proof Checker, version %s\n" Coq_config.version; exit 0 (* print the usage of coqtop (or coqc) on channel co *) @@ -179,14 +178,16 @@ output_string co command; output_string co "coqchk options are:\n"; output_string co -" -R dir coqdir map physical dir to logical coqdir\ +" -Q dir coqdir map physical dir to logical coqdir\ +\n -R dir coqdir synonymous for -Q\ +\n\ \n\ \n -admit module load module and dependencies without checking\ \n -norec module check module but admit dependencies without checking\ \n\ +\n -coqlib dir set coqchk's standard library location\ \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\ @@ -211,31 +212,27 @@ open Type_errors let anomaly_string () = str "Anomaly: " -let report () = (str "." ++ spc () ++ str "Please report" ++ - strbrk "at " ++ str Coq_config.wwwbugtracker ++ str ".") +let report () = strbrk (". Please report at " ^ Coq_config.wwwbugtracker ^ ".") let guill s = str "\"" ++ str s ++ str "\"" -let where s = - if !Flags.debug then (str"in " ++ str s ++ str":" ++ spc ()) else (mt ()) - -let rec explain_exn = function +let explain_exn = function | Stream.Failure -> hov 0 (anomaly_string () ++ str "uncaught Stream.Failure.") | Stream.Error txt -> hov 0 (str "Syntax error: " ++ str txt) | Sys_error msg -> hov 0 (anomaly_string () ++ str "uncaught exception Sys_error " ++ guill msg ++ report() ) - | UserError(s,pps) -> - hov 1 (str "User error: " ++ where s ++ pps) + | UserError pps -> + hov 1 (str "User error: " ++ pps) | Out_of_memory -> hov 0 (str "Out of memory") | Stack_overflow -> hov 0 (str "Stack overflow") | Match_failure(filename,pos1,pos2) -> hov 1 (anomaly_string () ++ str "Match failure in file " ++ - guill filename ++ str " at line " ++ int pos1 ++ - str " character " ++ int pos2 ++ report ()) + 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 -> @@ -243,15 +240,14 @@ | Invalid_argument s -> hov 0 (anomaly_string () ++ str "uncaught exception Invalid_argument " ++ guill s ++ report ()) | Sys.Break -> - hov 0 (fnl () ++ str "User interrupt.") - | Univ.UniverseInconsistency (o,u,v) -> - let msg = - if !Flags.debug (*!Constrextern.print_universes*) then - spc() ++ str "(cannot enforce" ++ spc() ++ Univ.pr_uni u ++ spc() ++ - str (match o with Univ.Lt -> "<" | Univ.Le -> "<=" | Univ.Eq -> "=") - ++ spc() ++ Univ.pr_uni v ++ str")" - else - mt() in + hov 0 (fnl () ++ str "User interrupt.") + | Univ.UniverseInconsistency i -> + let msg = + if CDebug.(get_flag misc) then + str "." ++ spc() ++ + Univ.explain_universe_inconsistency Univ.Level.pr i + else + mt() in hov 0 (str "Error: Universe inconsistency" ++ msg ++ str ".") | TypeError(ctx,te) -> hov 0 (str "Type error: " ++ @@ -268,45 +264,53 @@ | IllFormedBranch _ -> str"IllFormedBranch" | Generalization _ -> str"Generalization" | ActualType _ -> str"ActualType" - | CantApplyBadType ((n,a,b),(hd,hdty),args) -> - Format.printf "====== ill-typed term ====@\n"; - Format.printf "@[application head=@ "; - Print.print_pure_constr hd; - Format.printf "@]@\n@[head type=@ "; - Print.print_pure_constr hdty; - Format.printf "@]@\narguments:@\n@["; - Array.iteri (fun i (t,ty) -> - Format.printf "@[arg %d=@ " (i+1); - Print.print_pure_constr t; - Format.printf "@ type=@ "; - Print.print_pure_constr ty) args; - Format.printf "@]@\n====== type error ====@\n"; - Print.print_pure_constr b; - Format.printf "@\nis not convertible with@\n"; - Print.print_pure_constr a; - Format.printf "@\n====== universes ====@\n"; - chk_pp - (Univ.pr_universes - (ctx.Environ.env_stratification.Environ.env_universes)); - str "\nCantApplyBadType at argument " ++ int n + | IncorrectPrimitive _ -> str"IncorrectPrimitive" + | CantApplyBadType ((n,a,b),{uj_val = hd; uj_type = hdty},args) -> + let pp_arg i judge = + hv 1 (str"arg " ++ int (i+1) ++ str"= " ++ + Constr.debug_print judge.uj_val ++ + str ",type= " ++ Constr.debug_print judge.uj_type) ++ fnl () + in + Feedback.msg_notice (str"====== ill-typed term ====" ++ fnl () ++ + hov 2 (str"application head= " ++ Constr.debug_print hd) ++ fnl () ++ + hov 2 (str"head type= " ++ Constr.debug_print hdty) ++ fnl () ++ + str"arguments:" ++ fnl () ++ hv 1 (prvecti pp_arg args)); + Feedback.msg_notice (str"====== type error ====@" ++ fnl () ++ + Constr.debug_print b ++ fnl () ++ + str"is not convertible with" ++ fnl () ++ + Constr.debug_print a ++ fnl ()); + Feedback.msg_notice (str"====== universes ====" ++ fnl () ++ + (UGraph.pr_universes Univ.Level.pr + (UGraph.repr (ctx.Environ.env_universes)))); + str "CantApplyBadType at argument " ++ int n | CantApplyNonFunctional _ -> str"CantApplyNonFunctional" | IllFormedRecBody _ -> str"IllFormedRecBody" | IllTypedRecBody _ -> str"IllTypedRecBody" - | UnsatisfiedConstraints _ -> str"UnsatisfiedConstraints")) + | UnsatisfiedConstraints _ -> str"UnsatisfiedConstraints" + | DisallowedSProp -> str"DisallowedSProp" + | BadRelevance -> str"BadRelevance" + | BadInvert -> str"BadInvert" + | UndeclaredUniverse _ -> str"UndeclaredUniverse" + | BadVariance _ -> str "BadVariance" + )) - | Indtypes.InductiveError e -> + | InductiveError e -> hov 0 (str "Error related to inductive types") (* let ctx = Check.get_env() in hov 0 (str "Error:" ++ spc () ++ Himsg.explain_inductive_error ctx e)*) + + | CheckInductive.InductiveMismatch (mind,field) -> + hov 0 (MutInd.print mind ++ str ": field " ++ str field ++ str " is incorrect.") + | Assert_failure (s,b,e) -> hov 0 (anomaly_string () ++ str "assert failure" ++ spc () ++ - (if s = "" then mt () - else - (str "(file \"" ++ str s ++ str "\", line " ++ int b ++ - str ", characters " ++ int e ++ str "-" ++ - int (e+6) ++ str ")")) ++ - report ()) + (if s = "" then mt () + else + (str "(file \"" ++ str s ++ str "\", line " ++ int b ++ + str ", characters " ++ int e ++ str "-" ++ + int (e+6) ++ str ")")) ++ + report ()) | e -> CErrors.print e (* for anomalies and other uncaught exceptions *) let parse_args argv = @@ -315,32 +319,29 @@ | "-impredicative-set" :: rem -> set_impredicative_set (); parse rem + | "-indices-matter" :: rem -> + indices_matter:=true; parse rem + | "-coqlib" :: s :: rem -> - if not (exists_dir s) then - fatal_error (str "Directory '" ++ str s ++ str "' does not exist") false; - Flags.coqlib := s; - Flags.coqlib_spec := true; + if not (exists_dir s) then + fatal_error (str "Directory '" ++ str s ++ str "' does not exist") false; + Boot.Env.set_coqlib s; parse rem - | ("-I"|"-include") :: d :: "-as" :: p :: rem -> set_include d p; parse rem - | ("-I"|"-include") :: d :: "-as" :: [] -> usage () - | ("-I"|"-include") :: d :: rem -> set_default_include d; parse rem - | ("-I"|"-include") :: [] -> usage () + | ("-Q"|"-R") :: d :: p :: rem -> set_include d p;parse rem + | ("-Q"|"-R") :: ([] | [_]) -> usage () - | "-R" :: d :: p :: rem -> set_rec_include d p;parse rem - | "-R" :: ([] | [_]) -> usage () - - | "-debug" :: rem -> set_debug (); parse rem + | "-debug" :: rem -> CDebug.set_debug_all true; parse rem | "-where" :: _ -> - Envars.set_coqlib ~fail:CErrors.error; - print_endline (Envars.coqlib ()); - exit 0 + let env = Boot.Env.init () in + let coqlib = Boot.Env.coqlib env |> Boot.Path.to_string in + print_endline coqlib; + exit 0 | ("-?"|"-h"|"-H"|"-help"|"--help") :: _ -> usage () | ("-v"|"--version") :: _ -> version () - | "-boot" :: rem -> boot := true; parse rem | ("-m" | "--memory") :: rem -> Check_stat.memory_stat := true; parse rem | ("-o" | "--output-context") :: rem -> Check_stat.output_context := true; parse rem @@ -352,7 +353,7 @@ | "-norec" :: [] -> usage () | "-silent" :: rem -> - Flags.make_silent true; parse rem + Flags.quiet := true; parse rem | s :: _ when s<>"" && s.[0]='-' -> fatal_error (str "Unknown option " ++ str s) false @@ -361,32 +362,33 @@ parse (List.tl (Array.to_list argv)) -(* To prevent from doing the initialization twice *) -let initialized = ref false - +(* XXX: At some point we need to either port the checker to use the + feedback system or to remove its use completely. *) let init_with_argv argv = - if not !initialized then begin - initialized := true; - Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *) - try - parse_args argv; - if !Flags.debug then Printexc.record_backtrace true; - Envars.set_coqlib ~fail:CErrors.error; - if_verbose print_header (); - init_load_path (); - engage (); - with e -> - fatal_error (str "Error during initialization :" ++ (explain_exn e)) (is_anomaly e) - end + Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *) + let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in + try + parse_args argv; + CWarnings.set_flags ("+"^Typeops.warn_bad_relevance_name); + if CDebug.(get_flag misc) then Printexc.record_backtrace true; + Flags.if_verbose print_header (); + init_load_path (); + make_senv () + with e -> + fatal_error (str "Error during initialization :" ++ (explain_exn e)) (is_anomaly e) let init() = init_with_argv Sys.argv -let run () = +let run senv = try - compile_files (); - flush_all() + let senv = compile_files senv in + flush_all(); senv with e -> - if !Flags.debug then Printexc.print_backtrace stderr; + if CDebug.(get_flag misc) then Printexc.print_backtrace stderr; fatal_error (explain_exn e) (is_anomaly e) -let start () = init(); run(); Check_stat.stats(); exit 0 +let start () = + let senv = init() in + let senv, opac = run senv in + Check_stat.stats (Safe_typing.env_of_safe_env senv) opac; + exit 0 diff -Nru coq-doc-8.6/checker/checker.mli coq-doc-8.15.0/checker/checker.mli --- coq-doc-8.6/checker/checker.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/checker.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,11 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* unit diff -Nru coq-doc-8.6/checker/checkFlags.ml coq-doc-8.15.0/checker/checkFlags.ml --- coq-doc-8.6/checker/checkFlags.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/checkFlags.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,25 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* Environ.env -> Environ.env +(** Set flags except for those ignored by the checker (eg vm_compute). *) diff -Nru coq-doc-8.6/checker/checkInductive.ml coq-doc-8.15.0/checker/checkInductive.ml --- coq-doc-8.6/checker/checkInductive.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/checkInductive.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,201 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* None | FakeRecord -> Some None + | PrimRecord data -> Some (Some (Array.map (fun (x,_,_,_) -> x) data)) + in + let check_template ind = match ind.mind_arity with + | RegularArity _ -> false + | TemplateArity _ -> true + in + let mind_entry_template = Array.exists check_template mb.mind_packets in + let () = if mind_entry_template then assert (Array.for_all check_template mb.mind_packets) in + let mind_entry_universes = match mb.mind_universes with + | Monomorphic -> + (* We only need to rebuild the set of constraints for template polymorphic + inductive types. The set of monomorphic constraints is already part of + the graph at that point, but we need to emulate a broken bound variable + mechanism for template inductive types. *) + begin match mb.mind_template with + | None -> Monomorphic_ind_entry + | Some ctx -> Template_ind_entry ctx.template_context + end + | Polymorphic auctx -> Polymorphic_ind_entry (AbstractContext.repr auctx) + in + let ntyps = Array.length mb.mind_packets in + let mind_entry_inds = Array.map_to_list (fun ind -> + let mind_entry_arity = match ind.mind_arity with + | RegularArity ar -> + let ctx, arity = Term.decompose_prod_n_assum nparams ar.mind_user_arity in + ignore ctx; (* we will check that the produced user_arity is equal to the input *) + arity + | TemplateArity ar -> + let ctx = ind.mind_arity_ctxt in + let ctx = List.firstn (List.length ctx - nparams) ctx in + Term.mkArity (ctx, Sorts.sort_of_univ ar.template_level) + in + { + mind_entry_typename = ind.mind_typename; + mind_entry_arity; + mind_entry_consnames = Array.to_list ind.mind_consnames; + mind_entry_lc = Array.map_to_list (fun c -> + let c = Inductive.abstract_constructor_type_relatively_to_inductive_types_context ntyps mind c in + let ctx, c = Term.decompose_prod_n_assum nparams c in + ignore ctx; (* we will check that the produced user_lc is equal to the input *) + c + ) ind.mind_user_lc; + }) + mb.mind_packets + in + let mind_entry_variance = Option.map (Array.map (fun v -> Some v)) mb.mind_variance in + { + mind_entry_record; + mind_entry_finite = mb.mind_finite; + mind_entry_params = mb.mind_params_ctxt; + mind_entry_inds; + mind_entry_universes; + mind_entry_variance; + mind_entry_private = mb.mind_private; + } + +let check_arity env ar1 ar2 = match ar1, ar2 with + | RegularArity ar, RegularArity {mind_user_arity;mind_sort} -> + Constr.equal ar.mind_user_arity mind_user_arity && + Sorts.equal ar.mind_sort mind_sort + | TemplateArity ar, TemplateArity {template_level} -> + UGraph.check_leq (universes env) template_level ar.template_level + (* template_level is inferred by indtypes, so functor application can produce a smaller one *) + | (RegularArity _ | TemplateArity _), _ -> assert false + +let check_template ar1 ar2 = match ar1, ar2 with +| None, None -> true +| Some ar, Some {template_context; template_param_levels} -> + List.equal (Option.equal Univ.Level.equal) ar.template_param_levels template_param_levels && + ContextSet.equal template_context ar.template_context +| None, Some _ | Some _, None -> false + +let check_kelim k1 k2 = Sorts.family_leq k1 k2 + +(* Use [eq_ind_chk] because when we rebuild the recargs we have lost + the knowledge of who is the canonical version. + Try with to see test-suite/coqchk/include.v *) +let eq_nested_types ty1 ty2 = match ty1, ty2 with +| NestedInd ind1, NestedInd ind2 -> eq_ind_chk ind1 ind2 +| NestedInd _, _ -> false +| NestedPrimitive c1, NestedPrimitive c2 -> Names.Constant.CanOrd.equal c1 c2 +| NestedPrimitive _, _ -> false + +let eq_recarg a1 a2 = match a1, a2 with + | Norec, Norec -> true + | Mrec i1, Mrec i2 -> eq_ind_chk i1 i2 + | Nested ty1, Nested ty2 -> eq_nested_types ty1 ty2 + | (Norec | Mrec _ | Nested _), _ -> false + +let eq_reloc_tbl = Array.equal (fun x y -> Int.equal (fst x) (fst y) && Int.equal (snd x) (snd y)) + +let eq_in_context (ctx1, t1) (ctx2, t2) = + Context.Rel.equal Constr.equal ctx1 ctx2 && Constr.equal t1 t2 + +let check_packet env mind ind + { mind_typename; mind_arity_ctxt; mind_arity; mind_consnames; mind_user_lc; + mind_nrealargs; mind_nrealdecls; mind_kelim; mind_nf_lc; + mind_consnrealargs; mind_consnrealdecls; mind_recargs; mind_relevance; + mind_nb_constant; mind_nb_args; mind_reloc_tbl } = + let check = check mind in + + ignore mind_typename; (* passed through *) + check "mind_arity_ctxt" (Context.Rel.equal Constr.equal ind.mind_arity_ctxt mind_arity_ctxt); + check "mind_arity" (check_arity env ind.mind_arity mind_arity); + ignore mind_consnames; (* passed through *) + check "mind_user_lc" (Array.equal Constr.equal ind.mind_user_lc mind_user_lc); + check "mind_nrealargs" Int.(equal ind.mind_nrealargs mind_nrealargs); + check "mind_nrealdecls" Int.(equal ind.mind_nrealdecls mind_nrealdecls); + check "mind_kelim" (check_kelim ind.mind_kelim mind_kelim); + + check "mind_nf_lc" (Array.equal eq_in_context ind.mind_nf_lc mind_nf_lc); + (* NB: here syntactic equality is not just an optimisation, we also + care about the shape of the terms *) + + check "mind_consnrealargs" (Array.equal Int.equal ind.mind_consnrealargs mind_consnrealargs); + check "mind_consnrealdecls" (Array.equal Int.equal ind.mind_consnrealdecls mind_consnrealdecls); + + check "mind_recargs" (Rtree.equal eq_recarg ind.mind_recargs mind_recargs); + + check "mind_relevant" (Sorts.relevance_equal ind.mind_relevance mind_relevance); + + check "mind_nb_args" Int.(equal ind.mind_nb_args mind_nb_args); + check "mind_nb_constant" Int.(equal ind.mind_nb_constant mind_nb_constant); + check "mind_reloc_tbl" (eq_reloc_tbl ind.mind_reloc_tbl mind_reloc_tbl); + + () + +let check_same_record r1 r2 = match r1, r2 with + | NotRecord, NotRecord | FakeRecord, FakeRecord -> true + | PrimRecord r1, PrimRecord r2 -> + (* The kernel doesn't care about the names, we just need to check + that the saved types are correct. *) + Array.for_all2 (fun (_,_,r1,tys1) (_,_,r2,tys2) -> + Array.equal Sorts.relevance_equal r1 r2 && + Array.equal Constr.equal tys1 tys2) + r1 r2 + | (NotRecord | FakeRecord | PrimRecord _), _ -> false + +let check_inductive env mind mb = + let entry = to_entry mind mb in + let { mind_packets; mind_record; mind_finite; mind_ntypes; mind_hyps; + mind_nparams; mind_nparams_rec; mind_params_ctxt; + mind_universes; mind_template; mind_variance; mind_sec_variance; + mind_private; mind_typing_flags; } + = + (* Locally set typing flags for further typechecking *) + let env = CheckFlags.set_local_flags mb.mind_typing_flags env in + Indtypes.check_inductive env ~sec_univs:None mind entry + in + let check = check mind in + + Array.iter2 (check_packet env mind) mb.mind_packets mind_packets; + check "mind_record" (check_same_record mb.mind_record mind_record); + check "mind_finite" (mb.mind_finite == mind_finite); + check "mind_ntypes" Int.(equal mb.mind_ntypes mind_ntypes); + check "mind_hyps" (Context.Named.equal Constr.equal mb.mind_hyps mind_hyps); + check "mind_nparams" Int.(equal mb.mind_nparams mind_nparams); + + check "mind_nparams_rec" (mb.mind_nparams_rec <= mind_nparams_rec); + (* module substitution can increase the real number of recursively + uniform parameters, so be tolerant and use [<=]. *) + + check "mind_params_ctxt" (Context.Rel.equal Constr.equal mb.mind_params_ctxt mind_params_ctxt); + ignore mind_universes; (* Indtypes did the necessary checking *) + check "mind_template" (check_template mb.mind_template mind_template); + check "mind_variance" (Option.equal (Array.equal Univ.Variance.equal) + mb.mind_variance mind_variance); + check "mind_sec_variance" (Option.is_empty mind_sec_variance); + ignore mind_private; (* passed through Indtypes *) + + ignore mind_typing_flags; + (* TODO non oracle flags *) + + add_mind mind mb env diff -Nru coq-doc-8.6/checker/checkInductive.mli coq-doc-8.15.0/checker/checkInductive.mli --- coq-doc-8.6/checker/checkInductive.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/checkInductive.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,19 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* MutInd.t -> Declarations.mutual_inductive_body -> env diff -Nru coq-doc-8.6/checker/check.ml coq-doc-8.15.0/checker/check.ml --- coq-doc-8.6/checker/check.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/check.ml 2022-01-13 11:55:53.000000000 +0000 @@ -1,9 +1,11 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* - error ("Unknown library " ^ (DirPath.to_string dir)) - let library_full_filename dir = (find_library dir).library_filename (* If a library is loaded several time, then the first occurrence must @@ -84,43 +91,47 @@ (* Map from library names to table of opaque terms *) let opaque_tables = ref LibraryMap.empty -let opaque_univ_tables = ref LibraryMap.empty let access_opaque_table dp i = let t = try LibraryMap.find dp !opaque_tables with Not_found -> assert false in - assert (i < Array.length t); - Future.force t.(i) - -let access_opaque_univ_table dp i = - try - let t = LibraryMap.find dp !opaque_univ_tables in - assert (i < Array.length t); - Future.force t.(i) - with Not_found -> Univ.ContextSet.empty - + let i = Opaqueproof.repr_handle i in + let () = assert (0 <= i && i < Array.length t) in + t.(i) + +let indirect_accessor o = + let (sub, ci, dp, i) = Opaqueproof.repr o in + let c = access_opaque_table dp i in + let c = match c with + | None -> CErrors.user_err Pp.(str "Cannot access opaque delayed proof.") + | Some c -> c + in + let (c, prv) = Cooking.cook_constr ci c in + let c = Mod_subst.(List.fold_right subst_mps sub c) in + (c, prv) -let _ = Declarations.indirect_opaque_access := access_opaque_table -let _ = Declarations.indirect_opaque_univ_access := access_opaque_univ_table +let () = Mod_checking.set_indirect_accessor indirect_accessor -let check_one_lib admit (dir,m) = - let file = m.library_filename in +let check_one_lib admit senv (dir,m) = let md = m.library_compiled in let dig = m.library_digest in (* Look up if the library is to be admitted correct. We could also check if it carries a validation certificate (yet to be implemented). *) - if LibrarySet.mem dir admit then - (Flags.if_verbose Feedback.msg_notice - (str "Admitting library: " ++ pr_dirpath dir); - Safe_typing.unsafe_import file md m.library_extra_univs dig) - else - (Flags.if_verbose Feedback.msg_notice - (str "Checking library: " ++ pr_dirpath dir); - Safe_typing.import file md m.library_extra_univs dig); - register_loaded_library m + let senv = + if LibrarySet.mem dir admit then + (Flags.if_verbose Feedback.msg_notice + (str "Admitting library: " ++ pr_dirpath dir); + Safe_checking.unsafe_import (fst senv) md m.library_extra_univs dig), + (snd senv) + else + (Flags.if_verbose Feedback.msg_notice + (str "Checking library: " ++ pr_dirpath dir); + Safe_checking.import (fst senv) (snd senv) md m.library_extra_univs dig) + in + register_loaded_library m; senv (*************************************************************************) (*s Load path. Mapping from physical to logical paths etc.*) @@ -129,75 +140,46 @@ let load_paths = ref ([],[] : CUnix.physical_path list * logical_path list) -let get_load_paths () = fst !load_paths - -(* Hints to partially detects if two paths refer to the same repertory *) -let rec remove_path_dot p = - let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *) - let n = String.length curdir in - if String.length p > n && String.sub p 0 n = curdir then - remove_path_dot (String.sub p n (String.length p - n)) - else - p - -let strip_path p = - let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *) - let n = String.length cwd in - if String.length p > n && String.sub p 0 n = cwd then - remove_path_dot (String.sub p n (String.length p - n)) - else - remove_path_dot p - -let canonical_path_name p = - let current = Sys.getcwd () in - try - Sys.chdir p; - let p' = Sys.getcwd () in - Sys.chdir current; - p' - with Sys_error _ -> - (* We give up to find a canonical name and just simplify it... *) - strip_path p let find_logical_path phys_dir = - let phys_dir = canonical_path_name phys_dir in + let phys_dir = CUnix.canonical_path_name phys_dir in let physical, logical = !load_paths in match List.filter2 (fun p d -> p = phys_dir) physical logical with | _,[dir] -> dir | _,[] -> default_root_prefix - | _,l -> anomaly (Pp.str ("Two logical paths are associated to "^phys_dir)) + | _,l -> anomaly (Pp.str ("Two logical paths are associated to "^phys_dir^".")) let remove_load_path dir = let physical, logical = !load_paths in load_paths := List.filter2 (fun p d -> p <> dir) physical logical let add_load_path (phys_path,coq_path) = - if !Flags.debug then + if CDebug.(get_flag misc) then Feedback.msg_notice (str "path: " ++ pr_dirpath coq_path ++ str " ->" ++ spc() ++ str phys_path); - let phys_path = canonical_path_name phys_path in + let phys_path = CUnix.canonical_path_name phys_path in let physical, logical = !load_paths in match List.filter2 (fun p d -> p = phys_path) physical logical with | _,[dir] -> - if coq_path <> dir + if coq_path <> dir (* If this is not the default -I . to coqtop *) && not - (phys_path = canonical_path_name Filename.current_dir_name - && coq_path = default_root_prefix) - then - begin + (phys_path = CUnix.canonical_path_name Filename.current_dir_name + && coq_path = default_root_prefix) + then + begin (* Assume the user is concerned by library naming *) - if dir <> default_root_prefix then - Feedback.msg_warning - (str phys_path ++ strbrk " was previously bound to " ++ - pr_dirpath dir ++ strbrk "; it is remapped to " ++ - pr_dirpath coq_path); - remove_load_path phys_path; - load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths) - end + if dir <> default_root_prefix then + Feedback.msg_warning + (str phys_path ++ strbrk " was previously bound to " ++ + pr_dirpath dir ++ strbrk "; it is remapped to " ++ + pr_dirpath coq_path); + remove_load_path phys_path; + load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths) + end | _,[] -> - load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) - | _ -> anomaly (Pp.str ("Two logical paths are associated to "^phys_path)) + load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) + | _ -> anomaly (Pp.str ("Two logical paths are associated to "^phys_path^".")) let load_paths_of_dir_path dir = let physical, logical = !load_paths in @@ -227,13 +209,8 @@ let locate_qualified_library qid = try - let loadpath = - (* Search library in loadpath *) - if qid.dirpath=[] then get_load_paths () - else - (* we assume qid is an absolute dirpath *) - load_paths_of_dir_path (dir_of_path qid) - in + (* we assume qid is an absolute dirpath *) + let loadpath = load_paths_of_dir_path (dir_of_path qid) in if loadpath = [] then raise LibUnmappedDir; let name = qid.basename^".vo" in let path, file = System.where_in_path loadpath name in @@ -248,13 +225,14 @@ let error_unmapped_dir qid = let prefix = qid.dirpath in - errorlabstrm "load_absolute_library_from" + user_err (str "Cannot load " ++ pr_path qid ++ str ":" ++ spc () ++ - str "no physical path bound to" ++ spc () ++ pr_dirlist prefix ++ fnl ()) + str "no physical path bound to" ++ spc () ++ pr_dirlist prefix + ++ str "." ++ fnl ()) let error_lib_not_found qid = - errorlabstrm "load_absolute_library_from" - (str"Cannot find library " ++ pr_path qid ++ str" in loadpath") + user_err + (str "Cannot find library " ++ pr_path qid ++ str " in loadpath.") let try_locate_absolute_library dir = try @@ -263,7 +241,17 @@ | LibUnmappedDir -> error_unmapped_dir (path_of_dirpath dir) | LibNotFound -> error_lib_not_found (path_of_dirpath dir) -let try_locate_qualified_library qid = +let try_locate_qualified_library lib = match lib with +| PhysicalFile f -> + let () = + if not (System.file_exists_respecting_case "" f) then + error_lib_not_found { dirpath = []; basename = f; } + in + let dir = Filename.dirname f in + let base = Filename.chop_extension (Filename.basename f) in + let dir = extend_dirpath (find_logical_path dir) (Id.of_string base) in + (dir, f) +| LogicalFile qid -> try locate_qualified_library qid with @@ -274,12 +262,26 @@ (*s Low-level interning of libraries from files *) let raw_intern_library f = - System.raw_intern_state Coq_config.vo_magic_number f + ObjFile.open_in ~file:f (************************************************************************) (* Internalise libraries *) -open Cic +type summary_disk = { + md_name : compilation_unit_name; + md_deps : (compilation_unit_name * Safe_typing.vodigest) array; + md_ocaml : string; +} + +module Dyn = Dyn.Make () +type obj = Dyn.t (* persistent dynamic objects *) +type lib_objects = (Id.t * obj) list +type library_objects = lib_objects * lib_objects + +type library_disk = { + md_compiled : Safe_typing.compiled_library; + md_objects : library_objects; +} let mk_library sd md f table digest cst = { library_name = sd.md_name; @@ -295,71 +297,99 @@ pr_dirpath mdir ++ spc () ++ str "and not library" ++ spc() ++ pr_dirpath dir +type intern_mode = Rec | Root | Dep (* Rec = standard, Root = -norec, Dep = dependency of norec *) + (* Dependency graph *) let depgraph = ref LibraryMap.empty -let intern_from_file (dir, f) = +let marshal_in_segment ~validate ~value ~segment f ch = + let () = LargeFile.seek_in ch segment.ObjFile.pos in + if validate then + let v = + try + let v = Analyze.parse_channel ch in + let digest = Digest.input ch in + let () = if not (String.equal digest segment.ObjFile.hash) then raise Exit in + v + with _ -> + user_err (str "Corrupted file " ++ quote (str f)) + in + let () = Validate.validate value v in + let v = Analyze.instantiate v in + Obj.obj v + else + System.marshal_in f ch + +let marshal_or_skip ~validate ~value ~segment f ch = + if validate then + let v = marshal_in_segment ~validate:true ~value ~segment f ch in + Some v + else + None + +let intern_from_file ~intern_mode (dir, f) = + let validate = intern_mode <> Dep in Flags.if_verbose chk_pp (str"[intern "++str f++str" ..."); let (sd,md,table,opaque_csts,digest) = try + (* First pass to read the metadata of the file *) let ch = System.with_magic_number_check raw_intern_library f in - let (sd:Cic.summary_disk), _, digest = System.marshal_in_segment f ch in - let (md:Cic.library_disk), _, digest = System.marshal_in_segment f ch in - let (opaque_csts:'a option), _, udg = System.marshal_in_segment f ch in - let (discharging:'a option), _, _ = System.marshal_in_segment f ch in - let (tasks:'a option), _, _ = System.marshal_in_segment f ch in - let (table:Cic.opaque_table), pos, checksum = - System.marshal_in_segment f ch in + let seg_sd = ObjFile.get_segment ch ~segment:"summary" in + let seg_md = ObjFile.get_segment ch ~segment:"library" in + let seg_univs = ObjFile.get_segment ch ~segment:"universes" in + let seg_tasks = ObjFile.get_segment ch ~segment:"tasks" in + let seg_opaque = ObjFile.get_segment ch ~segment:"opaques" in + let () = ObjFile.close_in ch in + (* Actually read the data *) + let ch = open_in_bin f in + + let (sd:summary_disk) = marshal_in_segment ~validate ~value:Values.v_libsum ~segment:seg_sd f ch in + let (md:library_disk) = marshal_in_segment ~validate ~value:Values.v_lib ~segment:seg_md f ch in + let (opaque_csts:seg_univ option) = marshal_in_segment ~validate ~value:Values.v_univopaques ~segment:seg_univs f ch in + let (tasks:'a option) = marshal_in_segment ~validate ~value:Values.(Opt Any) ~segment:seg_tasks f ch in + let (table:seg_proofs option) = + marshal_or_skip ~validate ~value:Values.v_opaquetable ~segment:seg_opaque f ch in (* Verification of the final checksum *) let () = close_in ch in let ch = open_in_bin f in - if not (String.equal (Digest.channel ch pos) checksum) then - errorlabstrm "intern_from_file" (str "Checksum mismatch"); let () = close_in ch in + let () = System.check_caml_version ~caml:sd.md_ocaml ~file:f in if dir <> sd.md_name then - errorlabstrm "intern_from_file" + user_err (name_clash_message dir sd.md_name f); - if tasks <> None || discharging <> None then - errorlabstrm "intern_from_file" + if tasks <> None then + user_err (str "The file "++str f++str " contains unfinished tasks"); if opaque_csts <> None then begin - chk_pp (str " (was a vio file) "); - Option.iter (fun (_,_,b) -> if not b then - errorlabstrm "intern_from_file" + Flags.if_verbose chk_pp (str " (was a vio file) "); + Option.iter (fun (_,b) -> if not b then + user_err (str "The file "++str f++str " is still a .vio")) opaque_csts; - Validate.validate !Flags.debug Values.v_univopaques opaque_csts; end; - (* Verification of the unmarshalled values *) - Validate.validate !Flags.debug Values.v_libsum sd; - Validate.validate !Flags.debug Values.v_lib md; - Validate.validate !Flags.debug Values.v_opaques table; Flags.if_verbose chk_pp (str" done]" ++ fnl ()); let digest = - if opaque_csts <> None then Cic.Dviovo (digest,udg) - else (Cic.Dvo digest) in + let open ObjFile in + if opaque_csts <> None then Safe_typing.Dvivo (seg_md.hash, seg_univs.hash) + else (Safe_typing.Dvo_or_vi seg_md.hash) in sd,md,table,opaque_csts,digest with e -> Flags.if_verbose chk_pp (str" failed!]" ++ fnl ()); raise e in depgraph := LibraryMap.add sd.md_name sd.md_deps !depgraph; - opaque_tables := LibraryMap.add sd.md_name table !opaque_tables; - Option.iter (fun (opaque_csts,_,_) -> - opaque_univ_tables := - LibraryMap.add sd.md_name opaque_csts !opaque_univ_tables) - opaque_csts; + Option.iter (fun table -> opaque_tables := LibraryMap.add sd.md_name table !opaque_tables) table; let extra_cst = Option.default Univ.ContextSet.empty - (Option.map (fun (_,cs,_) -> cs) opaque_csts) in + (Option.map (fun (cs,_) -> cs) opaque_csts) in mk_library sd md f table digest extra_cst let get_deps (dir, f) = try LibraryMap.find dir !depgraph with Not_found -> - let _ = intern_from_file (dir,f) in + let _ = intern_from_file ~intern_mode:Dep (dir,f) in LibraryMap.find dir !depgraph (* Read a compiled library and all dependencies, in reverse order. Do not include files that are already in the context. *) -let rec intern_library seen (dir, f) needed = +let rec intern_library ~intern_mode seen (dir, f) needed = if LibrarySet.mem dir seen then failwith "Recursive dependencies!"; (* Look if in the current logical environment *) try let _ = find_library dir in needed @@ -368,12 +398,13 @@ if List.mem_assoc_f DirPath.equal dir needed then needed else (* [dir] is an absolute name which matches [f] which must be in loadpath *) - let m = intern_from_file (dir,f) in + let m = intern_from_file ~intern_mode (dir,f) in let seen' = LibrarySet.add dir seen in let deps = Array.map (fun (d,_) -> try_locate_absolute_library d) m.library_deps in - (dir,m) :: Array.fold_right (intern_library seen') deps needed + let intern_mode = match intern_mode with Rec -> Rec | Root | Dep -> Dep in + (dir,m) :: Array.fold_right (intern_library ~intern_mode seen') deps needed (* Compute the reflexive transitive dependency closure *) let rec fold_deps seen ff (dir,f) (s,acc) = @@ -392,12 +423,13 @@ let fold_deps_list ff modl acc = snd (fold_deps_list LibrarySet.empty ff modl (LibrarySet.empty,acc)) -let recheck_library ~norec ~admit ~check = +let recheck_library senv ~norec ~admit ~check = let ml = List.map try_locate_qualified_library check in let nrl = List.map try_locate_qualified_library norec in let al = List.map try_locate_qualified_library admit in - let needed = List.rev - (List.fold_right (intern_library LibrarySet.empty) (ml@nrl) []) in + let needed = List.fold_right (intern_library ~intern_mode:Rec LibrarySet.empty) ml [] in + let needed = List.fold_right (intern_library ~intern_mode:Root LibrarySet.empty) nrl needed in + let needed = List.rev needed in (* first compute the closure of norec, remove closure of check, add closure of admit, and finally remove norec and check *) let nochk = fold_deps_list LibrarySet.add nrl LibrarySet.empty in @@ -410,11 +442,6 @@ Flags.if_verbose Feedback.msg_notice (fnl()++hv 2 (str "Ordered list:" ++ fnl() ++ prlist (fun (dir,_) -> pr_dirpath dir ++ fnl()) needed)); - List.iter (check_one_lib nochk) needed; - Flags.if_verbose Feedback.msg_notice (str"Modules were successfully checked") - -open Printf - -let mem s = - let m = try_find_library s in - h 0 (str (sprintf "%dk" (CObj.size_kb m))) + let senv = List.fold_left (check_one_lib nochk) (senv, Cmap.empty) needed in + Flags.if_verbose Feedback.msg_notice (str"Modules were successfully checked"); + senv diff -Nru coq-doc-8.6/checker/check.mli coq-doc-8.15.0/checker/check.mli --- coq-doc-8.6/checker/check.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/check.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,33 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* unit + +val recheck_library : safe_environment -> + norec:object_file list -> + admit:object_file list -> + check:object_file list -> safe_environment * Cset.t Cmap.t diff -Nru coq-doc-8.6/checker/check.mllib coq-doc-8.15.0/checker/check.mllib --- coq-doc-8.6/checker/check.mllib 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/check.mllib 1970-01-01 00:00:00.000000000 +0000 @@ -1,71 +0,0 @@ -Coq_config - -Hook -Terminal -Canary -Hashset -Hashcons -CSet -CMap -Int -Dyn -HMap -Option -Store -Exninfo -Backtrace -Flags -Control -Pp_control -Loc -CList -CString -Serialize -Stateid -CObj -CArray -CStack -Util -Pp -Ppstyle -Xml_datatype -Richpp -Feedback -Segmenttree -Unicodetable -Unicode -CErrors -CWarnings -CEphemeron -Future -CUnix - -Minisys -System -Profile -RemoteCounter -Envars -Predicate -Rtree -Names -Univ -Esubst -Term -Print -Declarations -Environ -Closure -Reduction -Type_errors -Modops -Inductive -Typeops -Indtypes -Subtyping -Mod_checking -Safe_typing -Values -Validate -Check -Check_stat -Checker diff -Nru coq-doc-8.6/checker/check_stat.ml coq-doc-8.15.0/checker/check_stat.ml --- coq-doc-8.6/checker/check_stat.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/check_stat.ml 2022-01-13 11:55:53.000000000 +0000 @@ -1,14 +1,15 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* str "Theory: Set is impredicative" - | PredicativeSet -> str "Theory: Set is predicative" - end - -let cst_filter f csts = - Cmap_env.fold - (fun c ce acc -> if f c ce then c::acc else acc) - csts [] +let pr_impredicative_set env = + if is_impredicative_set env then str "Theory: Set is impredicative" + else str "Theory: Set is predicative" -let is_ax _ cb = not (constant_has_body cb) - -let pr_ax csts = - let axs = cst_filter is_ax csts in +let pr_assumptions ass axs = if axs = [] then - str "Axioms: " + str ass ++ str ": " else - hv 2 (str "Axioms:" ++ fnl() ++ prlist_with_sep fnl Indtypes.prcon axs) + hv 2 (str ass ++ str ":" ++ fnl() ++ prlist_with_sep fnl str axs) + +let pr_axioms env opac = + let add c cb acc = + if Declareops.constant_has_body cb then acc else + match Cmap.find_opt c opac with + | None -> Cset.add c acc + | Some s -> Cset.union s acc in + let csts = fold_constants add env Cset.empty in + let csts = Cset.fold (fun c acc -> Constant.to_string c :: acc) csts [] in + pr_assumptions "Axioms" csts + +let pr_type_in_type env = + let csts = fold_constants (fun c cb acc -> if not cb.const_typing_flags.check_universes then Constant.to_string c :: acc else acc) env [] in + let csts = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_universes then MutInd.to_string c :: acc else acc) env csts in + pr_assumptions "Constants/Inductives relying on type-in-type" csts + +let pr_unguarded env = + let csts = fold_constants (fun c cb acc -> if not cb.const_typing_flags.check_guarded then Constant.to_string c :: acc else acc) env [] in + let csts = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_guarded then MutInd.to_string c :: acc else acc) env csts in + pr_assumptions "Constants/Inductives relying on unsafe (co)fixpoints" csts + +let pr_nonpositive env = + let inds = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_positive then MutInd.to_string c :: acc else acc) env [] in + pr_assumptions "Inductives whose positivity is assumed" inds -let print_context env = +let print_context env opac = if !output_context then begin - let - {env_globals= - {env_constants=csts; env_inductives=inds; - env_modules=mods; env_modtypes=mtys}; - env_stratification= - {env_universes=univ; env_engagement=engt}} = env in Feedback.msg_notice (hov 0 (fnl() ++ str"CONTEXT SUMMARY" ++ fnl() ++ str"===============" ++ fnl() ++ fnl() ++ - str "* " ++ hov 0 (pr_engagement engt ++ fnl()) ++ fnl() ++ - str "* " ++ hov 0 (pr_ax csts))); + str "* " ++ hov 0 (pr_impredicative_set env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_axioms env opac ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_type_in_type env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_unguarded env ++ fnl()) ++ fnl() ++ + str "* " ++ hov 0 (pr_nonpositive env ++ fnl())) + ) end -let stats () = - print_context (Safe_typing.get_env()); +let stats env opac = + print_context env opac; print_memory_stat () diff -Nru coq-doc-8.6/checker/check_stat.mli coq-doc-8.15.0/checker/check_stat.mli --- coq-doc-8.6/checker/check_stat.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/check_stat.mli 2022-01-13 11:55:53.000000000 +0000 @@ -1,12 +1,13 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit +val stats : Environ.env -> Names.Cset.t Names.Cmap.t -> unit diff -Nru coq-doc-8.6/checker/checkTypes.ml coq-doc-8.15.0/checker/checkTypes.ml --- coq-doc-8.6/checker/checkTypes.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/checkTypes.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,36 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* () + | _ -> failwith "not the correct sort" + +let check_polymorphic_arity env params par = + let pl = par.template_param_levels in + let rec check_p env pl params = + let open Context.Rel.Declaration in + match pl, params with + Some u::pl, LocalAssum (na,ty)::params -> + check_kind env ty u; + check_p (push_rel (LocalAssum (na,ty)) env) pl params + | None::pl,d::params -> check_p (push_rel d env) pl params + | [], _ -> () + | _ -> failwith "check_poly: not the right number of params" in + check_p env pl (List.rev params) diff -Nru coq-doc-8.6/checker/checkTypes.mli coq-doc-8.15.0/checker/checkTypes.mli --- coq-doc-8.6/checker/checkTypes.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/checkTypes.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,20 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* rel_context -> template_universes -> unit diff -Nru coq-doc-8.6/checker/cic.mli coq-doc-8.15.0/checker/cic.mli --- coq-doc-8.6/checker/cic.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/cic.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,461 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* red_kind - val fVAR : Id.t -> red_kind - val no_red : reds - val red_add : reds -> red_kind -> reds - val mkflags : red_kind list -> reds - val red_set : reds -> red_kind -> bool -end - -module RedFlags = (struct - - (* [r_const=(true,cl)] means all constants but those in [cl] *) - (* [r_const=(false,cl)] means only those in [cl] *) - (* [r_delta=true] just mean [r_const=(true,[])] *) - - type reds = { - r_beta : bool; - r_delta : bool; - r_const : transparent_state; - r_zeta : bool; - r_evar : bool; - r_iota : bool } - - type red_kind = BETA | DELTA | IOTA | ZETA - | CONST of constant | VAR of Id.t - let fBETA = BETA - let fDELTA = DELTA - let fIOTA = IOTA - let fZETA = ZETA - let fCONST kn = CONST kn - let fVAR id = VAR id - let no_red = { - r_beta = false; - r_delta = false; - r_const = all_opaque; - r_zeta = false; - r_evar = false; - r_iota = false } - - let red_add red = function - | BETA -> { red with r_beta = true } - | DELTA -> { red with r_delta = true; r_const = all_transparent } - | CONST kn -> - let (l1,l2) = red.r_const in - { red with r_const = l1, Cpred.add kn l2 } - | IOTA -> { red with r_iota = true } - | ZETA -> { red with r_zeta = true } - | VAR id -> - let (l1,l2) = red.r_const in - { red with r_const = Id.Pred.add id l1, l2 } - - let mkflags = List.fold_left red_add no_red - - let red_set red = function - | BETA -> incr_cnt red.r_beta beta - | CONST kn -> - let (_,l) = red.r_const in - let c = Cpred.mem kn l in - incr_cnt c delta - | VAR id -> (* En attendant d'avoir des kn pour les Var *) - let (l,_) = red.r_const in - let c = Id.Pred.mem id l in - incr_cnt c delta - | ZETA -> incr_cnt red.r_zeta zeta - | IOTA -> incr_cnt red.r_iota iota - | DELTA -> (* Used for Rel/Var defined in context *) - incr_cnt red.r_delta delta - -end : RedFlagsSig) - -open RedFlags - -let betadeltaiota = mkflags [fBETA;fDELTA;fZETA;fIOTA] -let betadeltaiotanolet = mkflags [fBETA;fDELTA;fIOTA] -let betaiotazeta = mkflags [fBETA;fIOTA;fZETA] - -(* specification of the reduction function *) - - -(* Flags of reduction and cache of constants: 'a is a type that may be - * mapped to constr. 'a infos implements a cache for constants and - * abstractions, storing a representation (of type 'a) of the body of - * this constant or abstraction. - * * i_tab is the cache table of the results - * * i_repr is the function to get the representation from the current - * state of the cache and the body of the constant. The result - * is stored in the table. - * * i_rels = (4,[(1,c);(3,d)]) means there are 4 free rel variables - * and only those with index 1 and 3 have bodies which are c and d resp. - * - * ref_value_cache searchs in the tab, otherwise uses i_repr to - * compute the result and store it in the table. If the constant can't - * be unfolded, returns None, but does not store this failure. * This - * doesn't take the RESET into account. You mustn't keep such a table - * after a Reset. * This type is not exported. Only its two - * instantiations (cbv or lazy) are. - *) - -type 'a tableKey = - | ConstKey of 'a - | VarKey of Id.t - | RelKey of int - -type table_key = constant puniverses tableKey - -module KeyHash = -struct - type t = table_key - let equal k1 k2 = match k1, k2 with - | ConstKey (c1,u1), ConstKey (c2,u2) -> Constant.UserOrd.equal c1 c2 - && Univ.Instance.equal u1 u2 - | VarKey id1, VarKey id2 -> Id.equal id1 id2 - | RelKey i1, RelKey i2 -> Int.equal i1 i2 - | (ConstKey _ | VarKey _ | RelKey _), _ -> false - - open Hashset.Combine - - let hash = function - | ConstKey (c,u) -> combinesmall 1 (Constant.UserOrd.hash c) - | VarKey id -> combinesmall 2 (Id.hash id) - | RelKey i -> combinesmall 3 (Int.hash i) -end - -module KeyTable = Hashtbl.Make(KeyHash) - -type 'a infos = { - i_flags : reds; - i_repr : 'a infos -> constr -> 'a; - i_env : env; - i_rels : int * (int * constr) list; - i_tab : 'a KeyTable.t } - -let ref_value_cache info ref = - try - Some (KeyTable.find info.i_tab ref) - with Not_found -> - try - let body = - match ref with - | RelKey n -> - let (s,l) = info.i_rels in lift n (Int.List.assoc (s-n) l) - | VarKey id -> raise Not_found - | ConstKey cst -> constant_value info.i_env cst - in - let v = info.i_repr info body in - KeyTable.add info.i_tab ref v; - Some v - with - | Not_found (* List.assoc *) - | NotEvaluableConst _ (* Const *) - -> None - -let defined_rels flags env = -(* if red_local_const (snd flags) then*) - fold_rel_context - (fun decl (i,subs) -> - match decl with - | LocalAssum _ -> (i+1, subs) - | LocalDef (_,body,_) -> (i+1, (i,body) :: subs)) - (rel_context env) ~init:(0,[]) -(* else (0,[])*) - -let mind_equiv_infos info = mind_equiv info.i_env - -let eq_table_key = KeyHash.equal - -let create mk_cl flgs env = - { i_flags = flgs; - i_repr = mk_cl; - i_env = env; - i_rels = defined_rels flgs env; - i_tab = KeyTable.create 17 } - - -(**********************************************************************) -(* Lazy reduction: the one used in kernel operations *) - -(* type of shared terms. fconstr and frterm are mutually recursive. - * Clone of the constr structure, but completely mutable, and - * annotated with reduction state (reducible or not). - * - FLIFT is a delayed shift; allows sharing between 2 lifted copies - * of a given term. - * - FCLOS is a delayed substitution applied to a constr - * - FLOCKED is used to erase the content of a reference that must - * be updated. This is to allow the garbage collector to work - * before the term is computed. - *) - -(* Norm means the term is fully normalized and cannot create a redex - when substituted - Cstr means the term is in head normal form and that it can - create a redex when substituted (i.e. constructor, fix, lambda) - Whnf means we reached the head normal form and that it cannot - create a redex when substituted - Red is used for terms that might be reduced -*) -type red_state = Norm | Cstr | Whnf | Red - -let neutr = function - | (Whnf|Norm) -> Whnf - | (Red|Cstr) -> Red - -type fconstr = { - mutable norm: red_state; - mutable term: fterm } - -and fterm = - | FRel of int - | FAtom of constr (* Metas and Sorts *) - | FCast of fconstr * cast_kind * fconstr - | FFlex of table_key - | FInd of pinductive - | FConstruct of pconstructor - | FApp of fconstr * fconstr array - | FProj of projection * fconstr - | FFix of fixpoint * fconstr subs - | FCoFix of cofixpoint * fconstr subs - | FCase of case_info * fconstr * fconstr * fconstr array - | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *) - | FLambda of int * (name * constr) list * constr * fconstr subs - | FProd of name * fconstr * fconstr - | FLetIn of name * fconstr * fconstr * constr * fconstr subs - | FEvar of existential_key * fconstr array (* why diff from kernel/closure? *) - | FLIFT of int * fconstr - | FCLOS of constr * fconstr subs - | FLOCKED - -let fterm_of v = v.term -let set_norm v = v.norm <- Norm - -(* Could issue a warning if no is still Red, pointing out that we loose - sharing. *) -let update v1 (no,t) = - if !share then - (v1.norm <- no; - v1.term <- t; - v1) - else {norm=no;term=t} - -(**********************************************************************) -(* The type of (machine) stacks (= lambda-bar-calculus' contexts) *) - -type stack_member = - | Zapp of fconstr array - | Zcase of case_info * fconstr * fconstr array - | ZcaseT of case_info * constr * constr array * fconstr subs - | Zproj of int * int * projection - | Zfix of fconstr * stack - | Zshift of int - | Zupdate of fconstr - -and stack = stack_member list - -let append_stack v s = - if Array.length v = 0 then s else - match s with - | Zapp l :: s -> Zapp (Array.append v l) :: s - | _ -> Zapp v :: s - -(* Collapse the shifts in the stack *) -let zshift n s = - match (n,s) with - (0,_) -> s - | (_,Zshift(k)::s) -> Zshift(n+k)::s - | _ -> Zshift(n)::s - -(* 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. *) -let rec lft_fconstr n ft = - match ft.term with - | (FInd _|FConstruct _|FFlex(ConstKey _|VarKey _)) -> ft - | FRel i -> {norm=Norm;term=FRel(i+n)} - | FLambda(k,tys,f,e) -> {norm=Cstr; term=FLambda(k,tys,f,subs_shft(n,e))} - | FFix(fx,e) -> {norm=Cstr; term=FFix(fx,subs_shft(n,e))} - | FCoFix(cfx,e) -> {norm=Cstr; term=FCoFix(cfx,subs_shft(n,e))} - | FLIFT(k,m) -> lft_fconstr (n+k) m - | FLOCKED -> assert false - | _ -> {norm=ft.norm; term=FLIFT(n,ft)} -let lift_fconstr k f = - if k=0 then f else lft_fconstr k f -let lift_fconstr_vect k v = - if k=0 then v else Array.map (fun f -> lft_fconstr k f) v - -let clos_rel e i = - match expand_rel i e with - | Inl(n,mt) -> lift_fconstr n mt - | Inr(k,None) -> {norm=Norm; term= FRel k} - | Inr(k,Some p) -> - lift_fconstr (k-p) {norm=Red;term=FFlex(RelKey p)} - -(* since the head may be reducible, we might introduce lifts of 0 *) -let compact_stack head stk = - let rec strip_rec depth = function - | Zshift(k)::s -> strip_rec (depth+k) s - | Zupdate(m)::s -> - (* Be sure to create a new cell otherwise sharing would be - lost by the update operation *) - let h' = lft_fconstr depth head in - let _ = update m (h'.norm,h'.term) in - strip_rec depth s - | stk -> zshift depth stk in - strip_rec 0 stk - -(* Put an update mark in the stack, only if needed *) -let zupdate m s = - if !share && m.norm = Red - then - let s' = compact_stack m s in - let _ = m.term <- FLOCKED in - Zupdate(m)::s' - else s - -let mk_lambda env t = - let (rvars,t') = decompose_lam t in - FLambda(List.length rvars, List.rev rvars, t', env) - -let destFLambda clos_fun t = - match t.term with - FLambda(_,[(na,ty)],b,e) -> (na,clos_fun e ty,clos_fun (subs_lift e) b) - | FLambda(n,(na,ty)::tys,b,e) -> - (na,clos_fun e ty,{norm=Cstr;term=FLambda(n-1,tys,b,subs_lift e)}) - | _ -> assert false - -(* Optimization: do not enclose variables in a closure. - Makes variable access much faster *) -let mk_clos e t = - match t with - | Rel i -> clos_rel e i - | Var x -> { norm = Red; term = FFlex (VarKey x) } - | Const c -> { norm = Red; term = FFlex (ConstKey c) } - | Meta _ | Sort _ -> { norm = Norm; term = FAtom t } - | Ind kn -> { norm = Norm; term = FInd kn } - | Construct kn -> { norm = Cstr; term = FConstruct kn } - | (CoFix _|Lambda _|Fix _|Prod _|Evar _|App _|Case _|Cast _|LetIn _|Proj _) -> - {norm = Red; term = FCLOS(t,e)} - -let mk_clos_vect env v = Array.map (mk_clos env) v - -(* Translate the head constructor of t from constr to fconstr. This - function is parameterized by the function to apply on the direct - subterms. - Could be used insted of mk_clos. *) -let mk_clos_deep clos_fun env t = - match t with - | (Rel _|Ind _|Const _|Construct _|Var _|Meta _ | Sort _) -> - mk_clos env t - | Cast (a,k,b) -> - { norm = Red; - term = FCast (clos_fun env a, k, clos_fun env b)} - | App (f,v) -> - { norm = Red; - term = FApp (clos_fun env f, Array.map (clos_fun env) v) } - | Proj (p,c) -> - { norm = Red; - term = FProj (p, clos_fun env c) } - | Case (ci,p,c,v) -> - { norm = Red; term = FCaseT (ci, p, clos_fun env c, v, env) } - | Fix fx -> - { norm = Cstr; term = FFix (fx, env) } - | CoFix cfx -> - { norm = Cstr; term = FCoFix(cfx,env) } - | Lambda _ -> - { norm = Cstr; term = mk_lambda env t } - | Prod (n,t,c) -> - { norm = Whnf; - term = FProd (n, clos_fun env t, clos_fun (subs_lift env) c) } - | LetIn (n,b,t,c) -> - { norm = Red; - term = FLetIn (n, clos_fun env b, clos_fun env t, c, env) } - | Evar(ev,args) -> - { norm = Whnf; term = FEvar(ev,Array.map (clos_fun env) args) } - -(* A better mk_clos? *) -let mk_clos2 = mk_clos_deep mk_clos - -(* The inverse of mk_clos_deep: move back to constr *) -let rec to_constr constr_fun lfts v = - match v.term with - | FRel i -> Rel (reloc_rel i lfts) - | FFlex (RelKey p) -> Rel (reloc_rel p lfts) - | FFlex (VarKey x) -> Var x - | FAtom c -> exliftn lfts c - | FCast (a,k,b) -> - Cast (constr_fun lfts a, k, constr_fun lfts b) - | FFlex (ConstKey op) -> Const op - | FInd op -> Ind op - | FConstruct op -> Construct op - | FCase (ci,p,c,ve) -> - Case (ci, constr_fun lfts p, - constr_fun lfts c, - Array.map (constr_fun lfts) ve) - | FCaseT (ci,p,c,ve,e) -> (* TODO: enable sharing, cf FCLOS below ? *) - to_constr constr_fun lfts - {norm=Red;term=FCase(ci,mk_clos2 e p,c,mk_clos_vect e ve)} - | FFix ((op,(lna,tys,bds)),e) -> - let n = Array.length bds in - let ftys = Array.map (mk_clos e) tys in - let fbds = Array.map (mk_clos (subs_liftn n e)) bds in - let lfts' = el_liftn n lfts in - Fix (op, (lna, Array.map (constr_fun lfts) ftys, - Array.map (constr_fun lfts') fbds)) - | FCoFix ((op,(lna,tys,bds)),e) -> - let n = Array.length bds in - let ftys = Array.map (mk_clos e) tys in - let fbds = Array.map (mk_clos (subs_liftn n e)) bds in - let lfts' = el_liftn (Array.length bds) lfts in - CoFix (op, (lna, Array.map (constr_fun lfts) ftys, - Array.map (constr_fun lfts') fbds)) - | FApp (f,ve) -> - App (constr_fun lfts f, - Array.map (constr_fun lfts) ve) - | FProj (p,c) -> - Proj (p,constr_fun lfts c) - | FLambda _ -> - let (na,ty,bd) = destFLambda mk_clos2 v in - Lambda (na, constr_fun lfts ty, - constr_fun (el_lift lfts) bd) - | FProd (n,t,c) -> - Prod (n, constr_fun lfts t, - constr_fun (el_lift lfts) c) - | FLetIn (n,b,t,f,e) -> - let fc = mk_clos2 (subs_lift e) f in - LetIn (n, constr_fun lfts b, - constr_fun lfts t, - constr_fun (el_lift lfts) fc) - | FEvar (ev,args) -> Evar(ev,Array.map (constr_fun lfts) args) - | FLIFT (k,a) -> to_constr constr_fun (el_shft k lfts) a - | FCLOS (t,env) -> - let fr = mk_clos2 env t in - let unfv = update v (fr.norm,fr.term) in - to_constr constr_fun lfts unfv - | FLOCKED -> assert false (*mkVar(Id.of_string"_LOCK_")*) - -(* This function defines the correspondance between constr and - fconstr. When we find a closure whose substitution is the identity, - then we directly return the constr to avoid possibly huge - reallocation. *) -let term_of_fconstr = - let rec term_of_fconstr_lift lfts v = - match v.term with - | FCLOS(t,env) when is_subs_id env && is_lift_id lfts -> t - | FLambda(_,tys,f,e) when is_subs_id e && is_lift_id lfts -> - compose_lam (List.rev tys) f - | FCaseT(ci,p,c,b,env) when is_subs_id env && is_lift_id lfts -> - Case(ci,p,term_of_fconstr_lift lfts c,b) - | 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 el_id - - - -(* fstrong applies unfreeze_fun recursively on the (freeze) term and - * yields a term. Assumes that the unfreeze_fun never returns a - * FCLOS term. -let rec fstrong unfreeze_fun lfts v = - to_constr (fstrong unfreeze_fun) lfts (unfreeze_fun v) -*) - -let rec zip m stk = - match stk with - | [] -> m - | Zapp args :: s -> zip {norm=neutr m.norm; term=FApp(m, args)} s - | Zcase(ci,p,br)::s -> - let t = FCase(ci, p, m, br) in - zip {norm=neutr m.norm; term=t} s - | ZcaseT(ci,p,br,e)::s -> - let t = FCaseT(ci, p, m, br, e) in - zip {norm=neutr m.norm; term=t} s - | Zproj (i,j,cst) :: s -> - zip {norm=neutr m.norm; term=FProj (cst,m)} s - | Zfix(fx,par)::s -> - zip fx (par @ append_stack [|m|] s) - | Zshift(n)::s -> - zip (lift_fconstr n m) s - | Zupdate(rf)::s -> - zip (update rf (m.norm,m.term)) s - -let fapp_stack (m,stk) = zip m stk - -(*********************************************************************) - -(* The assertions in the functions below are granted because they are - called only when m is a constructor, a cofix - (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_app head stk = - assert (head.norm <> Red); - let rec strip_rec rstk h depth = function - | Zshift(k) as e :: s -> - strip_rec (e::rstk) (lift_fconstr k h) (depth+k) s - | (Zapp args :: s) -> - strip_rec (Zapp args :: rstk) - {norm=h.norm;term=FApp(h,args)} depth s - | Zupdate(m)::s -> - strip_rec rstk (update m (h.norm,h.term)) depth s - | stk -> (depth,List.rev rstk, stk) in - strip_rec [] head 0 stk - - -let get_nth_arg head n stk = - assert (head.norm <> Red); - let rec strip_rec rstk h n = function - | Zshift(k) as e :: 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)} (n-q) s' - else - let bef = Array.sub args 0 n in - let aft = Array.sub args (n+1) (q-n-1) in - let 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)) n s - | s -> (None, List.rev rstk @ s) in - 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 *) -let rec get_args n tys f e stk = - match stk with - Zupdate r :: s -> - let _hd = update r (Cstr,FLambda(n,tys,f,e)) in - get_args n tys f e s - | Zshift k :: s -> - get_args n tys f (subs_shft (k,e)) s - | Zapp l :: s -> - let na = Array.length l in - if n == na then (Inl (subs_cons(l,e)),s) - else if n < na then (* more arguments *) - let args = Array.sub l 0 n in - let eargs = Array.sub l n (na-n) in - (Inl (subs_cons(args,e)), Zapp eargs :: s) - else (* more lambdas *) - let etys = List.skipn na tys in - 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 _ | ZcaseT _ | Zproj _ - | 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 *) -let rec reloc_rargs_rec depth stk = - match stk with - Zapp args :: s -> - Zapp (lift_fconstr_vect depth args) :: reloc_rargs_rec depth s - | Zshift(k)::s -> if k=depth then s else reloc_rargs_rec (depth-k) s - | _ -> stk - -let reloc_rargs depth stk = - if depth = 0 then stk else reloc_rargs_rec depth stk - -let rec try_drop_parameters depth n argstk = - match argstk with - Zapp args::s -> - let q = Array.length args in - if n > q then try_drop_parameters depth (n-q) s - else if Int.equal n q then reloc_rargs depth s - else - let aft = Array.sub args n (q-n) in - reloc_rargs depth (append_stack aft s) - | Zshift(k)::s -> try_drop_parameters (depth-k) n s - | [] -> - if Int.equal n 0 then [] - else raise Not_found - | _ -> assert false - (* strip_update_shift_app only produces Zapp and Zshift items *) - -let drop_parameters depth n argstk = - try try_drop_parameters depth n argstk - with Not_found -> assert false - (* we know that n < stack_args_size(argstk) (if well-typed term) *) - -(** Projections and eta expansion *) - -let rec get_parameters depth n argstk = - match argstk with - Zapp args::s -> - let q = Array.length args in - if n > q then Array.append args (get_parameters depth (n-q) s) - else if Int.equal n q then [||] - else Array.sub args 0 n - | Zshift(k)::s -> - get_parameters (depth-k) n s - | [] -> (* we know that n < stack_args_size(argstk) (if well-typed term) *) - if Int.equal n 0 then [||] - else raise Not_found (* Trying to eta-expand a partial application..., should do - eta expansion first? *) - | _ -> assert false - (* strip_update_shift_app only produces Zapp and Zshift items *) - -let eta_expand_ind_stack env ind m s (f, s') = - let mib = lookup_mind (fst ind) env in - match mib.mind_record with - | Some (Some (_,projs,pbs)) when mib.mind_finite <> CoFinite -> - (* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') -> - arg1..argn ~= (proj1 t...projn t) where t = zip (f,s') *) - let pars = mib.mind_nparams in - let right = fapp_stack (f, s') in - let (depth, args, s) = strip_update_shift_app m s in - (** Try to drop the params, might fail on partially applied constructors. *) - let argss = try_drop_parameters depth pars args in - let hstack = - Array.map (fun p -> { norm = Red; (* right can't be a constructor though *) - term = FProj (Projection.make p false, right) }) projs in - argss, [Zapp hstack] - | _ -> raise Not_found (* disallow eta-exp for non-primitive records *) - -let rec project_nth_arg n argstk = - match argstk with - | Zapp args :: s -> - let q = Array.length args in - if n >= q then project_nth_arg (n - q) s - else (* n < q *) args.(n) - | _ -> assert false - (* After drop_parameters we have a purely applicative stack *) - - -(* Iota reduction: expansion of a fixpoint. - * Given a fixpoint and a substitution, returns the corresponding - * fixpoint body, and the substitution in which it should be - * evaluated: its first variables are the fixpoint bodies - * - * FCLOS(fix Fi {F0 := T0 .. Fn-1 := Tn-1}, S) - * -> (S. FCLOS(F0,S) . ... . FCLOS(Fn-1,S), Ti) - *) -(* does not deal with FLIFT *) -let contract_fix_vect fix = - let (thisbody, make_body, env, nfix) = - match fix with - | FFix (((reci,i),(_,_,bds as rdcl)),env) -> - (bds.(i), - (fun j -> { norm = Cstr; term = FFix (((reci,j),rdcl),env) }), - env, Array.length bds) - | FCoFix ((i,(_,_,bds as rdcl)),env) -> - (bds.(i), - (fun j -> { norm = Cstr; term = FCoFix ((j,rdcl),env) }), - env, Array.length bds) - | _ -> assert false - in - (subs_cons(Array.init nfix make_body, env), thisbody) - - -(*********************************************************************) -(* A machine that inspects the head of a term until it finds an - atom or a subterm that may produce a redex (abstraction, - constructor, cofix, letin, constant), or a neutral term (product, - inductive) *) -let rec knh info m stk = - match m.term with - | FLIFT(k,a) -> knh info a (zshift k stk) - | FCLOS(t,e) -> knht info e t (zupdate m stk) - | FLOCKED -> assert false - | FApp(a,b) -> knh info a (append_stack b (zupdate m stk)) - | FCase(ci,p,t,br) -> knh info t (Zcase(ci,p,br)::zupdate m stk) - | FCaseT(ci,p,t,br,env) -> knh info t (ZcaseT(ci,p,br,env)::zupdate m stk) - | FFix(((ri,n),(_,_,_)),_) -> - (match get_nth_arg m ri.(n) stk with - (Some(pars,arg),stk') -> knh info arg (Zfix(m,pars)::stk') - | (None, stk') -> (m,stk')) - | FCast(t,_,_) -> knh info t stk - - | FProj (p,c) -> - if red_set info.i_flags (fCONST (Projection.constant p)) then - (let pb = lookup_projection p (info.i_env) in - knh info c (Zproj (pb.proj_npars, pb.proj_arg, p) - :: zupdate m stk)) - else (m,stk) - -(* cases where knh stops *) - | (FFlex _|FLetIn _|FConstruct _|FEvar _| - FCoFix _|FLambda _|FRel _|FAtom _|FInd _|FProd _) -> - (m, stk) - -(* The same for pure terms *) -and knht info e t stk = - match t with - | App(a,b) -> - knht info e a (append_stack (mk_clos_vect e b) stk) - | Case(ci,p,t,br) -> knht info e t (ZcaseT(ci, p, br, e)::stk) - | Fix _ -> knh info (mk_clos2 e t) stk (* laziness *) - | Cast(a,_,_) -> knht info e a stk - | Rel n -> knh info (clos_rel e n) stk - | Proj (p,c) -> knh info (mk_clos2 e t) stk (* laziness *) - | (Lambda _|Prod _|Construct _|CoFix _|Ind _| - LetIn _|Const _|Var _|Evar _|Meta _|Sort _) -> - (mk_clos2 e t, stk) - - -(************************************************************************) - -(* Computes a weak head normal form from the result of knh. *) -let rec knr info m stk = - match m.term with - | FLambda(n,tys,f,e) when red_set info.i_flags fBETA -> - (match get_args n tys f e stk with - Inl e', s -> knit info e' f s - | Inr lam, s -> (lam,s)) - | FFlex(ConstKey kn) when red_set info.i_flags (fCONST (fst kn)) -> - (match ref_value_cache info (ConstKey kn) with - Some v -> kni info v stk - | None -> (set_norm m; (m,stk))) - | FFlex(VarKey id) when red_set info.i_flags (fVAR id) -> - (match ref_value_cache info (VarKey id) with - Some v -> kni info v stk - | None -> (set_norm m; (m,stk))) - | FFlex(RelKey k) when red_set info.i_flags fDELTA -> - (match ref_value_cache info (RelKey k) with - Some v -> kni info v stk - | None -> (set_norm m; (m,stk))) - | FConstruct((ind,c),u) when red_set info.i_flags fIOTA -> - (match strip_update_shift_app m stk with - (depth, args, Zcase(ci,_,br)::s) -> - assert (ci.ci_npar>=0); - let rargs = drop_parameters depth ci.ci_npar args in - kni info br.(c-1) (rargs@s) - | (depth, args, ZcaseT(ci,_,br,env)::s) -> - assert (ci.ci_npar>=0); - let rargs = drop_parameters depth ci.ci_npar args in - knit info env br.(c-1) (rargs@s) - | (_, cargs, Zfix(fx,par)::s) -> - let rarg = fapp_stack(m,cargs) in - let stk' = par @ append_stack [|rarg|] s in - let (fxe,fxbd) = contract_fix_vect fx.term in - knit info fxe fxbd stk' - | (depth, args, Zproj (n, m, cst)::s) -> - let rargs = drop_parameters depth n args in - let rarg = project_nth_arg m rargs in - kni info rarg s - | (_,args,s) -> (m,args@s)) - | FCoFix _ when red_set info.i_flags fIOTA -> - (match strip_update_shift_app m stk with - (_, args, (((Zcase _|ZcaseT _)::_) as stk')) -> - let (fxe,fxbd) = contract_fix_vect m.term in - knit info fxe fxbd (args@stk') - | (_,args,s) -> (m,args@s)) - | FLetIn (_,v,_,bd,e) when red_set info.i_flags fZETA -> - knit info (subs_cons([|v|],e)) bd stk - | _ -> (m,stk) - -(* Computes the weak head normal form of a term *) -and kni info m stk = - let (hm,s) = knh info m stk in - knr info hm s -and knit info e t stk = - let (ht,s) = knht info e t stk in - knr info ht s - -let kh info v stk = fapp_stack(kni info v stk) - -(************************************************************************) -(* Initialization and then normalization *) - -(* weak reduction *) -let whd_val info v = - with_stats (lazy (term_of_fconstr (kh info v []))) - -let inject = mk_clos (subs_id 0) - -let whd_stack infos m stk = - let k = kni infos m stk in - let _ = fapp_stack k in (* to unlock Zupdates! *) - k - -(* cache of constants: the body is computed only when needed. *) -type clos_infos = fconstr infos - -let infos_env x = x.i_env -let infos_flags x = x.i_flags - -let create_clos_infos flgs env = - create (fun _ -> inject) flgs env - -let unfold_reference = ref_value_cache diff -Nru coq-doc-8.6/checker/closure.mli coq-doc-8.15.0/checker/closure.mli --- coq-doc-8.6/checker/closure.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/closure.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,186 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* 'a - -(*s Delta implies all consts (both global (= by - [kernel_name]) and local (= by [Rel] or [Var])), all evars, and letin's. - Rem: reduction of a Rel/Var bound to a term is Delta, but reduction of - a LetIn expression is Letin reduction *) - -type transparent_state = Id.Pred.t * Cpred.t - -val all_opaque : transparent_state -val all_transparent : transparent_state - -val is_transparent_variable : transparent_state -> variable -> bool -val is_transparent_constant : transparent_state -> constant -> bool - -(* Sets of reduction kinds. *) -module type RedFlagsSig = sig - type reds - type red_kind - - (* The different kinds of reduction *) - val fBETA : red_kind - val fDELTA : red_kind - val fIOTA : red_kind - val fZETA : red_kind - val fCONST : constant -> red_kind - val fVAR : Id.t -> red_kind - - (* No reduction at all *) - val no_red : reds - - (* Adds a reduction kind to a set *) - val red_add : reds -> red_kind -> 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 -end - -module RedFlags : RedFlagsSig -open RedFlags - -val betadeltaiota : reds -val betaiotazeta : reds -val betadeltaiotanolet : reds - -(***********************************************************************) -type 'a tableKey = - | ConstKey of 'a - | VarKey of Id.t - | RelKey of int - -type table_key = constant puniverses tableKey - -type 'a infos -val ref_value_cache: 'a infos -> table_key -> 'a option -val create: ('a infos -> constr -> 'a) -> reds -> env -> 'a infos - -(************************************************************************) -(*s Lazy reduction. *) - -(* [fconstr] is the type of frozen constr *) - -type fconstr - -(* [fconstr] can be accessed by using the function [fterm_of] and by - matching on type [fterm] *) - -type fterm = - | FRel of int - | FAtom of constr (* Metas and Sorts *) - | FCast of fconstr * cast_kind * fconstr - | FFlex of table_key - | FInd of pinductive - | FConstruct of pconstructor - | FApp of fconstr * fconstr array - | FProj of projection * fconstr - | FFix of fixpoint * fconstr subs - | FCoFix of cofixpoint * fconstr subs - | FCase of case_info * fconstr * fconstr * fconstr array - | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *) - | FLambda of int * (name * constr) list * constr * fconstr subs - | FProd of name * fconstr * fconstr - | FLetIn of name * fconstr * fconstr * constr * fconstr subs - | FEvar of existential_key * fconstr array - | FLIFT of int * fconstr - | FCLOS of constr * fconstr subs - | FLOCKED - -(************************************************************************) -(*s A [stack] is a context of arguments, arguments are pushed by - [append_stack] one array at a time but popped with [decomp_stack] - one by one *) - -type stack_member = - | Zapp of fconstr array - | Zcase of case_info * fconstr * fconstr array - | ZcaseT of case_info * constr * constr array * fconstr subs - | Zproj of int * int * projection - | Zfix of fconstr * stack - | Zshift of int - | Zupdate of fconstr - -and stack = stack_member list - -val append_stack : fconstr array -> stack -> stack -val eta_expand_stack : stack -> stack - -val eta_expand_ind_stack : env -> inductive -> fconstr -> stack -> - (fconstr * 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 - -val fterm_of : fconstr -> fterm -val term_of_fconstr : fconstr -> constr -val destFLambda : - (fconstr subs -> constr -> fconstr) -> fconstr -> name * fconstr * fconstr - -(* Global and local constant cache *) -type clos_infos -val create_clos_infos : reds -> env -> clos_infos -val infos_env : clos_infos -> env -val infos_flags : clos_infos -> reds - -(* Reduction function *) - -(* [whd_val] is for weak head normalization *) -val whd_val : clos_infos -> fconstr -> constr - -(* [whd_stack] performs weak head normalization in a given stack. It - stops whenever a reduction is blocked. *) -val whd_stack : - clos_infos -> fconstr -> stack -> fconstr * stack - -(* Conversion auxiliary functions to do step by step normalisation *) - -(* [unfold_reference] unfolds references in a [fconstr] *) -val unfold_reference : clos_infos -> table_key -> fconstr option - -(* [mind_equiv] checks whether two inductive types are intentionally equal *) -val mind_equiv_infos : clos_infos -> inductive -> inductive -> bool - -val eq_table_key : table_key -> table_key -> bool -(************************************************************************) -(*i This is for lazy debug *) - -val lift_fconstr : int -> fconstr -> fconstr -val lift_fconstr_vect : int -> fconstr array -> fconstr array - -val mk_clos : fconstr subs -> constr -> fconstr -val mk_clos_vect : fconstr subs -> constr array -> fconstr array -val mk_clos_deep : - (fconstr subs -> constr -> fconstr) -> - fconstr subs -> constr -> fconstr - -val kni: clos_infos -> fconstr -> stack -> fconstr * stack -val knr: clos_infos -> fconstr -> stack -> fconstr * stack - -val to_constr : (lift -> fconstr -> constr) -> lift -> fconstr -> constr - -(* End of cbn debug section i*) diff -Nru coq-doc-8.6/checker/coqchk.ml coq-doc-8.15.0/checker/coqchk.ml --- coq-doc-8.6/checker/coqchk.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/coqchk.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,2 @@ + +let _ = Checker.start () diff -Nru coq-doc-8.6/checker/coqchk.mli coq-doc-8.15.0/checker/coqchk.mli --- coq-doc-8.6/checker/coqchk.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/coqchk.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,12 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a -> 'a - -let empty_subst = Umap.empty - -let is_empty_subst = Umap.is_empty - -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 mp_in_delta mp = - Deltamap.mem_mp mp - -let find_prefix resolve mp = - let rec sub_mp = function - | 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 - -(** 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 Not_found - with Not_found -> - let mp,dir,l = KerName.repr kn in - let new_mp = find_prefix resolve mp in - if mp == new_mp then - kn - else - KerName.make new_mp dir l - -let gen_of_delta resolve x kn fix_can = - let new_kn = solve_delta_kn resolve kn in - if kn == new_kn then x else fix_can new_kn - -let constant_of_delta resolve con = - let kn = Constant.user con in - gen_of_delta resolve con kn (Constant.make kn) - -let constant_of_delta2 resolve con = - let kn, kn' = Constant.canonical con, Constant.user con in - gen_of_delta resolve con kn (Constant.make kn') - -let mind_of_delta resolve mind = - let kn = MutInd.user mind in - gen_of_delta resolve mind kn (MutInd.make kn) - -let mind_of_delta2 resolve mind = - let kn, kn' = MutInd.canonical mind, MutInd.user mind in - gen_of_delta resolve mind kn (MutInd.make kn') - -let find_inline_of_delta kn resolve = - match Deltamap.find_kn kn resolve with - | Inline (_,o) -> o - | _ -> raise Not_found - -let constant_of_delta_with_inline resolve con = - let kn1,kn2 = Constant.canonical con, Constant.user con in - 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 -> Umap.find_mp mp sub - | MPbound bid -> - begin - try Umap.find_mbi bid sub - with Not_found -> Umap.find_mp mp sub - end - | MPdot (mp1,l) as mp2 -> - begin - try Umap.find_mp mp2 sub - with Not_found -> - let mp1',resolve = aux mp1 in - MPdot (mp1',l),resolve - end - in - try Some (aux mp) with Not_found -> None - -let subst_mp sub mp = - match subst_mp0 sub mp with - None -> mp - | Some (mp',_) -> mp' - -let subst_kn_delta sub kn = - let mp,dir,l = KerName.repr kn in - match subst_mp0 sub mp with - Some (mp',resolve) -> - solve_delta_kn resolve (KerName.make mp' dir l) - | None -> kn - -let subst_kn sub kn = - let mp,dir,l = KerName.repr kn in - match subst_mp0 sub mp with - Some (mp',_) -> - KerName.make mp' dir l - | None -> kn - -exception No_subst - -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 make_mind_equiv mpu mpc dir l = - let knu = KerName.make mpu dir l in - if mpu == mpc then MutInd.make1 knu - else MutInd.make knu (KerName.make mpc dir l) - -let subst_ind sub mind = - let kn1,kn2 = MutInd.user mind, MutInd.canonical mind in - let mp1,dir,l = KerName.repr kn1 in - let mp2,_,_ = KerName.repr kn2 in - 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 make_con_equiv mpu mpc dir l = - let knu = KerName.make mpu dir l in - if mpu == mpc then Constant.make1 knu - else Constant.make knu (KerName.make mpc dir l) - -let subst_con0 sub con u = - let kn1,kn2 = Constant.user con, Constant.canonical con in - let mp1,dir,l = KerName.repr kn1 in - let mp2,_,_ = KerName.repr kn2 in - let rebuild_con mp1 mp2 = make_con_equiv mp1 mp2 dir l in - let dup con = con, Const (con, u) 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 - 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, u) -> (try snd (f' kn u) with No_subst -> c) - | Proj (p,t) -> - let p' = - Projection.map (fun kn -> - try fst (f' kn Univ.Instance.empty) - with No_subst -> kn) p - in - let t' = func t in - if p' == p && t' == t then c - else Proj (p', t') - | Ind ((kn,i),u) -> - let kn' = f kn in - if kn'==kn then c else Ind ((kn',i),u) - | Construct (((kn,i),j),u) -> - let kn' = f kn in - if kn'==kn then c else Construct (((kn',i),j),u) - | Case (ci,p,ct,l) -> - let ci_ind = - let (kn,i) = ci.ci_ind 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 - if (ci.ci_ind==ci_ind && p'==p - && l'==l && ct'==ct)then c - else - Case ({ci with ci_ind = ci_ind}, - p',ct', l') - | Cast (ct,k,t) -> - let ct' = func ct in - let t'= func t in - if (t'==t && ct'==ct) then c - else Cast (ct', k, t') - | Prod (na,t,ct) -> - let ct' = func ct in - let t'= func t in - if (t'==t && ct'==ct) then c - else Prod (na, t', ct') - | Lambda (na,t,ct) -> - let ct' = func ct in - let t'= func t in - if (t'==t && ct'==ct) then c - else Lambda (na, t', ct') - | LetIn (na,b,t,ct) -> - let ct' = func ct in - let t'= func t in - let b'= func b in - if (t'==t && ct'==ct && b==b') then c - else LetIn (na, b', t', ct') - | App (ct,l) -> - let ct' = func ct in - let l' = Array.smartmap func l in - if (ct'== ct && l'==l) then c - else App (ct',l') - | Evar (e,l) -> - let l' = Array.smartmap func l in - if (l'==l) then c - else Evar (e,l') - | Fix (ln,(lna,tl,bl)) -> - let tl' = Array.smartmap func tl in - let bl' = Array.smartmap func bl in - if (bl == bl'&& tl == tl') then c - else Fix (ln,(lna,tl',bl')) - | CoFix(ln,(lna,tl,bl)) -> - let tl' = Array.smartmap func tl in - let bl' = Array.smartmap func bl in - if (bl == bl'&& tl == tl') then c - else CoFix (ln,(lna,tl',bl')) - | _ -> c - -let subst_mps sub c = - if is_empty_subst sub then c - else map_kn (subst_ind sub) (subst_con0 sub) c - -let rec replace_mp_in_mp mpfrom mpto mp = - match mp with - | _ when ModPath.equal mp mpfrom -> mpto - | MPdot (mp1,l) -> - let mp1' = replace_mp_in_mp mpfrom mpto mp1 in - if mp1==mp1' then mp - else MPdot (mp1',l) - | _ -> mp - -let rec mp_in_mp mp mp1 = - match mp1 with - | _ when ModPath.equal mp1 mp -> true - | MPdot (mp2,l) -> mp_in_mp mp mp2 - | _ -> false - -let subset_prefixed_by mp resolver = - 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 (KerName.modpath kn) - then Deltamap.add_kn kn hint rslv - else rslv - in - Deltamap.fold mp_prefix kn_prefix resolver empty_delta_resolver - -let subst_dom_delta_resolver subst resolver = - let mp_apply_subst mkey mequ rslv = - Deltamap.add_mp (subst_mp subst mkey) mequ rslv - in - 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 mkey = - match subst_mp0 sub mp with - None -> empty_delta_resolver,mp - | Some (mp',resolve) -> - let mp1 = find_prefix resolve mp' in - let resolve1 = subset_prefixed_by mp1 resolve in - (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 - 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 update_delta_resolver resolver1 resolver2 = - 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 Deltamap.is_empty resolver2 then - resolver1 - else - Deltamap.join (update_delta_resolver resolver1 resolver2) resolver2 - -let substition_prefixed_by k mp subst = - let mp_prefixmp kmp (mp_to,reso) sub = - if mp_in_mp mp kmp && not (ModPath.equal 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 mp_prefixmp mbi_prefixmp subst empty_subst - -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'' = - match resolve' with - | Some res -> - add_delta_resolver - (subst_dom_codom_delta_resolver subst2 resolve) res - | None -> - subst_codom_delta_resolver subst2 resolve - in - 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 from_val x = { subst_value = x; subst_subst = []; } - -let force fsubst r = match r.subst_subst with -| [] -> r.subst_value -| s -> - let subst = List.fold_left join empty_subst (List.rev s) in - let x = fsubst subst r.subst_value in - let () = r.subst_subst <- [] in - let () = r.subst_value <- x in - x - -let subst_substituted s r = { r with subst_subst = s :: r.subst_subst; } - -let force_constr = force subst_mps - -let subst_constr_subst = subst_substituted - -let subst_lazy_constr sub = function - | Indirect (l,dp,i) -> Indirect (sub::l,dp,i) - -let indirect_opaque_access = - ref ((fun dp i -> assert false) : DirPath.t -> int -> constr) -let indirect_opaque_univ_access = - ref ((fun dp i -> assert false) : DirPath.t -> int -> Univ.ContextSet.t) - -let force_lazy_constr = function - | Indirect (l,dp,i) -> - let c = !indirect_opaque_access dp i in - force_constr (List.fold_right subst_constr_subst l (from_val c)) - -let force_lazy_constr_univs = function - | OpaqueDef (Indirect (l,dp,i)) -> !indirect_opaque_univ_access dp i - | _ -> Univ.ContextSet.empty - -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) - -(** Local variables and graph *) - -let body_of_constant cb = match cb.const_body with - | Undef _ -> None - | Def c -> Some (force_constr c) - | OpaqueDef c -> Some (force_lazy_constr 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 opaque_univ_context cb = force_lazy_constr_univs cb.const_body - -let subst_rel_declaration sub (id,copt,t as x) = - let copt' = Option.smartmap (subst_mps sub) copt in - let t' = subst_mps sub t in - if copt == copt' && t == t' then x else (id,copt',t') - -let subst_rel_context sub = List.smartmap (subst_rel_declaration sub) - -let subst_recarg sub r = match r with - | Norec -> r - | (Mrec(kn,i)|Imbr (kn,i)) -> let kn' = subst_ind sub kn in - if kn==kn' then r else Imbr (kn',i) - -let mk_norec = Rtree.mk_node Norec [||] - -let mk_paths r recargs = - Rtree.mk_node r - (Array.map (fun l -> Rtree.mk_node Norec (Array.of_list l)) recargs) - -let dest_recarg p = fst (Rtree.dest_node p) - -let dest_subterms p = - let (_,cstrs) = Rtree.dest_node p in - Array.map (fun t -> Array.to_list (snd (Rtree.dest_node t))) cstrs - -let subst_wf_paths sub p = Rtree.smartmap (subst_recarg sub) p - -let eq_recarg r1 r2 = match r1, r2 with - | Norec, Norec -> true - | Mrec i1, Mrec i2 -> Names.eq_ind i1 i2 - | Imbr i1, Imbr i2 -> Names.eq_ind i1 i2 - | _ -> false - -let eq_wf_paths = Rtree.equal eq_recarg - -(**********************************************************************) -(* Representation of mutual inductive types in the kernel *) -(* - Inductive I1 (params) : U1 := c11 : T11 | ... | c1p1 : T1p1 - ... - with In (params) : Un := cn1 : Tn1 | ... | cnpn : Tnpn -*) - - -let subst_decl_arity f g sub ar = - match ar with - | RegularArity x -> - let x' = f sub x in - if x' == x then ar - else RegularArity x' - | TemplateArity x -> - let x' = g sub x in - if x' == x then ar - else TemplateArity x' - -let map_decl_arity f g = function - | RegularArity a -> RegularArity (f a) - | TemplateArity a -> TemplateArity (g a) - -let subst_rel_declaration sub = - Term.map_rel_decl (subst_mps sub) - -let subst_rel_context sub = List.smartmap (subst_rel_declaration sub) - -let subst_template_cst_arity sub (ctx,s as arity) = - let ctx' = subst_rel_context sub ctx in - if ctx==ctx' then arity else (ctx',s) - -let subst_arity sub s = subst_decl_arity subst_mps subst_template_cst_arity sub s - -(* TODO: should be changed to non-coping after Term.subst_mps *) -(* NB: we leave bytecode and native code fields untouched *) -let subst_const_body sub cb = - { cb with - const_body = subst_constant_def sub cb.const_body; - const_type = subst_arity sub cb.const_type } - - -let subst_regular_ind_arity sub s = - let uar' = subst_mps sub s.mind_user_arity in - if uar' == s.mind_user_arity then s - else { mind_user_arity = uar'; mind_sort = s.mind_sort } - -let subst_template_ind_arity sub s = s - -(* FIXME records *) -let subst_ind_arity = - subst_decl_arity subst_regular_ind_arity subst_template_ind_arity - -let subst_mind_packet sub mbp = - { mind_consnames = mbp.mind_consnames; - mind_consnrealdecls = mbp.mind_consnrealdecls; - mind_consnrealargs = mbp.mind_consnrealargs; - mind_typename = mbp.mind_typename; - mind_nf_lc = Array.smartmap (subst_mps sub) mbp.mind_nf_lc; - mind_arity_ctxt = subst_rel_context sub mbp.mind_arity_ctxt; - mind_arity = subst_ind_arity sub mbp.mind_arity; - mind_user_lc = Array.smartmap (subst_mps sub) mbp.mind_user_lc; - mind_nrealargs = mbp.mind_nrealargs; - mind_nrealdecls = mbp.mind_nrealdecls; - mind_kelim = mbp.mind_kelim; - mind_recargs = subst_wf_paths sub mbp.mind_recargs (*wf_paths*); - mind_nb_constant = mbp.mind_nb_constant; - mind_nb_args = mbp.mind_nb_args; - mind_reloc_tbl = mbp.mind_reloc_tbl } - - -let subst_mind sub mib = - { mib with - mind_params_ctxt = map_rel_context (subst_mps sub) mib.mind_params_ctxt; - mind_packets = Array.smartmap (subst_mind_packet sub) mib.mind_packets } - -(* Modules *) - -let rec functor_map fty f0 = function - | NoFunctor a -> NoFunctor (f0 a) - | MoreFunctor (mbid,ty,e) -> MoreFunctor(mbid,fty ty,functor_map fty f0 e) - -let implem_map fs fa = function - | Struct s -> Struct (fs s) - | Algebraic a -> Algebraic (fa a) - | impl -> impl - -let subst_with_body sub = function - | WithMod(id,mp) -> WithMod(id,subst_mp sub mp) - | WithDef(id,(c,ctx)) -> WithDef(id,(subst_mps sub c,ctx)) - -let rec subst_expr sub = function - | MEident mp -> MEident (subst_mp sub mp) - | MEapply (me1,mp2)-> MEapply (subst_expr sub me1, subst_mp sub mp2) - | MEwith (me,wd)-> MEwith (subst_expr sub me, subst_with_body sub wd) - -let rec subst_expression sub me = - functor_map (subst_module sub) (subst_expr sub) me - -and subst_signature sub sign = - functor_map (subst_module sub) (subst_structure sub) sign - -and subst_structure sub struc = - let subst_body = function - | SFBconst cb -> SFBconst (subst_const_body sub cb) - | SFBmind mib -> SFBmind (subst_mind sub mib) - | SFBmodule mb -> SFBmodule (subst_module sub mb) - | SFBmodtype mtb -> SFBmodtype (subst_module sub mtb) - in - List.map (fun (l,b) -> (l,subst_body b)) struc - -and subst_module sub mb = - { mb with - mod_mp = subst_mp sub mb.mod_mp; - mod_expr = - implem_map (subst_signature sub) (subst_expression sub) mb.mod_expr; - mod_type = subst_signature sub mb.mod_type; - mod_type_alg = Option.smartmap (subst_expression sub) mb.mod_type_alg } diff -Nru coq-doc-8.6/checker/declarations.mli coq-doc-8.15.0/checker/declarations.mli --- coq-doc-8.6/checker/declarations.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/declarations.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,48 +0,0 @@ -open Names -open Cic - -val force_constr : constr_substituted -> constr -val force_lazy_constr_univs : Cic.constant_def -> Univ.ContextSet.t -val from_val : constr -> constr_substituted - -val indirect_opaque_access : (DirPath.t -> int -> constr) ref -val indirect_opaque_univ_access : (DirPath.t -> int -> Univ.ContextSet.t) ref - -(** Constant_body *) - -val body_of_constant : constant_body -> constr option -val constant_has_body : constant_body -> bool -val is_opaque : constant_body -> bool -val opaque_univ_context : constant_body -> Univ.ContextSet.t - -(* Mutual inductives *) - -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 -val eq_recarg : recarg -> recarg -> bool -val eq_wf_paths : wf_paths -> wf_paths -> bool - -(* Modules *) - -val empty_delta_resolver : delta_resolver - -(* Substitutions *) - -type 'a subst_fun = substitution -> 'a -> 'a - -val empty_subst : substitution -val add_mbid : MBId.t -> module_path -> substitution -> substitution -val add_mp : module_path -> module_path -> substitution -> substitution -val map_mbid : MBId.t -> module_path -> substitution -val map_mp : module_path -> module_path -> substitution -val mp_in_delta : module_path -> delta_resolver -> bool -val mind_of_delta : delta_resolver -> mutual_inductive -> mutual_inductive - -val subst_const_body : constant_body subst_fun -val subst_mind : mutual_inductive_body subst_fun -val subst_signature : substitution -> module_signature -> module_signature -val subst_module : substitution -> module_body -> module_body - -val join : substitution -> substitution -> substitution diff -Nru coq-doc-8.6/checker/.depend coq-doc-8.15.0/checker/.depend --- coq-doc-8.6/checker/.depend 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/.depend 1970-01-01 00:00:00.000000000 +0000 @@ -1,58 +0,0 @@ -checker.cmo: type_errors.cmi term.cmo safe_typing.cmi indtypes.cmi \ - declarations.cmi check_stat.cmi check.cmo -checker.cmx: type_errors.cmx term.cmx safe_typing.cmx indtypes.cmx \ - declarations.cmx check_stat.cmx check.cmx -check.cmo: safe_typing.cmi -check.cmx: safe_typing.cmx -check_stat.cmo: term.cmo safe_typing.cmi indtypes.cmi environ.cmo \ - declarations.cmi check_stat.cmi -check_stat.cmx: term.cmx safe_typing.cmx indtypes.cmx environ.cmx \ - declarations.cmx check_stat.cmi -closure.cmo: term.cmo environ.cmo closure.cmi -closure.cmx: term.cmx environ.cmx closure.cmi -closure.cmi: term.cmo environ.cmo -declarations.cmo: term.cmo declarations.cmi -declarations.cmx: term.cmx declarations.cmi -declarations.cmi: term.cmo -environ.cmo: term.cmo declarations.cmi -environ.cmx: term.cmx declarations.cmx -indtypes.cmo: typeops.cmi term.cmo reduction.cmi inductive.cmi environ.cmo \ - declarations.cmi indtypes.cmi -indtypes.cmx: typeops.cmx term.cmx reduction.cmx inductive.cmx environ.cmx \ - declarations.cmx indtypes.cmi -indtypes.cmi: typeops.cmi term.cmo environ.cmo declarations.cmi -inductive.cmo: type_errors.cmi term.cmo reduction.cmi environ.cmo \ - declarations.cmi inductive.cmi -inductive.cmx: type_errors.cmx term.cmx reduction.cmx environ.cmx \ - declarations.cmx inductive.cmi -inductive.cmi: term.cmo environ.cmo declarations.cmi -main.cmo: checker.cmo -main.cmx: checker.cmx -mod_checking.cmo: typeops.cmi term.cmo subtyping.cmi reduction.cmi modops.cmi \ - inductive.cmi indtypes.cmi environ.cmo declarations.cmi -mod_checking.cmx: typeops.cmx term.cmx subtyping.cmx reduction.cmx modops.cmx \ - inductive.cmx indtypes.cmx environ.cmx declarations.cmx -modops.cmo: term.cmo environ.cmo declarations.cmi modops.cmi -modops.cmx: term.cmx environ.cmx declarations.cmx modops.cmi -modops.cmi: term.cmo environ.cmo declarations.cmi -reduction.cmo: term.cmo environ.cmo closure.cmi reduction.cmi -reduction.cmx: term.cmx environ.cmx closure.cmx reduction.cmi -reduction.cmi: term.cmo environ.cmo -safe_typing.cmo: validate.cmo modops.cmi mod_checking.cmo environ.cmo \ - declarations.cmi safe_typing.cmi -safe_typing.cmx: validate.cmx modops.cmx mod_checking.cmx environ.cmx \ - declarations.cmx safe_typing.cmi -safe_typing.cmi: term.cmo environ.cmo declarations.cmi -subtyping.cmo: typeops.cmi term.cmo reduction.cmi modops.cmi inductive.cmi \ - environ.cmo declarations.cmi subtyping.cmi -subtyping.cmx: typeops.cmx term.cmx reduction.cmx modops.cmx inductive.cmx \ - environ.cmx declarations.cmx subtyping.cmi -subtyping.cmi: term.cmo environ.cmo declarations.cmi -type_errors.cmo: term.cmo environ.cmo type_errors.cmi -type_errors.cmx: term.cmx environ.cmx type_errors.cmi -type_errors.cmi: term.cmo environ.cmo -typeops.cmo: type_errors.cmi term.cmo reduction.cmi inductive.cmi environ.cmo \ - declarations.cmi typeops.cmi -typeops.cmx: type_errors.cmx term.cmx reduction.cmx inductive.cmx environ.cmx \ - declarations.cmx typeops.cmi -typeops.cmi: term.cmo environ.cmo declarations.cmi diff -Nru coq-doc-8.6/checker/dune coq-doc-8.15.0/checker/dune --- coq-doc-8.6/checker/dune 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/dune 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,29 @@ +; Careful with bug https://github.com/ocaml/odoc/issues/148 +; +; If we don't pack checker we will have a problem here due to +; duplicate module names in the whole build. +(library + (name coq_checklib) + (synopsis "Coq's Standalone Proof Checker") + (modules :standard \ coqchk votour) + (wrapped true) + (libraries coq-core.boot coq-core.kernel)) + +(executable + (name coqchk) + (public_name coqchk) + (modes exe byte) + ; Move to coq-checker? + (package coq-core) + (modules coqchk) + (flags :standard -open Coq_checklib) + (libraries coq_checklib)) + +(executable + (name votour) + (public_name votour) + (package coq-core) + (modules votour) + (flags :standard -open Coq_checklib) + (libraries coq_checklib)) + diff -Nru coq-doc-8.6/checker/environ.ml coq-doc-8.15.0/checker/environ.ml --- coq-doc-8.6/checker/environ.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/environ.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,236 +0,0 @@ -open CErrors -open Util -open Names -open Cic -open Term -open Declarations - -type globals = { - env_constants : constant_body Cmap_env.t; - env_inductives : mutual_inductive_body Mindmap_env.t; - env_inductives_eq : kernel_name KNmap.t; - env_modules : module_body MPmap.t; - env_modtypes : module_type_body MPmap.t} - -type stratification = { - env_universes : Univ.universes; - env_engagement : engagement -} - -type env = { - env_globals : globals; - env_rel_context : rel_context; - env_stratification : stratification; - env_imports : Cic.vodigest MPmap.t } - -let empty_env = { - env_globals = - { env_constants = Cmap_env.empty; - env_inductives = Mindmap_env.empty; - env_inductives_eq = KNmap.empty; - env_modules = MPmap.empty; - env_modtypes = MPmap.empty}; - env_rel_context = []; - env_stratification = - { env_universes = Univ.initial_universes; - env_engagement = PredicativeSet }; - env_imports = MPmap.empty } - -let engagement env = env.env_stratification.env_engagement -let universes env = env.env_stratification.env_universes -let rel_context env = env.env_rel_context - -let set_engagement (impr_set as c) env = - let expected_impr_set = - env.env_stratification.env_engagement in - begin - match impr_set,expected_impr_set with - | PredicativeSet, ImpredicativeSet -> error "Incompatible engagement" - | _ -> () - end; - { env with env_stratification = - { env.env_stratification with env_engagement = c } } - -(* Digests *) - -let add_digest env dp digest = - { env with env_imports = MPmap.add (MPfile dp) digest env.env_imports } - -let lookup_digest env dp = - MPmap.find (MPfile dp) env.env_imports - -(* Rel context *) -let lookup_rel n env = - let rec lookup_rel n sign = - match n, sign with - | 1, decl :: _ -> decl - | n, _ :: sign -> lookup_rel (n-1) sign - | _, [] -> raise Not_found in - lookup_rel n env.env_rel_context - -let push_rel d env = - { env with - env_rel_context = d :: env.env_rel_context } - -let push_rel_context ctxt x = fold_rel_context push_rel ctxt ~init:x - -let push_rec_types (lna,typarray,_) env = - let ctxt = Array.map2_i (fun i na t -> LocalAssum (na, lift i t)) lna typarray in - Array.fold_left (fun e assum -> push_rel assum e) env ctxt - -(* Universe constraints *) -let map_universes f env = - let s = env.env_stratification in - { env with env_stratification = - { s with env_universes = f s.env_universes } } - -let add_constraints c env = - if c == Univ.Constraint.empty then env - else map_universes (Univ.merge_constraints c) env - -let push_context ?(strict=false) ctx env = - map_universes (Univ.merge_context strict ctx) env - -let push_context_set ?(strict=false) ctx env = - map_universes (Univ.merge_context_set strict ctx) env - -let check_constraints cst env = - Univ.check_constraints cst env.env_stratification.env_universes - -(* Global constants *) - -let lookup_constant kn env = - Cmap_env.find kn env.env_globals.env_constants - -let anomaly s = anomaly (Pp.str s) - -let add_constant kn cs env = - if Cmap_env.mem kn env.env_globals.env_constants then - Printf.ksprintf anomaly ("Constant %s is already defined") - (Constant.to_string kn); - let new_constants = - Cmap_env.add kn cs env.env_globals.env_constants in - let new_globals = - { env.env_globals with - env_constants = new_constants } in - { env with env_globals = new_globals } - -type const_evaluation_result = NoBody | Opaque - -(* Constant types *) - -let constraints_of cb u = - let univs = cb.const_universes in - Univ.subst_instance_constraints u (Univ.UContext.constraints univs) - -let map_regular_arity f = function - | RegularArity a as ar -> - let a' = f a in - if a' == a then ar else RegularArity a' - | TemplateArity _ -> assert false - -(* constant_type gives the type of a constant *) -let constant_type env (kn,u) = - let cb = lookup_constant kn env in - if cb.const_polymorphic then - let csts = constraints_of cb u in - (map_regular_arity (subst_instance_constr u) cb.const_type, csts) - else cb.const_type, Univ.Constraint.empty - -exception NotEvaluableConst of const_evaluation_result - -let constant_value env (kn,u) = - let cb = lookup_constant kn env in - match cb.const_body with - | Def l_body -> - let b = force_constr l_body in - if cb.const_polymorphic then - subst_instance_constr u (force_constr l_body) - else b - | 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 = - try let _ = constant_value env (cst, Univ.Instance.empty) in true - with Not_found | NotEvaluableConst _ -> false - -let is_projection cst env = - not (Option.is_empty (lookup_constant cst env).const_proj) - -let lookup_projection p env = - match (lookup_constant (Projection.constant p) env).const_proj with - | Some pb -> pb - | None -> anomaly ("lookup_projection: constant is not a projection") - -(* Mutual Inductives *) -let scrape_mind env kn= - try - KNmap.find kn env.env_globals.env_inductives_eq - with - Not_found -> kn - -let mind_equiv env (kn1,i1) (kn2,i2) = - Int.equal i1 i2 && - KerName.equal - (scrape_mind env (MutInd.user kn1)) - (scrape_mind env (MutInd.user kn2)) - - -let lookup_mind kn env = - Mindmap_env.find kn env.env_globals.env_inductives - -let add_mind kn mib env = - if Mindmap_env.mem kn env.env_globals.env_inductives then - Printf.ksprintf anomaly ("Inductive %s is already defined") - (MutInd.to_string kn); - let new_inds = Mindmap_env.add kn mib env.env_globals.env_inductives in - let kn1,kn2 = MutInd.user kn, MutInd.canonical kn in - let new_inds_eq = if KerName.equal kn1 kn2 then - env.env_globals.env_inductives_eq - else - KNmap.add kn1 kn2 env.env_globals.env_inductives_eq in - let new_globals = - { env.env_globals with - env_inductives = new_inds; - env_inductives_eq = new_inds_eq} in - { env with env_globals = new_globals } - - -(* Modules *) - -let add_modtype ln mtb env = - if MPmap.mem ln env.env_globals.env_modtypes then - Printf.ksprintf anomaly ("Module type %s is already defined") - (ModPath.to_string ln); - let new_modtypes = MPmap.add ln mtb env.env_globals.env_modtypes in - let new_globals = - { env.env_globals with - env_modtypes = new_modtypes } in - { env with env_globals = new_globals } - -let shallow_add_module mp mb env = - if MPmap.mem mp env.env_globals.env_modules then - Printf.ksprintf anomaly ("Module %s is already defined") - (ModPath.to_string mp); - let new_mods = MPmap.add mp mb env.env_globals.env_modules in - let new_globals = - { env.env_globals with - env_modules = new_mods } in - { env with env_globals = new_globals } - -let shallow_remove_module mp env = - if not (MPmap.mem mp env.env_globals.env_modules) then - Printf.ksprintf anomaly ("Module %s is unknown") - (ModPath.to_string mp); - let new_mods = MPmap.remove mp env.env_globals.env_modules in - let new_globals = - { env.env_globals with - env_modules = new_mods } in - { env with env_globals = new_globals } - -let lookup_module mp env = - MPmap.find mp env.env_globals.env_modules - -let lookup_modtype ln env = - MPmap.find ln env.env_globals.env_modtypes diff -Nru coq-doc-8.6/checker/environ.mli coq-doc-8.15.0/checker/environ.mli --- coq-doc-8.6/checker/environ.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/environ.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,74 +0,0 @@ -open Names -open Cic - -(* Environments *) - -type globals = { - env_constants : constant_body Cmap_env.t; - env_inductives : mutual_inductive_body Mindmap_env.t; - env_inductives_eq : kernel_name KNmap.t; - env_modules : module_body MPmap.t; - env_modtypes : module_type_body MPmap.t} -type stratification = { - env_universes : Univ.universes; - env_engagement : engagement; -} -type env = { - env_globals : globals; - env_rel_context : rel_context; - env_stratification : stratification; - env_imports : Cic.vodigest MPmap.t; -} -val empty_env : env - -(* Engagement *) -val engagement : env -> Cic.engagement -val set_engagement : Cic.engagement -> env -> env - -(* Digests *) -val add_digest : env -> DirPath.t -> Cic.vodigest -> env -val lookup_digest : env -> DirPath.t -> Cic.vodigest - -(* de Bruijn variables *) -val rel_context : env -> rel_context -val lookup_rel : int -> env -> rel_declaration -val push_rel : rel_declaration -> env -> env -val push_rel_context : rel_context -> env -> env -val push_rec_types : name array * constr array * 'a -> env -> env - -(* Universes *) -val universes : env -> Univ.universes -val add_constraints : Univ.constraints -> env -> env -val push_context : ?strict:bool -> Univ.universe_context -> env -> env -val push_context_set : ?strict:bool -> Univ.universe_context_set -> env -> env -val check_constraints : Univ.constraints -> env -> bool - -(* Constants *) -val lookup_constant : constant -> env -> Cic.constant_body -val add_constant : constant -> Cic.constant_body -> env -> env -val constant_type : env -> constant puniverses -> constant_type Univ.constrained -type const_evaluation_result = NoBody | Opaque -exception NotEvaluableConst of const_evaluation_result -val constant_value : env -> constant puniverses -> constr -val evaluable_constant : constant -> env -> bool - -val is_projection : constant -> env -> bool -val lookup_projection : projection -> env -> projection_body - -(* Inductives *) -val mind_equiv : env -> inductive -> inductive -> bool - -val lookup_mind : - mutual_inductive -> env -> Cic.mutual_inductive_body - -val add_mind : - mutual_inductive -> Cic.mutual_inductive_body -> env -> env - -(* Modules *) -val add_modtype : - module_path -> Cic.module_type_body -> env -> env -val shallow_add_module : - module_path -> Cic.module_body -> env -> env -val shallow_remove_module : module_path -> env -> env -val lookup_module : module_path -> env -> Cic.module_body -val lookup_modtype : module_path -> env -> Cic.module_type_body diff -Nru coq-doc-8.6/checker/include coq-doc-8.15.0/checker/include --- coq-doc-8.6/checker/include 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/include 2022-01-13 11:55:53.000000000 +0000 @@ -3,7 +3,7 @@ (* Caml script to include for debugging the checker. Usage: from the checker/ directory launch ocaml toplevel and then type #use"include";; - This command loads the relevent modules, defines some pretty + This command loads the relevant modules, defines some pretty printers, and provides functions to interactively check modules (mainly run_l and norec). *) @@ -13,8 +13,6 @@ #directory "kernel";; #directory "checker";; #directory "+threads";; -#directory "+camlp4";; -#directory "+camlp5";; #load "unix.cma";; #load"threads.cma";; @@ -116,7 +114,7 @@ #install_printer prsub;;*) Checker.init_with_argv [|"";"-coqlib";"."|];; -Flags.make_silent false;; +Flags.quiet := false;; Flags.debug := true;; Sys.catch_break true;; @@ -171,8 +169,7 @@ ((Obj.magic lib.library_compiled): dir_path * module_body * - (dir_path * Digest.t) list * - engagement option);; + (dir_path * Digest.t) list);; let expln f x = diff -Nru coq-doc-8.6/checker/indtypes.ml coq-doc-8.15.0/checker/indtypes.ml --- coq-doc-8.6/checker/indtypes.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/indtypes.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,555 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* DirPath.to_string sl - | MPbound uid -> "bound("^MBId.to_string uid^")" - | MPdot (mp,l) -> debug_string_of_mp mp ^ "." ^ Label.to_string l - -let rec string_of_mp = function - | MPfile sl -> DirPath.to_string sl - | MPbound uid -> MBId.to_string uid - | MPdot (mp,l) -> string_of_mp mp ^ "." ^ Label.to_string l - -let string_of_mp mp = - if !Flags.debug then debug_string_of_mp mp else string_of_mp mp - -let prkn kn = - let (mp,_,l) = KerName.repr kn in - str(string_of_mp mp ^ "." ^ Label.to_string l) -let prcon c = - let ck = Constant.canonical c in - let uk = Constant.user c in - if KerName.equal ck uk then prkn uk else (prkn uk ++str"(="++prkn ck++str")") - -(* Same as noccur_between but may perform reductions. - Could be refined more... *) -let weaker_noccur_between env x nvars t = - if noccur_between x nvars t then Some t - else - let t' = whd_all env t in - if noccur_between x nvars t' then Some t' - else None - -let is_constructor_head t = - match fst(decompose_app t) with - | Rel _ -> true - | _ -> false - -let conv_ctxt_prefix env (ctx1:rel_context) ctx2 = - let rec chk env rctx1 rctx2 = - match rctx1, rctx2 with - (LocalAssum (_,ty1) as d1)::rctx1', LocalAssum (_,ty2)::rctx2' -> - conv env ty1 ty2; - chk (push_rel d1 env) rctx1' rctx2' - | (LocalDef (_,bd1,ty1) as d1)::rctx1', LocalDef (_,bd2,ty2)::rctx2' -> - conv env ty1 ty2; - conv env bd1 bd2; - chk (push_rel d1 env) rctx1' rctx2' - | [],_ -> () - | _ -> failwith "non convertible contexts" in - chk env (List.rev ctx1) (List.rev ctx2) - -(************************************************************************) -(* Various well-formedness check for inductive declarations *) - -(* Errors related to inductive constructions *) -type inductive_error = - | NonPos of env * constr * constr - | NotEnoughArgs of env * constr * constr - | NotConstructor of env * constr * constr - | NonPar of env * constr * int * constr * constr - | SameNamesTypes of Id.t - | SameNamesConstructors of Id.t - | SameNamesOverlap of Id.t list - | NotAnArity of Id.t - | BadEntry - -exception InductiveError of inductive_error - -(************************************************************************) -(************************************************************************) - -(* Typing the arities and constructor types *) - -let rec sorts_of_constr_args env t = - let t = whd_allnolet env t in - match t with - | Prod (name,c1,c2) -> - let varj = infer_type env c1 in - let env1 = push_rel (LocalAssum (name,c1)) env in - varj :: sorts_of_constr_args env1 c2 - | LetIn (name,def,ty,c) -> - let env1 = push_rel (LocalDef (name,def,ty)) env in - sorts_of_constr_args env1 c - | _ when is_constructor_head t -> [] - | _ -> anomaly ~label:"infos_and_sort" (Pp.str "not a positive constructor") - - -(* Prop and Set are small *) -let is_small_sort = function - | Prop _ -> true - | _ -> false - -let is_logic_sort = function -| Prop Null -> true -| _ -> false - -(* [infos] is a sequence of pair [islogic,issmall] for each type in - the product of a constructor or arity *) - -let is_small_constr infos = List.for_all (fun s -> is_small_sort s) infos -let is_logic_constr infos = List.for_all (fun s -> is_logic_sort s) infos - -(* An inductive definition is a "unit" if it has only one constructor - and that all arguments expected by this constructor are - logical, this is the case for equality, conjunction of logical properties -*) -let is_unit constrsinfos = - match constrsinfos with (* One info = One constructor *) - | [|constrinfos|] -> is_logic_constr constrinfos - | [||] -> (* type without constructors *) true - | _ -> false - -let small_unit constrsinfos = - let issmall = Array.for_all is_small_constr constrsinfos - and isunit = is_unit constrsinfos in - issmall, isunit - -(* check information related to inductive arity *) -let typecheck_arity env params inds = - let nparamargs = rel_context_nhyps params in - let nparamdecls = rel_context_length params in - let check_arity arctxt = function - | RegularArity mar -> - let ar = mar.mind_user_arity in - let _ = infer_type env ar in - conv env (it_mkProd_or_LetIn (Sort mar.mind_sort) arctxt) ar; - ar - | TemplateArity par -> - check_polymorphic_arity env params par; - it_mkProd_or_LetIn (Sort(Type par.template_level)) arctxt - in - let env_arities = - Array.fold_left - (fun env_ar ind -> - let ar_ctxt = ind.mind_arity_ctxt in - let _ = check_ctxt env ar_ctxt in - conv_ctxt_prefix env params ar_ctxt; - (* Arities (with params) are typed-checked here *) - let arity = check_arity ar_ctxt ind.mind_arity in - (* mind_nrealargs *) - let nrealargs = rel_context_nhyps ar_ctxt - nparamargs in - if ind.mind_nrealargs <> nrealargs then - failwith "bad number of real inductive arguments"; - let nrealargs_ctxt = rel_context_length ar_ctxt - nparamdecls in - if ind.mind_nrealdecls <> nrealargs_ctxt then - failwith "bad length of real inductive arguments signature"; - (* We do not need to generate the universe of full_arity; if - later, after the validation of the inductive definition, - full_arity is used as argument or subject to cast, an - upper universe will be generated *) - let id = ind.mind_typename in - let env_ar' = push_rel (LocalAssum (Name id, arity)) env_ar in - env_ar') - env - inds in - env_arities - -(* Allowed eliminations *) - -let check_predicativity env s small level = - match s, engagement env with - Type u, _ -> - (* let u' = fresh_local_univ () in *) - (* let cst = *) - (* merge_constraints (enforce_leq u u' empty_constraint) *) - (* (universes env) in *) - if not (Univ.check_leq (universes env) level u) then - failwith "impredicative Type inductive type" - | Prop Pos, ImpredicativeSet -> () - | Prop Pos, _ -> - if not small then failwith "impredicative Set inductive type" - | Prop Null,_ -> () - - -let sort_of_ind = function - | RegularArity mar -> mar.mind_sort - | TemplateArity par -> Type par.template_level - -let all_sorts = [InProp;InSet;InType] -let small_sorts = [InProp;InSet] -let logical_sorts = [InProp] - -let allowed_sorts issmall isunit s = - match family_of_sort s with - (* Type: all elimination allowed *) - | InType -> all_sorts - - (* Small Set is predicative: all elimination allowed *) - | InSet when issmall -> all_sorts - - (* Large Set is necessarily impredicative: forbids large elimination *) - | InSet -> small_sorts - - (* Unitary/empty Prop: elimination to all sorts are realizable *) - (* unless the type is large. If it is large, forbids large elimination *) - (* which otherwise allows simulating the inconsistent system Type:Type *) - | InProp when isunit -> if issmall then all_sorts else small_sorts - - (* Other propositions: elimination only to Prop *) - | InProp -> logical_sorts - - - -let compute_elim_sorts env_ar params mib arity lc = - let inst = extended_rel_list 0 params in - let env_params = push_rel_context params env_ar in - let lc = Array.map - (fun c -> - hnf_prod_applist env_params (lift (rel_context_length params) c) inst) - lc in - let s = sort_of_ind arity in - let infos = Array.map (sorts_of_constr_args env_params) lc in - let (small,unit) = small_unit infos in - (* We accept recursive unit types... *) - (* compute the max of the sorts of the products of the constructor type *) - let level = max_inductive_sort - (Array.concat (Array.to_list (Array.map Array.of_list infos))) in - check_predicativity env_ar s small level; - allowed_sorts small unit s - - -let typecheck_one_inductive env params mib mip = - (* mind_typename and mind_consnames not checked *) - (* mind_reloc_tbl, mind_nb_constant, mind_nb_args not checked (VM) *) - (* mind_arity_ctxt, mind_arity, mind_nrealargs DONE (typecheck_arity) *) - (* mind_user_lc *) - let _ = Array.map (infer_type env) mip.mind_user_lc in - (* mind_nf_lc *) - let _ = Array.map (infer_type env) mip.mind_nf_lc in - Array.iter2 (conv env) mip.mind_nf_lc mip.mind_user_lc; - (* mind_consnrealdecls *) - let check_cons_args c n = - let ctx,_ = decompose_prod_assum c in - if n <> rel_context_length ctx - rel_context_length params then - failwith "bad number of real constructor arguments" in - Array.iter2 check_cons_args mip.mind_nf_lc mip.mind_consnrealdecls; - (* mind_kelim: checked by positivity criterion ? *) - let sorts = - compute_elim_sorts env params mib mip.mind_arity mip.mind_nf_lc in - let reject_sort s = not (List.mem_f family_equal s sorts) in - if List.exists reject_sort mip.mind_kelim then - failwith "elimination not allowed"; - (* mind_recargs: checked by positivity criterion *) - () - -(************************************************************************) -(************************************************************************) -(* Positivity *) - -type ill_formed_ind = - | LocalNonPos of int - | LocalNotEnoughArgs of int - | LocalNotConstructor - | LocalNonPar of int * int * int - -exception IllFormedInd of ill_formed_ind - -(* [mind_extract_params mie] extracts the params from an inductive types - declaration, and checks that they are all present (and all the same) - for all the given types. *) - -let mind_extract_params = decompose_prod_n_assum - -let explain_ind_err ntyp env0 nbpar c err = - let (lpar,c') = mind_extract_params nbpar c in - let env = push_rel_context lpar env0 in - match err with - | LocalNonPos kt -> - raise (InductiveError (NonPos (env,c',Rel (kt+nbpar)))) - | LocalNotEnoughArgs kt -> - raise (InductiveError - (NotEnoughArgs (env,c',Rel (kt+nbpar)))) - | LocalNotConstructor -> - raise (InductiveError - (NotConstructor (env,c',Rel (ntyp+nbpar)))) - | LocalNonPar (n,i,l) -> - raise (InductiveError - (NonPar (env,c',n,Rel i,Rel (l+nbpar)))) - -let failwith_non_pos n ntypes c = - for k = n to n + ntypes - 1 do - if not (noccurn k c) then raise (IllFormedInd (LocalNonPos (k-n+1))) - done - -let failwith_non_pos_vect n ntypes v = - Array.iter (failwith_non_pos n ntypes) v; - anomaly ~label:"failwith_non_pos_vect" (Pp.str "some k in [n;n+ntypes-1] should occur") - -let failwith_non_pos_list n ntypes l = - List.iter (failwith_non_pos n ntypes) l; - anomaly ~label:"failwith_non_pos_list" (Pp.str "some k in [n;n+ntypes-1] should occur") - -(* Conclusion of constructors: check the inductive type is called with - the expected parameters *) -let check_correct_par (env,n,ntypes,_) hyps l largs = - let nparams = rel_context_nhyps hyps in - let largs = Array.of_list largs in - if Array.length largs < nparams then - raise (IllFormedInd (LocalNotEnoughArgs l)); - let (lpar,largs') = Array.chop nparams largs in - let nhyps = List.length hyps in - let rec check k index = function - | [] -> () - | LocalDef _ :: hyps -> check k (index+1) hyps - | _::hyps -> - match whd_all env lpar.(k) with - | Rel w when w = index -> check (k-1) (index+1) hyps - | _ -> raise (IllFormedInd (LocalNonPar (k+1,index,l))) - in check (nparams-1) (n-nhyps) hyps; - if not (Array.for_all (noccur_between n ntypes) largs') then - failwith_non_pos_vect n ntypes largs' - -(* Arguments of constructor: check the number of recursive parameters nrecp. - the first parameters which are constant in recursive arguments - n is the current depth, nmr is the maximum number of possible - recursive parameters *) - -let check_rec_par (env,n,_,_) hyps nrecp largs = - let (lpar,_) = List.chop nrecp largs in - let rec find index = - function - | ([],_) -> () - | (_,[]) -> - failwith "number of recursive parameters cannot be greater than the number of parameters." - | (lp,LocalDef _ :: hyps) -> find (index-1) (lp,hyps) - | (p::lp,_::hyps) -> - (match whd_all env p with - | Rel w when w = index -> find (index-1) (lp,hyps) - | _ -> failwith "bad number of recursive parameters") - in find (n-1) (lpar,List.rev hyps) - -let lambda_implicit_lift n a = - let lambda_implicit a = Lambda(Anonymous,Evar(0,[||]),a) in - iterate lambda_implicit n (lift n a) - -(* This removes global parameters of the inductive types in lc (for - nested inductive types only ) *) -let abstract_mind_lc env ntyps npars lc = - if npars = 0 then - lc - else - let make_abs = - List.init ntyps - (function i -> lambda_implicit_lift npars (Rel (i+1))) - in - Array.map (substl make_abs) lc - -(* [env] is the typing environment - [n] is the dB of the last inductive type - [ntypes] is the number of inductive types in the definition - (i.e. range of inductives is [n; n+ntypes-1]) - [lra] is the list of recursive tree of each variable - *) -let ienv_push_var (env, n, ntypes, lra) (x,a,ra) = - (push_rel (LocalAssum (x,a)) env, n+1, ntypes, (Norec,ra)::lra) - -let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lpar) = - let auxntyp = 1 in - let specif = lookup_mind_specif env mi in - let env' = - let decl = LocalAssum (Anonymous, - hnf_prod_applist env (type_of_inductive env (specif,u)) lpar) in - push_rel decl env in - let ra_env' = - (Imbr mi,(Rtree.mk_rec_calls 1).(0)) :: - List.map (fun (r,t) -> (r,Rtree.lift 1 t)) ra_env in - (* New index of the inductive types *) - let newidx = n + auxntyp in - (env', newidx, ntypes, ra_env') - -let rec ienv_decompose_prod (env,_,_,_ as ienv) n c = - if n=0 then (ienv,c) else - let c' = whd_all env c in - match c' with - Prod(na,a,b) -> - let ienv' = ienv_push_var ienv (na,a,mk_norec) in - ienv_decompose_prod ienv' (n-1) b - | _ -> assert false - -(* The recursive function that checks positivity and builds the list - of recursive arguments *) -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 = - let x,largs = decompose_app (whd_all env c) in - match x with - | Prod (na,b,d) -> - assert (List.is_empty largs); - (match weaker_noccur_between env n ntypes b with - None -> failwith_non_pos_list n ntypes [b] - | Some b -> - check_pos (ienv_push_var ienv (na, b, mk_norec)) d) - | Rel k -> - (try - let (ra,rarg) = List.nth ra_env (k-1) in - (match ra with - Mrec _ -> check_rec_par ienv hyps nrecp largs - | _ -> ()); - if not (List.for_all (noccur_between n ntypes) largs) - then failwith_non_pos_list n ntypes largs - else rarg - with Failure _ | Invalid_argument _ -> mk_norec) - | Ind ind_kn -> - (* If the inductive type being defined appears in a - parameter, then we have an imbricated type *) - if List.for_all (noccur_between n ntypes) largs then mk_norec - else check_positive_imbr ienv (ind_kn, largs) - | err -> - if noccur_between n ntypes x && - List.for_all (noccur_between n ntypes) largs - then mk_norec - else failwith_non_pos_list n ntypes (x::largs) - - (* accesses to the environment are not factorised, but is it worth it? *) - and check_positive_imbr (env,n,ntypes,ra_env as ienv) ((mi,u), largs) = - let (mib,mip) = lookup_mind_specif env mi in - let auxnpar = mib.mind_nparams_rec in - let nonrecpar = mib.mind_nparams - auxnpar in - let (lpar,auxlargs) = - try List.chop auxnpar largs - with Failure _ -> raise (IllFormedInd (LocalNonPos n)) in - (* If the inductive appears in the args (non params) then the - definition is not positive. *) - if not (List.for_all (noccur_between n ntypes) auxlargs) then - raise (IllFormedInd (LocalNonPos n)); - (* We do not deal with imbricated mutual inductive types *) - let auxntyp = mib.mind_ntypes in - if auxntyp <> 1 then raise (IllFormedInd (LocalNonPos n)); - (* The nested inductive type with parameters removed *) - let auxlcvect = abstract_mind_lc env auxntyp auxnpar mip.mind_nf_lc in - (* Extends the environment with a variable corresponding to - the inductive def *) - let (env',_,_,_ as ienv') = ienv_push_inductive ienv ((mi,u),lpar) in - (* Parameters expressed in env' *) - let lpar' = List.map (lift auxntyp) lpar in - let irecargs = - (* fails if the inductive type occurs non positively *) - (* with recursive parameters substituted *) - Array.map - (function c -> - let c' = hnf_prod_applist env' c lpar' in - (* skip non-recursive parameters *) - let (ienv',c') = ienv_decompose_prod ienv' nonrecpar c' in - check_constructors ienv' false c') - auxlcvect in - (Rtree.mk_rec [|mk_paths (Imbr mi) irecargs|]).(0) - - (* check the inductive types occur positively in the products of C, if - check_head=true, also check the head corresponds to a constructor of - the ith type *) - - and check_constructors ienv check_head c = - let rec check_constr_rec (env,n,ntypes,ra_env as ienv) lrec c = - let x,largs = decompose_app (whd_all env c) in - match x with - | Prod (na,b,d) -> - assert (List.is_empty largs); - let recarg = check_pos ienv b in - let ienv' = ienv_push_var ienv (na,b,mk_norec) in - check_constr_rec ienv' (recarg::lrec) d - - | hd -> - if check_head then - match hd with - | Rel j when j = (n + ntypes - i - 1) -> - check_correct_par ienv hyps (ntypes-i) largs - | _ -> - raise (IllFormedInd LocalNotConstructor) - else - if not (List.for_all (noccur_between n ntypes) largs) - then raise (IllFormedInd (LocalNonPos n)); - List.rev lrec - in check_constr_rec ienv [] c - in - let irecargs = - Array.map - (fun c -> - let _,rawc = mind_extract_params lparams c in - try - check_constructors ienv true rawc - with IllFormedInd err -> - explain_ind_err (ntypes-i) env lparams c err) - indlc - in mk_paths (Mrec ind) irecargs - -let check_subtree t1 t2 = - let cmp_labels l1 l2 = l1 == Norec || eq_recarg l1 l2 in - if not (Rtree.equiv eq_recarg cmp_labels t1 t2) - then failwith "bad recursive trees" -(* if t1=t2 then () else msg_warning (str"TODO: check recursive positions")*) - -let check_positivity env_ar mind params nrecp inds = - let ntypes = Array.length inds 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.init lparams (fun _ -> (Norec,mk_norec)) @ lra_ind in - let ienv = (env_ar, 1+lparams, ntypes, ra_env) in - 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 - Array.iter2 (fun ind wfpi -> check_subtree ind.mind_recargs wfpi) inds wfp - -(************************************************************************) -(************************************************************************) - -let check_inductive env kn mib = - Flags.if_verbose Feedback.msg_notice (str " checking ind: " ++ MutInd.print kn); - (* check mind_constraints: should be consistent with env *) - let env = add_constraints (Univ.UContext.constraints mib.mind_universes) env in - (* check mind_record : TODO ? check #constructor = 1 ? *) - (* check mind_finite : always OK *) - (* check mind_ntypes *) - if Array.length mib.mind_packets <> mib.mind_ntypes then - error "not the right number of packets"; - (* check mind_params_ctxt *) - let params = mib.mind_params_ctxt in - let _ = check_ctxt env params in - (* check mind_nparams *) - if rel_context_nhyps params <> mib.mind_nparams then - error "number the right number of parameters"; - (* mind_packets *) - (* - check arities *) - let env_ar = typecheck_arity env params mib.mind_packets in - (* - 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 kn params mib.mind_nparams_rec mib.mind_packets; - (* check mind_equiv... *) - (* Now we can add the inductive *) - add_mind kn mib env - diff -Nru coq-doc-8.6/checker/indtypes.mli coq-doc-8.15.0/checker/indtypes.mli --- coq-doc-8.6/checker/indtypes.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/indtypes.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,37 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Pp.std_ppcmds -val prcon : constant -> Pp.std_ppcmds - -(*s The different kinds of errors that may result of a malformed inductive - definition. *) - -(* Errors related to inductive constructions *) -type inductive_error = - | NonPos of env * constr * constr - | NotEnoughArgs of env * constr * constr - | NotConstructor of env * constr * constr - | NonPar of env * constr * int * constr * constr - | SameNamesTypes of Id.t - | SameNamesConstructors of Id.t - | SameNamesOverlap of Id.t list - | NotAnArity of Id.t - | BadEntry - -exception InductiveError of inductive_error - -(*s The following function does checks on inductive declarations. *) - -val check_inductive : env -> mutual_inductive -> mutual_inductive_body -> env diff -Nru coq-doc-8.6/checker/inductive.ml coq-doc-8.15.0/checker/inductive.ml --- coq-doc-8.6/checker/inductive.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/inductive.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,1188 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* = Array.length mib.mind_packets then - error "Inductive.lookup_mind_specif: invalid inductive index"; - (mib, mib.mind_packets.(tyi)) - -let find_rectype env c = - let (t, l) = decompose_app (whd_all env c) in - match t with - | Ind ind -> (ind, l) - | _ -> raise Not_found - -let find_inductive env c = - let (t, l) = decompose_app (whd_all env c) in - match t with - | Ind (ind,_) - when (fst (lookup_mind_specif env ind)).mind_finite != CoFinite -> (ind, l) - | _ -> raise Not_found - -let find_coinductive env c = - let (t, l) = decompose_app (whd_all env c) in - match t with - | Ind (ind,_) - when (fst (lookup_mind_specif env ind)).mind_finite == CoFinite -> (ind, l) - | _ -> raise Not_found - -let inductive_params (mib,_) = mib.mind_nparams - -(** Polymorphic inductives *) - -let inductive_instance mib = - if mib.mind_polymorphic then - UContext.instance mib.mind_universes - else Instance.empty - -(************************************************************************) - -(* Build the substitution that replaces Rels by the appropriate *) -(* inductives *) -let ind_subst mind mib u = - let ntypes = mib.mind_ntypes in - let make_Ik k = Ind ((mind,ntypes-k-1),u) in - List.init ntypes make_Ik - -(* Instantiate inductives in constructor type *) -let constructor_instantiate mind u mib c = - let s = ind_subst mind mib u in - substl s (subst_instance_constr u c) - -let instantiate_params full t u args sign = - let fail () = - anomaly ~label:"instantiate_params" (Pp.str "type, ctxt and args mismatch") in - let (rem_args, subs, ty) = - fold_rel_context - (fun decl (largs,subs,ty) -> - match (decl, largs, ty) with - | (LocalAssum _, a::args, Prod(_,_,t)) -> (args, a::subs, t) - | (LocalDef (_,b,_),_,LetIn(_,_,_,t)) -> - (largs, (substl subs (subst_instance_constr u b))::subs, t) - | (_,[],_) -> if full then fail() else ([], subs, ty) - | _ -> fail ()) - sign - ~init:(args,[],t) - in - if rem_args <> [] then fail(); - substl subs ty - -let full_inductive_instantiate mib u params sign = - let dummy = Prop Null in - let t = mkArity (subst_instance_context u sign,dummy) in - fst (destArity (instantiate_params true t u params mib.mind_params_ctxt)) - -let full_constructor_instantiate ((mind,_),u,(mib,_),params) t = - let inst_ind = constructor_instantiate mind u mib t in - instantiate_params true inst_ind u params mib.mind_params_ctxt - -(************************************************************************) -(************************************************************************) - -(* Functions to build standard types related to inductive *) - -(* -Computing the actual sort of an applied or partially applied inductive type: - -I_i: forall uniformparams:utyps, forall otherparams:otyps, Type(a) -uniformargs : utyps -otherargs : otyps -I_1:forall ...,s_1;...I_n:forall ...,s_n |- sort(C_kj(uniformargs)) = s_kj -s'_k = max(..s_kj..) -merge(..s'_k..) = ..s''_k.. --------------------------------------------------------------------- -Gamma |- I_i uniformargs otherargs : phi(s''_i) - -where - -- if p=0, phi() = Prop -- if p=1, phi(s) = s -- if p<>1, phi(s) = sup(Set,s) - -Remark: Set (predicative) is encoded as Type(0) -*) - -let sort_as_univ = function -| Type u -> u -| Prop Null -> Univ.type0m_univ -| Prop Pos -> Univ.type0_univ - -(* cons_subst add the mapping [u |-> su] in subst if [u] is not *) -(* in the domain or add [u |-> sup x su] if [u] is already mapped *) -(* to [x]. *) -let cons_subst u su subst = - try - Univ.LMap.add u (Univ.sup (Univ.LMap.find u subst) su) subst - with Not_found -> Univ.LMap.add u su subst - -(* remember_subst updates the mapping [u |-> x] by [u |-> sup x u] *) -(* if it is presents and returns the substitution unchanged if not.*) -let remember_subst u subst = - try - let su = Universe.make u in - Univ.LMap.add u (Univ.sup (Univ.LMap.find u subst) su) subst - with Not_found -> subst - -(* Bind expected levels of parameters to actual levels *) -(* Propagate the new levels in the signature *) -let rec make_subst env = - let rec make subst = function - | LocalDef _ :: sign, exp, args -> - make subst (sign, exp, args) - | d::sign, None::exp, args -> - let args = match args with _::args -> args | [] -> [] in - make subst (sign, exp, args) - | d::sign, Some u::exp, a::args -> - (* We recover the level of the argument, but we don't change the *) - (* level in the corresponding type in the arity; this level in the *) - (* arity is a global level which, at typing time, will be enforce *) - (* to be greater than the level of the argument; this is probably *) - (* a useless extra constraint *) - let s = sort_as_univ (snd (dest_arity env a)) in - make (cons_subst u s subst) (sign, exp, args) - | LocalAssum (na,t) :: sign, Some u::exp, [] -> - (* No more argument here: we add the remaining universes to the *) - (* substitution (when [u] is distinct from all other universes in the *) - (* template, it is identity substitution otherwise (ie. when u is *) - (* already in the domain of the substitution) [remember_subst] will *) - (* update its image [x] by [sup x u] in order not to forget the *) - (* dependency in [u] that remains to be fullfilled. *) - make (remember_subst u subst) (sign, exp, []) - | sign, [], _ -> - (* Uniform parameters are exhausted *) - subst - | [], _, _ -> - assert false - in - make Univ.LMap.empty - -let instantiate_universes env ctx ar argsorts = - let args = Array.to_list argsorts in - let subst = make_subst env (ctx,ar.template_param_levels,args) in - let level = Univ.subst_univs_universe (Univ.make_subst subst) ar.template_level in - let ty = - (* Singleton type not containing types are interpretable in Prop *) - if Univ.is_type0m_univ level then Prop Null - (* Non singleton type not containing types are interpretable in Set *) - else if Univ.is_type0_univ level then Prop Pos - (* This is a Type with constraints *) - else Type level - in - (ctx, ty) - -(* Type of an inductive type *) - -let type_of_inductive_gen env ((mib,mip),u) paramtyps = - match mip.mind_arity with - | RegularArity a -> - if not mib.mind_polymorphic then a.mind_user_arity - else subst_instance_constr u a.mind_user_arity - | TemplateArity ar -> - let ctx = List.rev mip.mind_arity_ctxt in - let ctx,s = instantiate_universes env ctx ar paramtyps in - mkArity (List.rev ctx,s) - -let type_of_inductive_knowing_parameters env mip args = - type_of_inductive_gen env mip args - -(* Type of a (non applied) inductive type *) - -let type_of_inductive env mip = - type_of_inductive_knowing_parameters env mip [||] - -(* The max of an array of universes *) - -let cumulate_constructor_univ u = function - | Prop Null -> u - | Prop Pos -> Univ.sup Univ.type0_univ u - | Type u' -> Univ.sup u u' - -let max_inductive_sort = - Array.fold_left cumulate_constructor_univ Univ.type0m_univ - -(************************************************************************) -(* Type of a constructor *) - -let type_of_constructor_subst cstr u (mib,mip) = - let ind = inductive_of_constructor cstr in - let specif = mip.mind_user_lc in - let i = index_of_constructor cstr in - let nconstr = Array.length mip.mind_consnames in - if i > nconstr then error "Not enough constructors in the type."; - constructor_instantiate (fst ind) u mib specif.(i-1) - -let type_of_constructor_gen (cstr,u) (mib,mip as mspec) = - type_of_constructor_subst cstr u mspec - -let type_of_constructor cstru mspec = - type_of_constructor_gen cstru mspec - -let arities_of_specif (kn,u) (mib,mip) = - let specif = mip.mind_nf_lc in - Array.map (constructor_instantiate kn u mib) specif - - - -(************************************************************************) - -let error_elim_expln kp ki = - match kp,ki with - | (InType | InSet), InProp -> NonInformativeToInformative - | InType, InSet -> StrongEliminationOnNonSmallType (* if Set impredicative *) - | _ -> WrongArity - -(* Type of case predicates *) - -(* Get type of inductive, with parameters instantiated *) - -let inductive_sort_family mip = - match mip.mind_arity with - | RegularArity s -> family_of_sort s.mind_sort - | TemplateArity _ -> InType - -let mind_arity mip = - mip.mind_arity_ctxt, inductive_sort_family mip - -let get_instantiated_arity (ind,u) (mib,mip) params = - let sign, s = mind_arity mip in - full_inductive_instantiate mib u params sign, s - -let elim_sorts (_,mip) = mip.mind_kelim - -let extended_rel_list n hyps = - let rec reln l p = function - | LocalAssum _ :: hyps -> reln (Rel (n+p) :: l) (p+1) hyps - | LocalDef _ :: hyps -> reln l (p+1) hyps - | [] -> l - in - reln [] 1 hyps - -let build_dependent_inductive ind (_,mip) params = - let realargs,_ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in - applist - (Ind ind, - List.map (lift mip.mind_nrealdecls) params - @ extended_rel_list 0 realargs) - -(* This exception is local *) -exception LocalArity of (sorts_family * sorts_family * arity_error) option - -let check_allowed_sort ksort specif = - if not (List.exists ((=) ksort) (elim_sorts specif)) then - let s = inductive_sort_family (snd specif) in - raise (LocalArity (Some(ksort,s,error_elim_expln ksort s))) - -let is_correct_arity env c (p,pj) ind specif params = - let arsign,_ = get_instantiated_arity ind specif params in - let rec srec env pt ar = - let pt' = whd_all env pt in - match pt', ar with - | Prod (na1,a1,t), LocalAssum (_,a1')::ar' -> - (try conv env a1 a1' - with NotConvertible -> raise (LocalArity None)); - srec (push_rel (LocalAssum (na1,a1)) env) t ar' - | Prod (na1,a1,a2), [] -> (* whnf of t was not needed here! *) - let env' = push_rel (LocalAssum (na1,a1)) env in - let ksort = match (whd_all env' a2) with - | Sort s -> family_of_sort s - | _ -> raise (LocalArity None) in - let dep_ind = build_dependent_inductive ind specif params in - (try conv env a1 dep_ind - with NotConvertible -> raise (LocalArity None)); - check_allowed_sort ksort specif; - true - | Sort s', [] -> - check_allowed_sort (family_of_sort s') specif; - false - | _, (LocalDef _ as d)::ar' -> - srec (push_rel d env) (lift 1 pt') ar' - | _ -> - raise (LocalArity None) - in - try srec env pj (List.rev arsign) - with LocalArity kinds -> - error_elim_arity env ind (elim_sorts specif) c (p,pj) kinds - - -(************************************************************************) -(* Type of case branches *) - -(* [p] is the predicate, [i] is the constructor number (starting from 0), - and [cty] is the type of the constructor (params not instantiated) *) -let build_branches_type (ind,u) (_,mip as specif) params dep p = - let build_one_branch i cty = - let typi = full_constructor_instantiate (ind,u,specif,params) cty in - let (args,ccl) = decompose_prod_assum typi in - let nargs = rel_context_length args in - let (_,allargs) = decompose_app ccl in - let (lparams,vargs) = List.chop (inductive_params specif) allargs in - let cargs = - if dep then - let cstr = ith_constructor_of_inductive ind (i+1) in - let dep_cstr = - applist (Construct (cstr,u),lparams@extended_rel_list 0 args) in - vargs @ [dep_cstr] - else - vargs in - let base = beta_appvect (lift nargs p) (Array.of_list cargs) in - it_mkProd_or_LetIn base args in - Array.mapi build_one_branch mip.mind_nf_lc - -(* [p] is the predicate, [c] is the match object, [realargs] is the - list of real args of the inductive type *) -let build_case_type dep p c realargs = - let args = if dep then realargs@[c] else realargs in - beta_appvect p (Array.of_list args) - -let type_case_branches env (pind,largs) (p,pj) c = - let specif = lookup_mind_specif env (fst pind) in - let nparams = inductive_params specif in - let (params,realargs) = List.chop nparams largs in - let dep = is_correct_arity env c (p,pj) pind specif params in - let lc = build_branches_type pind specif params dep p in - let ty = build_case_type dep p c realargs in - (lc, ty) - - -(************************************************************************) -(* 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) || - (mib.mind_nparams <> ci.ci_npar) || - (mip.mind_consnrealdecls <> ci.ci_cstr_ndecls) || - (mip.mind_consnrealargs <> ci.ci_cstr_nargs) - then raise (TypeError(env,WrongCaseInfo(indsp,ci))) - -(************************************************************************) -(************************************************************************) - -(* Guard conditions for fix and cofix-points *) - -(* Check if t is a subterm of Rel n, and gives its specification, - assuming lst already gives index of - subterms with corresponding specifications of recursive arguments *) - -(* A powerful notion of subterm *) - -(* To each inductive definition corresponds an array describing the - structure of recursive arguments for each constructor, we call it - the recursive spec of the type (it has type recargs vect). For - checking the guard, we start from the decreasing argument (Rel n) - with its recursive spec. During checking the guardness condition, - we collect patterns variables corresponding to subterms of n, each - of them with its recursive spec. They are organised in a list lst - of type (int * recargs) list which is sorted with respect to the - first argument. -*) - -(*************************************************************) -(* Environment annotated with marks on recursive arguments *) - -(* tells whether it is a strict or loose subterm *) -type size = Large | Strict - -(* merging information *) -let size_glb s1 s2 = - match s1,s2 with - Strict, Strict -> Strict - | _ -> Large - -(* possible specifications for a term: - - Not_subterm: when the size of a term is not related to the - recursive argument of the fixpoint - - Subterm: when the term is a subterm of the recursive argument - the wf_paths argument specifies which subterms are recursive - - Dead_code: when the term has been built by elimination over an - empty type - *) - -type subterm_spec = - Subterm of (size * wf_paths) - | Dead_code - | Not_subterm - -let eq_recarg r1 r2 = match r1, r2 with -| Norec, Norec -> true -| Mrec i1, Mrec i2 -> Names.eq_ind i1 i2 -| Imbr i1, Imbr i2 -> Names.eq_ind i1 i2 -| _ -> false - -let eq_wf_paths = Rtree.equal eq_recarg - -let pp_recarg = function - | Norec -> Pp.str "Norec" - | Mrec i -> Pp.str ("Mrec "^MutInd.to_string (fst i)) - | Imbr i -> Pp.str ("Imbr "^MutInd.to_string (fst i)) - -let pp_wf_paths = Rtree.pp_tree pp_recarg - -let inter_recarg r1 r2 = match r1, r2 with -| Norec, Norec -> Some r1 -| Mrec i1, Mrec i2 -| Imbr i1, Imbr i2 -| Mrec i1, Imbr i2 -> if Names.eq_ind i1 i2 then Some r1 else None -| Imbr i1, Mrec i2 -> if Names.eq_ind i1 i2 then Some r2 else None -| _ -> None - -let inter_wf_paths = Rtree.inter eq_recarg inter_recarg Norec - -let incl_wf_paths = Rtree.incl eq_recarg inter_recarg Norec - -let spec_of_tree t = - if eq_wf_paths t mk_norec - then Not_subterm - else Subterm (Strict, t) - -let inter_spec s1 s2 = - match s1, s2 with - | _, Dead_code -> s1 - | Dead_code, _ -> s2 - | Not_subterm, _ -> s1 - | _, Not_subterm -> s2 - | Subterm (a1,t1), Subterm (a2,t2) -> - Subterm (size_glb a1 a2, inter_wf_paths t1 t2) - -let subterm_spec_glb = - Array.fold_left inter_spec Dead_code - -type guard_env = - { env : env; - (* dB of last fixpoint *) - rel_min : int; - (* dB of variables denoting subterms *) - genv : subterm_spec Lazy.t list; - } - -let make_renv env recarg tree = - { env = env; - rel_min = recarg+2; (* recarg = 0 ==> Rel 1 -> recarg; Rel 2 -> fix *) - genv = [Lazy.from_val(Subterm(Large,tree))] } - -let push_var renv (x,ty,spec) = - { env = push_rel (LocalAssum (x,ty)) renv.env; - rel_min = renv.rel_min+1; - genv = spec:: renv.genv } - -let assign_var_spec renv (i,spec) = - { renv with genv = List.assign renv.genv (i-1) spec } - -let push_var_renv renv (x,ty) = - push_var renv (x,ty,Lazy.from_val Not_subterm) - -(* Fetch recursive information about a variable p *) -let subterm_var p renv = - try Lazy.force (List.nth renv.genv (p-1)) - with Failure _ | Invalid_argument _ -> Not_subterm - -let push_ctxt_renv renv ctxt = - let n = rel_context_length ctxt in - { env = push_rel_context ctxt renv.env; - rel_min = renv.rel_min+n; - genv = iterate (fun ge -> Lazy.from_val Not_subterm::ge) n renv.genv } - -let push_fix_renv renv (_,v,_ as recdef) = - let n = Array.length v in - { env = push_rec_types recdef renv.env; - rel_min = renv.rel_min+n; - genv = iterate (fun ge -> 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). *) - -(* - c is a branch of an inductive definition corresponding to the spec - lrec. mind_recvec is the recursive spec of the inductive - definition of the decreasing argument n. - - case_branches_specif renv lrec lc will pass the lambdas - of c corresponding to pattern variables and collect possibly new - subterms variables and returns the bodies of the branches with the - correct envs and decreasing args. -*) - -let lookup_subterms env ind = - let (_,mip) = lookup_mind_specif env ind in - mip.mind_recargs - -let match_inductive ind ra = - match ra with - | (Mrec i | Imbr i) -> eq_ind ind i - | Norec -> false - -(* 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_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 - | Dead_code -> Array.make nca Dead_code - | _ -> Array.make nca Not_subterm) in - List.init nca (fun j -> lazy (Lazy.force lvra).(j))) - car - -let check_inductive_codomain env p = - let absctx, ar = dest_lam_assum env p in - let env = push_rel_context absctx env in - let arctx, s = dest_prod_assum env ar in - let env = push_rel_context arctx env in - let i,l' = decompose_app (whd_all env s) in - match i with Ind _ -> true | _ -> false - -(* The following functions are almost duplicated from indtypes.ml, except -that they carry here a poorer environment (containing less information). *) -let ienv_push_var (env, lra) (x,a,ra) = -(push_rel (LocalAssum (x,a)) env, (Norec,ra)::lra) - -let ienv_push_inductive (env, ra_env) ((mind,u),lpar) = - let mib = Environ.lookup_mind mind env in - let ntypes = mib.mind_ntypes in - let push_ind specif env = - let decl = LocalAssum (Anonymous, - hnf_prod_applist env (type_of_inductive env ((mib,specif),u)) lpar) in - push_rel decl env - in - let env = Array.fold_right push_ind mib.mind_packets env in - let rc = Array.mapi (fun j t -> (Imbr (mind,j),t)) (Rtree.mk_rec_calls ntypes) in - let lra_ind = Array.rev_to_list rc in - let ra_env = List.map (fun (r,t) -> (r,Rtree.lift ntypes t)) ra_env in - (env, lra_ind @ ra_env) - -let rec ienv_decompose_prod (env,_ as ienv) n c = - if Int.equal n 0 then (ienv,c) else - let c' = whd_all env c in - match c' with - Prod(na,a,b) -> - let ienv' = ienv_push_var ienv (na,a,mk_norec) in - ienv_decompose_prod ienv' (n-1) b - | _ -> assert false - -let lambda_implicit_lift n a = - let level = Level.make (DirPath.make [Id.of_string "implicit"]) 0 in - let implicit_sort = Sort (Type (Universe.make level)) in - let lambda_implicit a = Lambda (Anonymous, implicit_sort, a) in - iterate lambda_implicit n (lift n a) - -let abstract_mind_lc ntyps npars lc = - if Int.equal npars 0 then - lc - else - let make_abs = - List.init ntyps - (function i -> lambda_implicit_lift npars (Rel (i+1))) - in - Array.map (substl make_abs) lc - -(* [get_recargs_approx env tree ind args] builds an approximation of the recargs -tree for ind, knowing args. The argument tree is used to know when candidate -nested types should be traversed, pruning the tree otherwise. This code is very -close to check_positive in indtypes.ml, but does no positivy check and does not -compute the number of recursive arguments. *) -let get_recargs_approx env tree ind args = - let rec build_recargs (env, ra_env as ienv) tree c = - let x,largs = decompose_app (whd_all env c) in - match x with - | Prod (na,b,d) -> - assert (List.is_empty largs); - build_recargs (ienv_push_var ienv (na, b, mk_norec)) tree d - | Rel k -> - (* Free variables are allowed and assigned Norec *) - (try snd (List.nth ra_env (k-1)) - with Failure _ | Invalid_argument _ -> mk_norec) - | Ind ind_kn -> - (* When the inferred tree allows it, we consider that we have a potential - nested inductive type *) - begin match dest_recarg tree with - | Imbr kn' | Mrec kn' when eq_ind (fst ind_kn) kn' -> - build_recargs_nested ienv tree (ind_kn, largs) - | _ -> mk_norec - end - | err -> - mk_norec - - and build_recargs_nested (env,ra_env as ienv) tree (((mind,i),u), largs) = - (* If the infered tree already disallows recursion, no need to go further *) - if eq_wf_paths tree mk_norec then tree - else - let mib = Environ.lookup_mind mind env in - let auxnpar = mib.mind_nparams_rec in - let nonrecpar = mib.mind_nparams - auxnpar in - let (lpar,_) = List.chop auxnpar largs in - let auxntyp = mib.mind_ntypes in - (* Extends the environment with a variable corresponding to - the inductive def *) - let (env',_ as ienv') = ienv_push_inductive ienv ((mind,u),lpar) in - (* Parameters expressed in env' *) - let lpar' = List.map (lift auxntyp) lpar in - (* In case of mutual inductive types, we use the recargs tree which was - computed statically. This is fine because nested inductive types with - mutually recursive containers are not supported. *) - let trees = - if Int.equal auxntyp 1 then [|dest_subterms tree|] - else Array.map (fun mip -> dest_subterms mip.mind_recargs) mib.mind_packets - in - let mk_irecargs j specif = - (* The nested inductive type with parameters removed *) - let auxlcvect = abstract_mind_lc auxntyp auxnpar specif.mind_nf_lc in - let paths = Array.mapi - (fun k c -> - let c' = hnf_prod_applist env' c lpar' in - (* skip non-recursive parameters *) - let (ienv',c') = ienv_decompose_prod ienv' nonrecpar c' in - build_recargs_constructors ienv' trees.(j).(k) c') - auxlcvect - in - mk_paths (Imbr (mind,j)) paths - in - let irecargs = Array.mapi mk_irecargs mib.mind_packets in - (Rtree.mk_rec irecargs).(i) - - and build_recargs_constructors ienv trees c = - let rec recargs_constr_rec (env,ra_env as ienv) trees lrec c = - let x,largs = decompose_app (whd_all env c) in - match x with - - | Prod (na,b,d) -> - let () = assert (List.is_empty largs) in - let recarg = build_recargs ienv (List.hd trees) b in - let ienv' = ienv_push_var ienv (na,b,mk_norec) in - recargs_constr_rec ienv' (List.tl trees) (recarg::lrec) d - | hd -> - List.rev lrec - in - recargs_constr_rec ienv trees [] c - in - (* starting with ra_env = [] seems safe because any unbounded Rel will be - assigned Norec *) - build_recargs_nested (env,[]) tree (ind, args) - -(* [restrict_spec env spec p] restricts the size information in spec to what is - allowed to flow through a match with predicate p in environment env. *) -let restrict_spec env spec p = - if spec = Not_subterm then spec - else let absctx, ar = dest_lam_assum env p in - (* Optimization: if the predicate is not dependent, no restriction is needed - and we avoid building the recargs tree. *) - if noccur_with_meta 1 (rel_context_length absctx) ar then spec - else - let env = push_rel_context absctx env in - let arctx, s = dest_prod_assum env ar in - let env = push_rel_context arctx env in - let i,args = decompose_app (whd_all env s) in - match i with - | Ind i -> - begin match spec with - | Dead_code -> spec - | Subterm(st,tree) -> - let recargs = get_recargs_approx env tree i args in - let recargs = inter_wf_paths tree recargs in - Subterm(st,recargs) - | _ -> assert false - end - | _ -> Not_subterm - -(* [subterm_specif renv t] computes the recursive structure of [t] and - compare its size with the size of the initial recursive argument of - the fixpoint we are checking. [renv] collects such information - about variables. -*) - - -let rec subterm_specif renv stack t = - (* maybe reduction is not always necessary! *) - let f,l = decompose_app (whd_all renv.env t) in - match f with - | Rel k -> subterm_var k renv - - | Case (ci,p,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 - let spec = subterm_spec_glb stl in - restrict_spec renv.env spec p - - | 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 - *) - if not (check_inductive_codomain renv.env typarray.(i)) then Not_subterm - else - 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.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 tree = - match Lazy.force x with - | Subterm (Strict,tree') -> incl_wf_paths tree tree' - | Dead_code -> true - | _ -> false - -(************************************************************************) - -exception FixGuardError of env * guard_error - -let error_illegal_rec_call renv fx (arg_renv,arg) = - let (_,le_vars,lt_vars) = - List.fold_left - (fun (i,le,lt) sbt -> - match Lazy.force sbt with - (Subterm(Strict,_) | Dead_code) -> (i+1, le, i::lt) - | (Subterm(Large,_)) -> (i+1, i::le, lt) - | _ -> (i+1, le ,lt)) - (1,[],[]) renv.genv in - raise (FixGuardError (renv.env, - RecursionOnIllegalTerm(fx,(arg_renv.env, arg), - le_vars,lt_vars))) - -let error_partial_apply renv fx = - raise (FixGuardError (renv.env,NotEnoughArgumentsForFixCall fx)) - -let filter_stack_domain env ci p stack = - let absctx, ar = dest_lam_assum env p in - (* Optimization: if the predicate is not dependent, no restriction is needed - and we avoid building the recargs tree. *) - if noccur_with_meta 1 (rel_context_length absctx) ar then stack - else let env = push_rel_context absctx env in - let rec filter_stack env ar stack = - let t = whd_all env ar in - match stack, t with - | elt :: stack', Prod (n,a,c0) -> - let d = LocalAssum (n,a) in - let ty, args = decompose_app (whd_all env a) in - let elt = match ty with - | Ind ind -> - let spec' = stack_element_specif elt in - (match (Lazy.force spec') with - | Not_subterm | Dead_code -> elt - | Subterm(s,path) -> - let recargs = get_recargs_approx env path ind args in - let path = inter_wf_paths path recargs in - SArg (lazy (Subterm(s,path)))) - | _ -> (SArg (lazy Not_subterm)) - in - elt :: filter_stack (push_rel d env) c0 stack' - | _,_ -> List.fold_right (fun _ l -> SArg (lazy Not_subterm) :: l) stack [] - in - filter_stack env ar stack - -(* Check if [def] is a guarded fixpoint body with decreasing arg. - given [recpos], the decreasing arguments of each mutually defined - fixpoint. *) -let check_one_fix renv recpos trees def = - let nfi = Array.length recpos in - - (* Checks if [t] only make valid recursive calls *) - 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 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; - (* 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 - let stack' = push_stack_closures renv l stack in - if List.length stack' <= np then error_partial_apply renv glob - else - (* Retrieve the expected tree for the argument *) - (* Check the decreasing arg is smaller *) - let z = List.nth stack' np in - if not (check_is_subterm (stack_element_specif z) trees.(glob)) 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 lookup_rel p renv.env with - | LocalAssum _ -> - List.iter (check_rec_call renv []) l - | LocalDef (_,c,_) -> - 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); - (* compute the recarg information for the arguments of - each branch *) - let case_spec = branches_specif renv - (lazy_subterm_specif renv [] c_0) ci in - let stack' = push_stack_closures renv l stack in - let stack' = filter_stack_domain renv.env ci p 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 (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 - in T1 ... Tp & - - ap is a sub-term of the formal argument of f & - - f is guarded with respect to the set of pattern variables - 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; - let decrArg = recindxs.(i) in - let renv' = push_fix_renv renv recdef in - let stack' = push_stack_closures renv l stack in - Array.iteri - (fun j 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,u) -> - if evaluable_constant kn renv.env then - try List.iter (check_rec_call renv []) l - with (FixGuardError _ ) -> - let value = (applist(constant_value renv.env (kn,u), l)) in - check_rec_call renv stack value - else List.iter (check_rec_call renv []) l - - | Lambda (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) -> - 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; - let renv' = push_fix_renv renv recdef in - Array.iter (check_rec_call renv' []) bodies - - | (Ind _ | Construct _) -> - List.iter (check_rec_call renv []) l - - | Proj (p, c) -> - List.iter (check_rec_call renv []) l; - check_rec_call renv [] c - - | Var _ -> anomaly (Pp.str "Section variable in Coqchk !") - - | Sort _ -> assert (l = []) - - (* l is not checked because it is considered as the meta's context *) - | (Evar _ | Meta _) -> () - - | (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 - else - match body with - | Lambda (x,a,b) -> - check_rec_call renv [] a; - let renv' = push_var_renv renv (x,a) in - check_nested_fix_body renv' (decr-1) recArgsDecrArg b - | _ -> anomaly (Pp.str "Not enough abstractions in fix body") - - in - check_rec_call renv [] def - - -let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) = - let nbfix = Array.length bodies in - if nbfix = 0 - || Array.length nvect <> nbfix - || Array.length types <> nbfix - || Array.length names <> nbfix - || bodynum < 0 - || bodynum >= nbfix - then anomaly (Pp.str "Ill-formed fix term"); - let fixenv = push_rec_types recdef env in - let raise_err env i err = - error_ill_formed_rec_body env err names i in - (* Check the i-th definition with recarg k *) - let find_ind i k def = - (* check fi does not appear in the k+1 first abstractions, - gives the type of the k+1-eme abstraction (must be an inductive) *) - let rec check_occur env n def = - match (whd_all env def) with - | Lambda (x,a,b) -> - if noccur_with_meta n nbfix a then - let env' = push_rel (LocalAssum (x,a)) env in - if n = k+1 then - (* get the inductive type of the fixpoint *) - let (mind, _) = - try find_inductive env a - with Not_found -> - raise_err env i (RecursionNotOnInductiveType a) in - (mind, (env', b)) - else check_occur env' (n+1) b - else anomaly ~label:"check_one_fix" (Pp.str "Bad occurrence of recursive call") - | _ -> raise_err env i NotEnoughAbstractionInFixBody in - check_occur fixenv 1 def in - (* Do it on every fixpoint *) - let rv = Array.map2_i find_ind nvect bodies in - (Array.map fst rv, Array.map snd rv) - - -let check_fix env ((nvect,_),(names,_,bodies as _recdef) as fix) = - let (minds, rdef) = inductive_of_mutfix env fix in - let get_tree (kn,i) = - let mib = Environ.lookup_mind kn env in - mib.mind_packets.(i).mind_recargs - in - let trees = Array.map get_tree minds in - for i = 0 to Array.length bodies - 1 do - let (fenv,body) = rdef.(i) in - let renv = make_renv fenv nvect.(i) trees.(i) in - try check_one_fix renv nvect trees body - with FixGuardError (fixenv,err) -> - error_ill_formed_rec_body fixenv err names i - done - -(* -let cfkey = Profile.declare_profile "check_fix";; -let check_fix env fix = Profile.profile3 cfkey check_fix env fix;; -*) - -(************************************************************************) -(* Co-fixpoints. *) - -exception CoFixGuardError of env * guard_error - -let anomaly_ill_typed () = - anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor") - -let rec codomain_is_coind env c = - let b = whd_all env c in - match b with - | Prod (x,a,b) -> - codomain_is_coind (push_rel (LocalAssum (x,a)) env) b - | _ -> - (try find_coinductive env b - with Not_found -> - raise (CoFixGuardError (env, CodomainNotInductiveType b))) - -let check_one_cofix env nbfix def deftype = - let rec check_rec_call env alreadygrd n tree vlra t = - if not (noccur_with_meta n nbfix t) then - let c,args = decompose_app (whd_all env t) in - match c with - | Rel p when n <= p && p < n+nbfix -> - (* recursive call: must be guarded and no nested recursive - call allowed *) - if not alreadygrd then - raise (CoFixGuardError (env,UnguardedRecursiveCall t)) - else if not(List.for_all (noccur_with_meta n nbfix) args) then - raise (CoFixGuardError (env,NestedRecursiveOccurrences)) - | Construct ((_,i as cstr_kn),u) -> - let lra = vlra.(i-1) in - let mI = inductive_of_constructor cstr_kn in - let (mib,mip) = lookup_mind_specif env mI in - let realargs = List.skipn mib.mind_nparams args in - let rec process_args_of_constr = function - | (t::lr), (rar::lrar) -> - if rar = mk_norec then - if noccur_with_meta n nbfix t - then process_args_of_constr (lr, lrar) - else raise (CoFixGuardError - (env,RecCallInNonRecArgOfConstructor t)) - else begin - check_rec_call env true n rar (dest_subterms rar) t; - process_args_of_constr (lr, lrar) - end - | [],_ -> () - | _ -> anomaly_ill_typed () - in process_args_of_constr (realargs, lra) - - | Lambda (x,a,b) -> - assert (args = []); - if noccur_with_meta n nbfix a then - let env' = push_rel (LocalAssum (x,a)) env in - check_rec_call env' alreadygrd (n+1) tree vlra b - else - raise (CoFixGuardError (env,RecCallInTypeOfAbstraction a)) - - | CoFix (j,(_,varit,vdefs as recdef)) -> - if List.for_all (noccur_with_meta n nbfix) args - then - if Array.for_all (noccur_with_meta n nbfix) varit then - let nbfix = Array.length vdefs in - let env' = push_rec_types recdef env in - (Array.iter (check_rec_call env' alreadygrd (n+nbfix) tree vlra) vdefs; - List.iter (check_rec_call env alreadygrd n tree vlra) args) - else - raise (CoFixGuardError (env,RecCallInTypeOfDef c)) - else - raise (CoFixGuardError (env,UnguardedRecursiveCall c)) - - | Case (_,p,tm,vrest) -> - begin - let tree = match restrict_spec env (Subterm (Strict, tree)) p with - | Dead_code -> assert false - | Subterm (_, tree') -> tree' - | _ -> raise (CoFixGuardError (env, ReturnPredicateNotCoInductive c)) - in - if (noccur_with_meta n nbfix p) then - if (noccur_with_meta n nbfix tm) then - if (List.for_all (noccur_with_meta n nbfix) args) then - let vlra = dest_subterms tree in - Array.iter (check_rec_call env alreadygrd n tree vlra) vrest - else - raise (CoFixGuardError (env,RecCallInCaseFun c)) - else - raise (CoFixGuardError (env,RecCallInCaseArg c)) - else - raise (CoFixGuardError (env,RecCallInCasePred c)) - end - - | Meta _ -> () - | Evar _ -> - List.iter (check_rec_call env alreadygrd n tree vlra) args - - | _ -> raise (CoFixGuardError (env,NotGuardedForm t)) in - - let (mind, _) = codomain_is_coind env deftype in - let vlra = lookup_subterms env mind in - check_rec_call env false 1 vlra (dest_subterms vlra) def - -(* The function which checks that the whole block of definitions - satisfies the guarded condition *) - -let check_cofix env (bodynum,(names,types,bodies as recdef)) = - let nbfix = Array.length bodies in - for i = 0 to nbfix-1 do - let fixenv = push_rec_types recdef env in - try check_one_cofix fixenv nbfix bodies.(i) types.(i) - with CoFixGuardError (errenv,err) -> - error_ill_formed_rec_body errenv err names i - done diff -Nru coq-doc-8.6/checker/inductive.mli coq-doc-8.15.0/checker/inductive.mli --- coq-doc-8.6/checker/inductive.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/inductive.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,81 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr -> pinductive * constr list - -type mind_specif = mutual_inductive_body * one_inductive_body - -(*s Fetching information in the environment about an inductive type. - Raises [Not_found] if the inductive type is not found. *) -val lookup_mind_specif : env -> inductive -> mind_specif - -val inductive_instance : mutual_inductive_body -> Univ.universe_instance - -val type_of_inductive : env -> mind_specif puniverses -> constr - -(* Return type as quoted by the user *) -val type_of_constructor : pconstructor -> mind_specif -> constr - -val arities_of_specif : mutual_inductive puniverses -> mind_specif -> constr array - -(* [type_case_branches env (I,args) (p:A) c] computes useful types - about the following Cases expression: -

Cases (c :: (I args)) of b1..bn end - It computes the type of every branch (pattern variables are - introduced by products) and the type for the whole expression. - *) -val type_case_branches : - env -> pinductive * constr list -> constr * constr -> constr - -> constr array * constr - -(* Check a [case_info] actually correspond to a Case expression on the - given inductive type. *) -val check_case_info : env -> inductive -> case_info -> unit - -(*s Guard conditions for fix and cofix-points. *) -val check_fix : env -> fixpoint -> unit -val check_cofix : env -> cofixpoint -> unit - -(*s Support for sort-polymorphic inductive types *) - -val type_of_inductive_knowing_parameters : - env -> mind_specif puniverses -> constr array -> constr - -val max_inductive_sort : sorts array -> Univ.universe - -val instantiate_universes : env -> rel_context -> - template_arity -> constr array -> rel_context * sorts - -(***************************************************************) -(* Debug *) - -type size = Large | Strict -type subterm_spec = - Subterm of (size * wf_paths) - | Dead_code - | Not_subterm -type guard_env = - { env : env; - (* dB of last fixpoint *) - rel_min : int; - (* dB of variables denoting subterms *) - genv : subterm_spec Lazy.t list; - } - -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 -Nru coq-doc-8.6/checker/main.ml coq-doc-8.15.0/checker/main.ml --- coq-doc-8.6/checker/main.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/main.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ - -let _ = Checker.start () diff -Nru coq-doc-8.6/checker/Makefile coq-doc-8.15.0/checker/Makefile --- coq-doc-8.6/checker/Makefile 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,88 +0,0 @@ -OCAMLC=ocamlc -OCAMLOPT=ocamlopt - -COQSRC=.. - -MLDIRS=-I $(COQSRC)/config -I $(COQSRC)/lib -I $(COQSRC)/kernel -I +camlp4 -BYTEFLAGS=$(MLDIRS) -OPTFLAGS=$(MLDIRS) - -CHECKERNAME=coqchk - -BINARIES=../bin/$(CHECKERNAME)$(EXE) ../bin/$(CHECKERNAME).opt$(EXE) -MCHECKERLOCAL :=\ - declarations.cmo environ.cmo \ - closure.cmo reduction.cmo \ - type_errors.cmo \ - modops.cmo \ - inductive.cmo typeops.cmo \ - indtypes.cmo subtyping.cmo mod_checking.cmo \ -validate.cmo \ - safe_typing.cmo check.cmo \ - check_stat.cmo checker.cmo - -MCHECKER:=\ - $(COQSRC)/config/coq_config.cmo \ - $(COQSRC)/lib/pp_control.cmo $(COQSRC)/lib/pp.cmo $(COQSRC)/lib/compat.cmo \ - $(COQSRC)/lib/util.cmo $(COQSRC)/lib/option.cmo $(COQSRC)/lib/hashcons.cmo \ - $(COQSRC)/lib/system.cmo $(COQSRC)/lib/flags.cmo \ - $(COQSRC)/lib/predicate.cmo $(COQSRC)/lib/rtree.cmo \ - $(COQSRC)/kernel/names.cmo $(COQSRC)/kernel/univ.cmo \ - $(COQSRC)/kernel/esubst.cmo term.cmo \ - $(MCHECKERLOCAL) - -all: $(BINARIES) - -byte : ../bin/$(CHECKERNAME)$(EXE) -opt : ../bin/$(CHECKERNAME).opt$(EXE) - -check.cma: $(MCHECKERLOCAL) - ocamlc $(BYTEFLAGS) -a -o $@ $(MCHECKER) - -check.cmxa: $(MCHECKERLOCAL:.cmo=.cmx) - ocamlopt $(OPTFLAGS) -a -o $@ $(MCHECKER:.cmo=.cmx) - -../bin/$(CHECKERNAME)$(EXE): check.cma - ocamlc $(BYTEFLAGS) -o $@ unix.cma gramlib.cma check.cma main.ml - -../bin/$(CHECKERNAME).opt$(EXE): check.cmxa - ocamlopt $(OPTFLAGS) -o $@ unix.cmxa gramlib.cmxa check.cmxa main.ml - -stats: - @echo STRUCTURE - @wc names.ml term.ml declarations.ml environ.ml type_errors.ml - @echo - @echo REDUCTION - @-wc esubst.ml closure.ml reduction.ml - @echo - @echo TYPAGE - @wc univ.ml inductive.ml indtypes.ml typeops.ml safe_typing.ml - @echo - @echo MODULES - @wc modops.ml subtyping.ml - @echo - @echo INTERFACE - @wc check*.ml main.ml - @echo - @echo TOTAL - @wc *.ml | tail -1 - -.SUFFIXES:.ml .mli .cmi .cmo .cmx - -.ml.cmo: - $(OCAMLC) -c $(BYTEFLAGS) $< - -.ml.cmx: - $(OCAMLOPT) -c $(OPTFLAGS) $< - -.mli.cmi: - $(OCAMLC) -c $(BYTEFLAGS) $< - - -depend:: - ocamldep *.ml* > .depend - -clean:: - rm -f *.cm* *.o *.a *~ $(BINARIES) - --include .depend diff -Nru coq-doc-8.6/checker/mod_checking.ml coq-doc-8.15.0/checker/mod_checking.ml --- coq-doc-8.6/checker/mod_checking.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/mod_checking.ml 2022-01-13 11:55:53.000000000 +0000 @@ -1,64 +1,81 @@ - open Pp open Util open Names -open Cic -open Term open Reduction open Typeops -open Indtypes -open Modops -open Subtyping open Declarations open Environ (** {6 Checking constants } *) -let refresh_arity ar = - let ctxt, hd = decompose_prod_assum ar in - match hd with - Sort (Type u) when not (Univ.is_univ_variable u) -> - let ul = Univ.Level.make DirPath.empty 1 in - let u' = Univ.Universe.make ul in - let cst = Univ.enforce_leq u u' Univ.empty_constraint in - let ctx = Univ.ContextSet.make (Univ.LSet.singleton ul) cst in - mkArity (ctxt,Prop Null), ctx - | _ -> ar, Univ.ContextSet.empty - -let check_constant_declaration env kn cb = - Flags.if_verbose Feedback.msg_notice (str " checking cst: " ++ prcon kn); - let env' = - if cb.const_polymorphic then - let inst = Univ.make_abstract_instance cb.const_universes in - let ctx = Univ.UContext.make (inst, Univ.UContext.constraints cb.const_universes) in - push_context ~strict:false ctx env - else push_context ~strict:true cb.const_universes env - in - let envty, ty = - match cb.const_type with - RegularArity ty -> - let ty', cu = refresh_arity ty in - let envty = push_context_set cu env' in - let _ = infer_type envty ty' in envty, ty - | TemplateArity(ctxt,par) -> - let _ = check_ctxt env' ctxt in - check_polymorphic_arity env' ctxt par; - env', it_mkProd_or_LetIn (Sort(Type par.template_level)) ctxt +let indirect_accessor : (cooking_info Opaqueproof.opaque -> Constr.t * unit Opaqueproof.delayed_universes) ref = + ref (fun _ -> assert false) + +let set_indirect_accessor f = indirect_accessor := f + +let register_opacified_constant env opac kn cb = + let rec gather_consts s c = + match Constr.kind c with + | Constr.Const (c, _) -> Cset.add c s + | _ -> Constr.fold gather_consts s c + in + let wo_body = + Cset.fold + (fun kn s -> + if Declareops.constant_has_body (lookup_constant kn env) then s else + match Cmap.find_opt kn opac with + | None -> Cset.add kn s + | Some s' -> Cset.union s' s) + (gather_consts Cset.empty cb) + Cset.empty + in + Cmap.add kn wo_body opac + +let check_constant_declaration env opac kn cb opacify = + Flags.if_verbose Feedback.msg_notice (str " checking cst:" ++ Constant.print kn); + let env = CheckFlags.set_local_flags cb.const_typing_flags env in + let poly, env = + match cb.const_universes with + | Monomorphic -> + (* Monomorphic universes are stored at the library level, the + ones in const_universes should not be needed *) + false, env + | Polymorphic auctx -> + let ctx = Univ.AbstractContext.repr auctx in + (* [env] contains De Bruijn universe variables *) + let env = push_context ~strict:false ctx env in + true, env + in + let ty = cb.const_type in + let _ = infer_type env ty in + let body, env = match cb.const_body with + | Undef _ | Primitive _ -> None, env + | Def c -> Some c, env + | OpaqueDef o -> + let c, u = !indirect_accessor o in + let env = match u, cb.const_universes with + | Opaqueproof.PrivateMonomorphic (), Monomorphic -> env + | Opaqueproof.PrivatePolymorphic (_, local), Polymorphic _ -> + push_subgraph local env + | _ -> assert false + in + Some c, env in - let () = - match body_of_constant cb with + let () = + match body with | Some bd -> - (match cb.const_proj with - | None -> let j = infer envty bd in - conv_leq envty j ty - | Some pb -> - let env' = add_constant kn cb env' in - let j = infer env' bd in - conv_leq envty j ty) + let j = infer env bd in + (try conv_leq env j.uj_type ty + with NotConvertible -> Type_errors.error_actual_type env j ty) | None -> () in - if cb.const_polymorphic then add_constant kn cb env - else add_constant kn cb env' + match body with + | Some body when opacify -> register_opacified_constant env opac kn body + | Some _ | None -> opac + +let check_constant_declaration env opac kn cb opacify = + let opac = check_constant_declaration env opac kn cb opacify in + Environ.add_constant kn cb env, opac (** {6 Checking modules } *) @@ -74,78 +91,106 @@ let mk_mtb mp sign delta = { mod_mp = mp; - mod_expr = Abstract; + mod_expr = (); mod_type = sign; mod_type_alg = None; - mod_constraints = Univ.ContextSet.empty; mod_delta = delta; - mod_retroknowledge = []; } + mod_retroknowledge = ModTypeRK; } -let rec check_module env mp mb = - let (_:module_signature) = - check_signature env mb.mod_type mb.mod_mp mb.mod_delta - in - let optsign = match mb.mod_expr with - |Struct sign -> Some (check_signature env sign mb.mod_mp mb.mod_delta) - |Algebraic me -> Some (check_mexpression env me mb.mod_mp mb.mod_delta) - |Abstract|FullStruct -> None +let rec collect_constants_without_body sign mp accu = + let collect_sf s lab = function + | SFBconst cb -> + let c = Constant.make2 mp lab in + if Declareops.constant_has_body cb then s else Cset.add c s + | SFBmodule msb -> collect_constants_without_body msb.mod_type (MPdot(mp,lab)) s + | SFBmind _ | SFBmodtype _ -> s in + match sign with + | MoreFunctor _ -> Cset.empty (* currently ignored *) + | NoFunctor struc -> + List.fold_left (fun s (lab,mb) -> collect_sf s lab mb) accu struc + +let rec check_module env opac mp mb opacify = + Flags.if_verbose Feedback.msg_notice (str " checking module: " ++ str (ModPath.to_string mp)); + let env = Modops.add_retroknowledge mb.mod_retroknowledge env in + let sign, opac = + check_signature env opac mb.mod_type mb.mod_mp mb.mod_delta opacify + in + let optsign, opac = match mb.mod_expr with + |Struct sign_struct -> + let opacify = collect_constants_without_body sign mb.mod_mp opacify in + let sign, opac = check_signature env opac sign_struct mb.mod_mp mb.mod_delta opacify in + Some (sign, mb.mod_delta), opac + |Algebraic me -> Some (check_mexpression env opac me mb.mod_mp mb.mod_delta), opac + |Abstract|FullStruct -> None, opac in - match optsign with + let () = match optsign with |None -> () - |Some sign -> - let mtb1 = mk_mtb mp sign mb.mod_delta + |Some (sign,delta) -> + let mtb1 = mk_mtb mp sign delta and mtb2 = mk_mtb mp mb.mod_type mb.mod_delta in - let env = add_module_type mp mtb1 env in - Subtyping.check_subtypes env mtb1 mtb2 + let env = Modops.add_module_type mp mtb1 env in + let cu = Subtyping.check_subtypes env mtb1 mtb2 in + if not (Environ.check_constraints cu env) then + CErrors.user_err Pp.(str "Incorrect universe constraints for module subtyping"); + in + opac and check_module_type env mty = - let (_:module_signature) = - check_signature env mty.mod_type mty.mod_mp mty.mod_delta in + Flags.if_verbose Feedback.msg_notice (str " checking module type: " ++ str (ModPath.to_string mty.mod_mp)); + let (_:module_signature), _ = + check_signature env Cmap.empty mty.mod_type mty.mod_mp mty.mod_delta Cset.empty in () -and check_structure_field env mp lab res = function +and check_structure_field env opac mp lab res opacify = function | SFBconst cb -> let c = Constant.make2 mp lab in - check_constant_declaration env c cb + check_constant_declaration env opac c cb (Cset.mem c opacify) | SFBmind mib -> - let kn = MutInd.make2 mp lab in - let kn = mind_of_delta res kn in - Indtypes.check_inductive env kn mib + let kn = KerName.make mp lab in + let kn = Mod_subst.mind_of_delta_kn res kn in + CheckInductive.check_inductive env kn mib, opac | SFBmodule msb -> - let () = check_module env (MPdot(mp,lab)) msb in - Modops.add_module msb env + let opac = check_module env opac (MPdot(mp,lab)) msb opacify in + Modops.add_module msb env, opac | SFBmodtype mty -> check_module_type env mty; - add_modtype (MPdot(mp,lab)) mty env + add_modtype mty env, opac -and check_mexpr env mse mp_mse res = match mse with +and check_mexpr env opac mse mp_mse res = match mse with | MEident mp -> let mb = lookup_module mp env in - (subst_and_strengthen mb mp_mse).mod_type + let mb = Modops.strengthen_and_subst_mb mb mp_mse false in + mb.mod_type, mb.mod_delta | MEapply (f,mp) -> - let sign = check_mexpr env f mp_mse res in - let farg_id, farg_b, fbody_b = destr_functor sign in - let mtb = module_type_of_module (Some mp) (lookup_module mp env) in - check_subtypes env mtb farg_b; - subst_signature (map_mbid farg_id mp) fbody_b - | MEwith _ -> error_with_module () + let sign, delta = check_mexpr env opac f mp_mse res in + let farg_id, farg_b, fbody_b = Modops.destr_functor sign in + let mtb = Modops.module_type_of_module (lookup_module mp env) in + let cu = Subtyping.check_subtypes env mtb farg_b in + if not (Environ.check_constraints cu env) then + CErrors.user_err Pp.(str "Incorrect universe constraints for module subtyping"); + let subst = Mod_subst.map_mbid farg_id mp Mod_subst.empty_delta_resolver in + Modops.subst_signature subst fbody_b, Mod_subst.subst_codom_delta_resolver subst delta + | MEwith _ -> CErrors.user_err Pp.(str "Unsupported 'with' constraint in module implementation") + -and check_mexpression env sign mp_mse res = match sign with +and check_mexpression env opac sign mp_mse res = match sign with | MoreFunctor (arg_id, mtb, body) -> check_module_type env mtb; - let env' = add_module_type (MPbound arg_id) mtb env in - let body = check_mexpression env' body mp_mse res in - MoreFunctor(arg_id,mtb,body) - | NoFunctor me -> check_mexpr env me mp_mse res + let env' = Modops.add_module_type (MPbound arg_id) mtb env in + let body, delta = check_mexpression env' opac body mp_mse res in + MoreFunctor(arg_id,mtb,body), delta + | NoFunctor me -> check_mexpr env opac me mp_mse res -and check_signature env sign mp_mse res = match sign with +and check_signature env opac sign mp_mse res opacify = match sign with | MoreFunctor (arg_id, mtb, body) -> check_module_type env mtb; - let env' = add_module_type (MPbound arg_id) mtb env in - let body = check_signature env' body mp_mse res in - MoreFunctor(arg_id,mtb,body) + let env' = Modops.add_module_type (MPbound arg_id) mtb env in + let body, opac = check_signature env' opac body mp_mse res Cset.empty in + MoreFunctor(arg_id,mtb,body), opac | NoFunctor struc -> - let (_:env) = List.fold_left (fun env (lab,mb) -> - check_structure_field env mp_mse lab res mb) env struc + let (_:env), opac = List.fold_left (fun (env, opac) (lab,mb) -> + check_structure_field env opac mp_mse lab res opacify mb) (env, opac) struc in - NoFunctor struc + NoFunctor struc, opac + +let check_module env opac mp mb = check_module env opac mp mb Cset.empty diff -Nru coq-doc-8.6/checker/mod_checking.mli coq-doc-8.15.0/checker/mod_checking.mli --- coq-doc-8.6/checker/mod_checking.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/mod_checking.mli 2022-01-13 11:55:53.000000000 +0000 @@ -1,9 +1,13 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Names.module_path -> Cic.module_body -> unit +val set_indirect_accessor : (Declarations.cooking_info Opaqueproof.opaque -> Constr.t * unit Opaqueproof.delayed_universes) -> unit + +val check_module : Environ.env -> Names.Cset.t Names.Cmap.t -> Names.ModPath.t -> Declarations.module_body -> Names.Cset.t Names.Cmap.t diff -Nru coq-doc-8.6/checker/modops.ml coq-doc-8.15.0/checker/modops.ml --- coq-doc-8.6/checker/modops.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/modops.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,147 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* true - | NoFunctor _ -> false - -let destr_functor = function - | MoreFunctor (arg_id,arg_t,body_t) -> (arg_id,arg_t,body_t) - | NoFunctor _ -> error_not_a_functor () - -let module_body_of_type mp mtb = - { mtb with mod_mp = mp; mod_expr = Abstract } - -let rec add_structure mp sign resolver env = - let add_one env (l,elem) = - let kn = KerName.make2 mp l in - let con = Constant.make1 kn in - let mind = mind_of_delta resolver (MutInd.make1 kn) in - match elem with - | SFBconst cb -> - (* let con = constant_of_delta resolver con in*) - Environ.add_constant con cb env - | SFBmind mib -> - (* let mind = mind_of_delta resolver mind in*) - Environ.add_mind mind mib env - | SFBmodule mb -> add_module mb env - (* adds components as well *) - | SFBmodtype mtb -> Environ.add_modtype mtb.mod_mp mtb env - in - List.fold_left add_one env sign - -and add_module mb env = - let mp = mb.mod_mp in - let env = Environ.shallow_add_module mp mb env in - match mb.mod_type with - | NoFunctor struc -> add_structure mp struc mb.mod_delta env - | MoreFunctor _ -> env - -let add_module_type mp mtb env = add_module (module_body_of_type mp mtb) env - -let strengthen_const mp_from l cb resolver = - match cb.const_body with - | Def _ -> cb - | _ -> - let con = Constant.make2 mp_from l in - let u = - if cb.const_polymorphic then - Univ.make_abstract_instance cb.const_universes - else Univ.Instance.empty - in - { cb with - const_body = Def (Declarations.from_val (Const (con,u))) } - -let rec strengthen_mod mp_from mp_to mb = - if Declarations.mp_in_delta mb.mod_mp mb.mod_delta then mb - else strengthen_body true mp_from mp_to mb - -and strengthen_body is_mod mp_from mp_to mb = - match mb.mod_type with - | MoreFunctor _ -> mb - | NoFunctor sign -> - let resolve_out,sign_out = strengthen_sig mp_from sign mp_to mb.mod_delta - in - { mb with - mod_expr = - (if is_mod then Algebraic (NoFunctor (MEident mp_to)) else Abstract); - mod_type = NoFunctor sign_out; - mod_delta = resolve_out } - -and strengthen_sig mp_from sign mp_to resolver = - match sign with - | [] -> empty_delta_resolver,[] - | (l,SFBconst cb) :: rest -> - let item' = l,SFBconst (strengthen_const mp_from l cb resolver) in - let resolve_out,rest' = strengthen_sig mp_from rest mp_to resolver in - 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' - | (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 (*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' - -let strengthen mtb mp = - strengthen_body false mtb.mod_mp mp mtb - -let subst_and_strengthen mb mp = - strengthen_mod mb.mod_mp mp (subst_module (map_mp mb.mod_mp mp) mb) - -let module_type_of_module mp mb = - let mtb = - { mb with - mod_expr = Abstract; - mod_type_alg = None; - mod_retroknowledge = [] } - in - match mp with - | Some mp -> strengthen {mtb with mod_mp = mp} mp - | None -> mtb diff -Nru coq-doc-8.6/checker/modops.mli coq-doc-8.15.0/checker/modops.mli --- coq-doc-8.6/checker/modops.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/modops.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,47 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* module_body -> module_type_body - -val is_functor : ('ty,'a) functorize -> bool - -val destr_functor : ('ty,'a) functorize -> MBId.t * 'ty * ('ty,'a) functorize - -(* adds a module and its components, but not the constraints *) -val add_module : module_body -> env -> env - -val add_module_type : module_path -> module_type_body -> env -> env - -val strengthen : module_type_body -> module_path -> module_type_body - -val subst_and_strengthen : module_body -> module_path -> module_body - -val error_incompatible_modtypes : - module_type_body -> module_type_body -> 'a - -val error_not_match : label -> structure_field_body -> 'a - -val error_with_module : unit -> 'a - -val error_no_such_label : label -> 'a - -val error_no_such_label_sub : - label -> module_path -> 'a - -val error_not_a_constant : label -> 'a - -val error_not_a_module : label -> 'a diff -Nru coq-doc-8.6/checker/print.ml coq-doc-8.15.0/checker/print.ml --- coq-doc-8.6/checker/print.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/print.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,146 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* print_string "#"; print_int n - | Meta n -> print_string "Meta("; print_int n; print_string ")" - | Var id -> print_string (Id.to_string id) - | Sort s -> sort_display s - | Cast (c,_, t) -> open_hovbox 1; - print_string "("; (term_display c); print_cut(); - print_string "::"; (term_display t); print_string ")"; close_box() - | Prod (Name(id),t,c) -> - open_hovbox 1; - print_string"("; print_string (Id.to_string id); - print_string ":"; box_display t; - print_string ")"; print_cut(); - box_display c; close_box() - | Prod (Anonymous,t,c) -> - print_string"("; box_display t; print_cut(); print_string "->"; - box_display c; print_string ")"; - | Lambda (na,t,c) -> - print_string "["; name_display na; - print_string ":"; box_display t; print_string "]"; - print_cut(); box_display c; - | LetIn (na,b,t,c) -> - print_string "["; name_display na; print_string "="; - box_display b; print_cut(); - print_string ":"; box_display t; print_string "]"; - print_cut(); box_display c; - | App (c,l) -> - print_string "("; - box_display c; - Array.iter (fun x -> print_space (); box_display x) l; - print_string ")" - | Evar _ -> print_string "Evar#" - | Const (c,u) -> print_string "Cons("; - sp_con_display c; - print_string ","; print_instance u; - print_string ")" - | Ind ((sp,i),u) -> - print_string "Ind("; - sp_display sp; - print_string ","; print_int i; - print_string ","; print_instance u; - print_string ")" - | Construct (((sp,i),j),u) -> - print_string "Constr("; - sp_display sp; - print_string ","; - print_int i; print_string ","; print_int j; - print_string ","; print_instance u; print_string ")" - | Case (ci,p,c,bl) -> - open_vbox 0; - print_string "<"; box_display p; print_string ">"; - print_cut(); print_string "Case"; - print_space(); box_display c; print_space (); print_string "of"; - open_vbox 0; - Array.iter (fun x -> print_cut(); box_display x) bl; - close_box(); - print_cut(); - print_string "end"; - close_box() - | Fix ((t,i),(lna,tl,bl)) -> - print_string "Fix("; print_int i; print_string ")"; - print_cut(); - open_vbox 0; - let print_fix () = - for k = 0 to (Array.length tl) - 1 do - open_vbox 0; - name_display lna.(k); print_string "/"; - print_int t.(k); print_cut(); print_string ":"; - box_display tl.(k) ; print_cut(); print_string ":="; - box_display bl.(k); close_box (); - print_cut() - done - in print_string"{"; print_fix(); print_string"}" - | CoFix(i,(lna,tl,bl)) -> - print_string "CoFix("; print_int i; print_string ")"; - print_cut(); - open_vbox 0; - let print_fix () = - for k = 0 to (Array.length tl) - 1 do - open_vbox 1; - name_display lna.(k); print_cut(); print_string ":"; - box_display tl.(k) ; print_cut(); print_string ":="; - box_display bl.(k); close_box (); - print_cut(); - done - in print_string"{"; print_fix (); print_string"}" - | Proj (p, c) -> - print_string "Proj("; sp_con_display (Projection.constant p); print_string ","; - box_display c; print_string ")" - - and box_display c = open_hovbox 1; term_display c; close_box() - - and sort_display = function - | Prop(Pos) -> print_string "Set" - | Prop(Null) -> print_string "Prop" - | Type u -> print_string "Type("; chk_pp (Univ.pr_uni u); print_string ")" - - and name_display = function - | Name id -> print_string (Id.to_string id) - | Anonymous -> print_string "_" -(* Remove the top names for library and Scratch to avoid long names *) - and sp_display sp = -(* let dir,l = decode_kn sp in - let ls = - match List.rev_map Id.to_string (DirPath.repr dir) with - ("Top"::l)-> l - | ("Coq"::_::l) -> l - | l -> l - in List.iter (fun x -> print_string x; print_string ".") ls;*) - print_string (MutInd.debug_to_string sp) - and sp_con_display sp = -(* let dir,l = decode_kn sp in - let ls = - match List.rev_map Id.to_string (DirPath.repr dir) with - ("Top"::l)-> l - | ("Coq"::_::l) -> l - | l -> l - in List.iter (fun x -> print_string x; print_string ".") ls;*) - print_string (Constant.debug_to_string sp) - - in - try - box_display csr; print_flush() - with e -> - print_string (Printexc.to_string e);print_flush (); - raise e - - - diff -Nru coq-doc-8.6/checker/reduction.ml coq-doc-8.15.0/checker/reduction.ml --- coq-doc-8.6/checker/reduction.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/reduction.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,540 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* true - | Zupdate _::s -> is_empty_stack s - | Zshift _::s -> is_empty_stack s - | _ -> false - -(* Compute the lift to be performed on a term placed in a given stack *) -let el_stack el stk = - let n = - List.fold_left - (fun i z -> - match z with - Zshift n -> i+n - | _ -> i) - 0 - stk in - el_shft n el - -let compare_stack_shape stk1 stk2 = - let rec compare_rec bal stk1 stk2 = - match (stk1,stk2) with - ([],[]) -> bal=0 - | ((Zupdate _|Zshift _)::s1, _) -> compare_rec bal s1 stk2 - | (_, (Zupdate _|Zshift _)::s2) -> compare_rec bal stk1 s2 - | (Zapp l1::s1, _) -> compare_rec (bal+Array.length l1) s1 stk2 - | (_, Zapp l2::s2) -> compare_rec (bal-Array.length l2) stk1 s2 - | (Zproj (n1,m1,p1)::s1, Zproj (n2,m2,p2)::s2) -> - Int.equal bal 0 && compare_rec 0 s1 s2 - | ((Zcase(c1,_,_)|ZcaseT(c1,_,_,_))::s1, - (Zcase(c2,_,_)|ZcaseT(c2,_,_,_))::s2) -> - bal=0 (* && c1.ci_ind = c2.ci_ind *) && compare_rec 0 s1 s2 - | (Zfix(_,a1)::s1, Zfix(_,a2)::s2) -> - bal=0 && compare_rec 0 a1 a2 && compare_rec 0 s1 s2 - | (_,_) -> false in - compare_rec 0 stk1 stk2 - -type lft_constr_stack_elt = - Zlapp of (lift * fconstr) array - | Zlproj of Names.projection * lift - | Zlfix of (lift * fconstr) * lft_constr_stack - | Zlcase of case_info * lift * fconstr * fconstr array -and lft_constr_stack = lft_constr_stack_elt list - -let rec zlapp v = function - Zlapp v2 :: s -> zlapp (Array.append v v2) s - | s -> Zlapp v :: s - -let pure_stack lfts stk = - let rec pure_rec lfts stk = - match stk with - [] -> (lfts,[]) - | zi::s -> - (match (zi,pure_rec lfts s) with - (Zupdate _,lpstk) -> lpstk - | (Zshift n,(l,pstk)) -> (el_shft n l, pstk) - | (Zapp a, (l,pstk)) -> - (l,zlapp (Array.map (fun t -> (l,t)) a) pstk) - | (Zproj (n,m,c), (l,pstk)) -> - (l, Zlproj (c,l)::pstk) - | (Zfix(fx,a),(l,pstk)) -> - let (lfx,pa) = pure_rec l a in - (l, Zlfix((lfx,fx),pa)::pstk) - | (ZcaseT(ci,p,br,env),(l,pstk)) -> - (l,Zlcase(ci,l,mk_clos env p,mk_clos_vect env br)::pstk) - | (Zcase(ci,p,br),(l,pstk)) -> - (l,Zlcase(ci,l,p,br)::pstk)) in - snd (pure_rec lfts stk) - -(****************************************************************************) -(* Reduction Functions *) -(****************************************************************************) - -let whd_betaiotazeta x = - match x with - | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _| - Prod _|Lambda _|Fix _|CoFix _) -> x - | _ -> whd_val (create_clos_infos betaiotazeta empty_env) (inject x) - -let whd_all env t = - match t with - | (Sort _|Meta _|Evar _|Ind _|Construct _| - Prod _|Lambda _|Fix _|CoFix _) -> t - | _ -> whd_val (create_clos_infos betadeltaiota env) (inject t) - -let whd_allnolet env t = - match t with - | (Sort _|Meta _|Evar _|Ind _|Construct _| - Prod _|Lambda _|Fix _|CoFix _|LetIn _) -> t - | _ -> whd_val (create_clos_infos betadeltaiotanolet env) (inject t) - -(* Beta *) - -let beta_appvect c v = - let rec stacklam env t stack = - match t, stack with - Lambda(_,_,c), arg::stacktl -> stacklam (arg::env) c stacktl - | _ -> applist (substl env t, stack) in - stacklam [] c (Array.to_list v) - -(********************************************************************) -(* Conversion *) -(********************************************************************) - -(* Conversion utility functions *) -type 'a conversion_function = env -> 'a -> 'a -> unit - -exception NotConvertible -exception NotConvertibleVect of int - -let convert_universes univ u u' = - if Univ.Instance.check_eq univ u u' then () - else raise NotConvertible - -let compare_stacks f fmind lft1 stk1 lft2 stk2 = - let rec cmp_rec pstk1 pstk2 = - match (pstk1,pstk2) with - | (z1::s1, z2::s2) -> - cmp_rec s1 s2; - (match (z1,z2) with - | (Zlapp a1,Zlapp a2) -> Array.iter2 f a1 a2 - | (Zlfix(fx1,a1),Zlfix(fx2,a2)) -> - f fx1 fx2; cmp_rec a1 a2 - | (Zlproj (c1,l1),Zlproj (c2,l2)) -> - if not (Names.eq_con_chk - (Names.Projection.constant c1) - (Names.Projection.constant c2)) then - raise NotConvertible - | (Zlcase(ci1,l1,p1,br1),Zlcase(ci2,l2,p2,br2)) -> - if not (fmind ci1.ci_ind ci2.ci_ind) then - raise NotConvertible; - f (l1,p1) (l2,p2); - Array.iter2 (fun c1 c2 -> f (l1,c1) (l2,c2)) br1 br2 - | _ -> assert false) - | _ -> () in - if compare_stack_shape stk1 stk2 then - cmp_rec (pure_stack lft1 stk1) (pure_stack lft2 stk2) - else raise NotConvertible - -(* Convertibility of sorts *) - -type conv_pb = - | CONV - | CUMUL - -let sort_cmp env univ pb s0 s1 = - match (s0,s1) with - | (Prop c1, Prop c2) when pb = CUMUL -> if c1 = Pos && c2 = Null then raise NotConvertible - | (Prop c1, Prop c2) -> if c1 <> c2 then raise NotConvertible - | (Prop c1, Type u) -> - (match pb with - CUMUL -> () - | _ -> raise NotConvertible) - | (Type u1, Type u2) -> - (** FIXME: handle type-in-type option here *) - if (* snd (engagement env) == StratifiedType && *) - not - (match pb with - | CONV -> Univ.check_eq univ u1 u2 - | CUMUL -> Univ.check_leq univ u1 u2) - then begin - if !Flags.debug then begin - let op = match pb with CONV -> "=" | CUMUL -> "<=" in - Printf.eprintf "sort_cmp: %s\n%!" Pp.(string_of_ppcmds - (str"Error: " ++ Univ.pr_uni u1 ++ str op ++ Univ.pr_uni u2 ++ str ":" ++ cut() - ++ Univ.pr_universes univ)) - end; - raise NotConvertible - end - | (_, _) -> raise NotConvertible - -let rec no_arg_available = function - | [] -> true - | Zupdate _ :: stk -> no_arg_available stk - | Zshift _ :: stk -> no_arg_available stk - | Zapp v :: stk -> Array.length v = 0 && no_arg_available stk - | Zproj _ :: _ -> true - | Zcase _ :: _ -> true - | ZcaseT _ :: _ -> true - | Zfix _ :: _ -> true - -let rec no_nth_arg_available n = function - | [] -> true - | Zupdate _ :: stk -> no_nth_arg_available n stk - | Zshift _ :: stk -> no_nth_arg_available n stk - | Zapp v :: stk -> - let k = Array.length v in - if n >= k then no_nth_arg_available (n-k) stk - else false - | Zproj _ :: _ -> true - | Zcase _ :: _ -> true - | ZcaseT _ :: _ -> true - | Zfix _ :: _ -> true - -let rec no_case_available = function - | [] -> true - | Zupdate _ :: stk -> no_case_available stk - | Zshift _ :: stk -> no_case_available stk - | Zapp _ :: stk -> no_case_available stk - | Zproj (_,_,_) :: _ -> false - | Zcase _ :: _ -> false - | ZcaseT _ :: _ -> false - | Zfix _ :: _ -> true - -let in_whnf (t,stk) = - match fterm_of t with - | (FLetIn _ | FCase _ | FCaseT _ | FApp _ | FCLOS _ | FLIFT _ | FCast _) -> false - | FLambda _ -> no_arg_available stk - | FConstruct _ -> no_case_available stk - | FCoFix _ -> no_case_available stk - | FFix(((ri,n),(_,_,_)),_) -> no_nth_arg_available ri.(n) stk - | (FFlex _ | FProd _ | FEvar _ | FInd _ | FAtom _ | FRel _ | FProj _) -> true - | FLOCKED -> assert false - -let oracle_order fl1 fl2 = - match fl1,fl2 with - ConstKey c1, ConstKey c2 -> (*height c1 > height c2*)false - | _, ConstKey _ -> true - | _ -> false - -let unfold_projection infos p c = - let pb = lookup_projection p (infos_env infos) in - let s = Zproj (pb.proj_npars, pb.proj_arg, p) in - (c, s) - -(* Conversion between [lft1]term1 and [lft2]term2 *) -let rec ccnv univ cv_pb infos lft1 lft2 term1 term2 = - eqappr univ cv_pb infos (lft1, (term1,[])) (lft2, (term2,[])) - -(* Conversion between [lft1](hd1 v1) and [lft2](hd2 v2) *) -and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) = - Control.check_for_interrupt (); - (* First head reduce both terms *) - 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), - and st1 might not be in whnf anymore. If so, we iterate ccnv. *) - if in_whnf st1' then (st1',st2') else whd_both st1' st2' in - let ((hd1,v1),(hd2,v2)) = whd_both st1 st2 in - let appr1 = (lft1,(hd1,v1)) and appr2 = (lft2,(hd2,v2)) in - (* compute the lifts that apply to the head of the term (hd1 and hd2) *) - let el1 = el_stack lft1 v1 in - let el2 = el_stack lft2 v2 in - match (fterm_of hd1, fterm_of hd2) with - (* case of leaves *) - | (FAtom a1, FAtom a2) -> - (match a1, a2 with - | (Sort s1, Sort s2) -> - assert (is_empty_stack v1 && is_empty_stack v2); - sort_cmp (infos_env infos) univ cv_pb s1 s2 - | (Meta n, Meta m) -> - if n=m - then convert_stacks univ infos lft1 lft2 v1 v2 - else raise NotConvertible - | _ -> raise NotConvertible) - | (FEvar (ev1,args1), FEvar (ev2,args2)) -> - if ev1=ev2 then - (convert_stacks univ infos lft1 lft2 v1 v2; - convert_vect univ infos el1 el2 args1 args2) - else raise NotConvertible - - (* 2 index known to be bound to no constant *) - | (FRel n, FRel m) -> - if reloc_rel n el1 = reloc_rel m el2 - then convert_stacks univ infos lft1 lft2 v1 v2 - else raise NotConvertible - - (* 2 constants, 2 local defined vars or 2 defined rels *) - | (FFlex fl1, FFlex fl2) -> - (try (* try first intensional equality *) - if eq_table_key fl1 fl2 - then convert_stacks univ infos lft1 lft2 v1 v2 - else raise NotConvertible - with NotConvertible -> - (* else the oracle tells which constant is to be expanded *) - let (app1,app2) = - if oracle_order fl1 fl2 then - match unfold_reference infos fl1 with - | Some def1 -> ((lft1, whd_stack infos def1 v1), appr2) - | None -> - (match unfold_reference infos fl2 with - | Some def2 -> (appr1, (lft2, whd_stack infos def2 v2)) - | None -> raise NotConvertible) - else - match unfold_reference infos fl2 with - | Some def2 -> (appr1, (lft2, whd_stack infos def2 v2)) - | None -> - (match unfold_reference infos fl1 with - | Some def1 -> ((lft1, whd_stack infos def1 v1), appr2) - | None -> raise NotConvertible) in - eqappr univ cv_pb infos app1 app2) - - | (FProj (p1,c1), _) -> - let (def1, s1) = unfold_projection infos p1 c1 in - eqappr univ cv_pb infos (lft1, whd_stack infos def1 (s1 :: v1)) appr2 - - | (_, FProj (p2,c2)) -> - let (def2, s2) = unfold_projection infos p2 c2 in - eqappr univ cv_pb infos appr1 (lft2, whd_stack infos def2 (s2 :: v2)) - - (* 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 - ccnv univ CONV infos el1 el2 ty1 ty2; - ccnv univ CONV infos (el_lift el1) (el_lift el2) bd1 bd2 - - | (FProd (_,c1,c2), FProd (_,c'1,c'2)) -> - assert (is_empty_stack v1 && is_empty_stack v2); - (* Luo's system *) - 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 (Pp.str "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 (Pp.str "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, c2) -> - (match unfold_reference infos fl1 with - | Some def1 -> - eqappr univ cv_pb infos (lft1, whd_stack infos def1 v1) appr2 - | None -> - match c2 with - | FConstruct ((ind2,j2),u2) -> - (try - let v2, v1 = - eta_expand_ind_stack (infos_env infos) ind2 hd2 v2 (snd appr1) - in convert_stacks univ infos lft1 lft2 v1 v2 - with Not_found -> raise NotConvertible) - | _ -> raise NotConvertible) - - | (c1, FFlex fl2) -> - (match unfold_reference infos fl2 with - | Some def2 -> - eqappr univ cv_pb infos appr1 (lft2, whd_stack infos def2 v2) - | None -> - match c1 with - | FConstruct ((ind1,j1),u1) -> - (try let v1, v2 = - eta_expand_ind_stack (infos_env infos) ind1 hd1 v1 (snd appr2) - in convert_stacks univ infos lft1 lft2 v1 v2 - with Not_found -> raise NotConvertible) - | _ -> raise NotConvertible) - - (* Inductive types: MutInd MutConstruct Fix Cofix *) - - | (FInd (ind1,u1), FInd (ind2,u2)) -> - if mind_equiv_infos infos ind1 ind2 - then - (let () = convert_universes univ u1 u2 in - convert_stacks univ infos lft1 lft2 v1 v2) - else raise NotConvertible - - | (FConstruct ((ind1,j1),u1), FConstruct ((ind2,j2),u2)) -> - if Int.equal j1 j2 && mind_equiv_infos infos ind1 ind2 - then - (let () = convert_universes univ u1 u2 in - convert_stacks univ infos lft1 lft2 v1 v2) - else raise NotConvertible - - (* Eta expansion of records *) - | (FConstruct ((ind1,j1),u1), _) -> - (try - let v1, v2 = - eta_expand_ind_stack (infos_env infos) ind1 hd1 v1 (snd appr2) - in convert_stacks univ infos lft1 lft2 v1 v2 - with Not_found -> raise NotConvertible) - - | (_, FConstruct ((ind2,j2),u2)) -> - (try - let v2, v1 = - eta_expand_ind_stack (infos_env infos) ind2 hd2 v2 (snd appr1) - in convert_stacks univ infos lft1 lft2 v1 v2 - with Not_found -> raise NotConvertible) - - | (FFix ((op1,(_,tys1,cl1)),e1), FFix((op2,(_,tys2,cl2)),e2)) -> - if op1 = op2 - then - let n = Array.length cl1 in - let fty1 = Array.map (mk_clos e1) tys1 in - let fty2 = Array.map (mk_clos e2) tys2 in - let fcl1 = Array.map (mk_clos (subs_liftn n e1)) cl1 in - let fcl2 = Array.map (mk_clos (subs_liftn n e2)) cl2 in - convert_vect univ infos el1 el2 fty1 fty2; - convert_vect univ infos - (el_liftn n el1) (el_liftn n el2) fcl1 fcl2; - convert_stacks univ infos lft1 lft2 v1 v2 - else raise NotConvertible - - | (FCoFix ((op1,(_,tys1,cl1)),e1), FCoFix((op2,(_,tys2,cl2)),e2)) -> - if op1 = op2 - then - let n = Array.length cl1 in - let fty1 = Array.map (mk_clos e1) tys1 in - let fty2 = Array.map (mk_clos e2) tys2 in - let fcl1 = Array.map (mk_clos (subs_liftn n e1)) cl1 in - let fcl2 = Array.map (mk_clos (subs_liftn n e2)) cl2 in - convert_vect univ infos el1 el2 fty1 fty2; - convert_vect univ infos - (el_liftn n el1) (el_liftn n el2) fcl1 fcl2; - convert_stacks univ infos lft1 lft2 v1 v2 - else raise NotConvertible - - (* Should not happen because both (hd1,v1) and (hd2,v2) are in whnf *) - | ( (FLetIn _, _) | (FCase _,_) | (FCaseT _,_) | (FApp _,_) | (FCLOS _,_) | (FLIFT _,_) - | (_, FLetIn _) | (_,FCase _) | (_,FCaseT _) | (_,FApp _) | (_,FCLOS _) | (_,FLIFT _) - | (FLOCKED,_) | (_,FLOCKED) ) -> assert false - - (* In all other cases, terms are not convertible *) - | _ -> raise NotConvertible - -and convert_stacks univ infos lft1 lft2 stk1 stk2 = - compare_stacks - (fun (l1,t1) (l2,t2) -> ccnv univ CONV infos l1 l2 t1 t2) - (mind_equiv_infos infos) - lft1 stk1 lft2 stk2 - -and convert_vect univ infos lft1 lft2 v1 v2 = - Array.iter2 (fun t1 t2 -> ccnv univ CONV infos lft1 lft2 t1 t2) v1 v2 - -let clos_fconv cv_pb eager_delta env t1 t2 = - let infos = - create_clos_infos - (if eager_delta then betadeltaiota else betaiotazeta) env in - let univ = universes env in - ccnv univ cv_pb infos el_id el_id (inject t1) (inject t2) - -let fconv cv_pb eager_delta env t1 t2 = - if eq_constr t1 t2 then () - else clos_fconv cv_pb eager_delta env t1 t2 - -let conv = fconv CONV false -let conv_leq = fconv CUMUL false - -(* option for conversion : no compilation for the checker *) - -let vm_conv cv_pb = fconv cv_pb true - -(********************************************************************) -(* Special-Purpose Reduction *) -(********************************************************************) - -(* pseudo-reduction rule: - * [hnf_prod_app env s (Prod(_,B)) N --> B[N] - * with an HNF on the first argument to produce a product. - * if this does not work, then we use the string S as part of our - * error message. *) - -let hnf_prod_app env t n = - match whd_all env t with - | Prod (_,_,b) -> subst1 n b - | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product") - -let hnf_prod_applist env t nl = - List.fold_left (hnf_prod_app env) t nl - -(* Dealing with arities *) - -let dest_prod env = - let rec decrec env m c = - let t = whd_all env c in - match t with - | Prod (n,a,c0) -> - let d = LocalAssum (n,a) in - decrec (push_rel d env) (d::m) c0 - | _ -> m,t - in - decrec env empty_rel_context - -(* The same but preserving lets in the context, not internal ones. *) -let dest_prod_assum env = - let rec prodec_rec env l ty = - let rty = whd_allnolet env ty in - match rty with - | Prod (x,t,c) -> - let d = LocalAssum (x,t) in - prodec_rec (push_rel d env) (d::l) c - | LetIn (x,b,t,c) -> - let d = LocalDef (x,b,t) in - prodec_rec (push_rel d env) (d::l) c - | Cast (c,_,_) -> prodec_rec env l c - | _ -> - let rty' = whd_all env rty in - if Term.eq_constr rty' rty then l, rty - else prodec_rec env l rty' - in - prodec_rec env empty_rel_context - -let dest_lam_assum env = - let rec lamec_rec env l ty = - let rty = whd_allnolet env ty in - match rty with - | Lambda (x,t,c) -> - let d = LocalAssum (x,t) in - lamec_rec (push_rel d env) (d::l) c - | LetIn (x,b,t,c) -> - let d = LocalDef (x,b,t) in - lamec_rec (push_rel d env) (d::l) c - | Cast (c,_,_) -> lamec_rec env l c - | _ -> l,rty - in - lamec_rec env empty_rel_context - - -let dest_arity env c = - let l, c = dest_prod_assum env c in - match c with - | Sort s -> l,s - | _ -> error "not an arity" - diff -Nru coq-doc-8.6/checker/reduction.mli coq-doc-8.15.0/checker/reduction.mli --- coq-doc-8.6/checker/reduction.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/reduction.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,53 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr -val whd_all : env -> constr -> constr -val whd_allnolet : env -> constr -> constr - -(************************************************************************) -(*s conversion functions *) - -exception NotConvertible -exception NotConvertibleVect of int -type 'a conversion_function = env -> 'a -> 'a -> unit - -type conv_pb = CONV | CUMUL - -val conv : constr conversion_function -val conv_leq : constr conversion_function - -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 - -(* Pseudo-reduction rule Prod(x,A,B) a --> B[x\a] *) -val hnf_prod_applist : env -> constr -> constr list -> constr - - -(************************************************************************) -(*s Recognizing products and arities modulo reduction *) - -val dest_prod : env -> constr -> rel_context * constr -val dest_prod_assum : env -> constr -> rel_context * constr -val dest_lam_assum : env -> constr -> rel_context * constr - - -val dest_arity : env -> constr -> arity diff -Nru coq-doc-8.6/checker/safe_checking.ml coq-doc-8.15.0/checker/safe_checking.ml --- coq-doc-8.6/checker/safe_checking.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/safe_checking.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,24 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* Names.Cset.t Names.Cmap.t -> compiled_library -> Univ.ContextSet.t -> vodigest -> safe_environment * Names.Cset.t Names.Cmap.t +val unsafe_import : safe_environment -> compiled_library -> Univ.ContextSet.t -> vodigest -> safe_environment diff -Nru coq-doc-8.6/checker/safe_typing.ml coq-doc-8.15.0/checker/safe_typing.ml --- coq-doc-8.6/checker/safe_typing.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/safe_typing.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,94 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* - CErrors.error "Needs option -impredicative-set." - | _ -> () - end; - () - -(* Libraries = Compiled modules *) - -let report_clash f caller dir = - let msg = - str "compiled library " ++ pr_dirpath caller ++ - spc() ++ str "makes inconsistent assumptions over library" ++ spc() ++ - pr_dirpath dir ++ fnl() in - f msg - - -let check_imports f caller env needed = - let check (dp,stamp) = - try - let actual_stamp = lookup_digest env dp in - if stamp <> actual_stamp then report_clash f caller dp - with Not_found -> - error ("Reference to unknown module " ^ (DirPath.to_string dp)) - in - Array.iter check needed - -(* This function should append a certificate to the .vo file. - The digest must be part of the certicate to rule out attackers - that could change the .vo file between the time it was read and - the time the stamp is written. - For the moment, .vo are not signed. *) -let stamp_library file digest = () - -(* When the module is checked, digests do not need to match, but a - warning is issued in case of mismatch *) -let import file clib univs digest = - let env = !genv in - check_imports Feedback.msg_warning clib.comp_name env clib.comp_deps; - check_engagement env clib.comp_enga; - let mb = clib.comp_mod in - Mod_checking.check_module - (push_context_set ~strict:true univs - (push_context_set ~strict:true mb.mod_constraints env)) mb.mod_mp mb; - stamp_library file digest; - full_add_module clib.comp_name mb univs digest - -(* When the module is admitted, digests *must* match *) -let unsafe_import file clib univs digest = - let env = !genv in - if !Flags.debug then check_imports Feedback.msg_warning clib.comp_name env clib.comp_deps - else check_imports (errorlabstrm"unsafe_import") clib.comp_name env clib.comp_deps; - check_engagement env clib.comp_enga; - full_add_module clib.comp_name clib.comp_mod univs digest diff -Nru coq-doc-8.6/checker/safe_typing.mli coq-doc-8.15.0/checker/safe_typing.mli --- coq-doc-8.6/checker/safe_typing.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/safe_typing.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* env - -val set_engagement : engagement -> unit -val import : - CUnix.physical_path -> compiled_library -> Univ.ContextSet.t -> Cic.vodigest -> unit -val unsafe_import : - CUnix.physical_path -> compiled_library -> Univ.ContextSet.t -> Cic.vodigest -> unit diff -Nru coq-doc-8.6/checker/subtyping.ml coq-doc-8.15.0/checker/subtyping.ml --- coq-doc-8.6/checker/subtyping.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/subtyping.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,405 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* - Label.Map.add (Label.of_id id) (IndConstr((ip,i+1), mib)) map) - oib.mind_consnames - map - in - Label.Map.add (Label.of_id oib.mind_typename) (IndType (ip, mib)) map - in - Array.fold_right_i add_mip_nameobjects mib.mind_packets map - - -(* creates (namedobject/namedmodule) map for the whole signature *) - -type labmap = { objs : namedobject Label.Map.t; mods : namedmodule Label.Map.t } - -let empty_labmap = { objs = Label.Map.empty; mods = Label.Map.empty } - -let get_obj mp map l = - try Label.Map.find l map.objs - with Not_found -> error_no_such_label_sub l mp - -let get_mod mp map l = - try Label.Map.find l map.mods - with Not_found -> error_no_such_label_sub l mp - -let make_labmap mp list = - let add_one (l,e) map = - match e with - | SFBconst cb -> { map with objs = Label.Map.add l (Constant cb) map.objs } - | SFBmind mib -> { map with objs = add_mib_nameobjects mp l mib map.objs } - | SFBmodule mb -> { map with mods = Label.Map.add l (Module mb) map.mods } - | SFBmodtype mtb -> { map with mods = Label.Map.add l (Modtype mtb) map.mods } - in - List.fold_right add_one list empty_labmap - - -let check_conv_error error f env a1 a2 = - try - f env a1 a2 - with - NotConvertible -> error () - -(* for now we do not allow reorderings *) -let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2= - let kn = MutInd.make2 mp1 l in - let error () = error_not_match l spec2 in - let check_conv f = check_conv_error error f in - let mib1 = - match info1 with - | IndType ((_,0), mib) -> mib - | _ -> error () - in - let mib2 = subst_mind subst2 mib2 in - let check eq f = if not (eq (f mib1) (f mib2)) then error () in - let bool_equal (x : bool) (y : bool) = x = y in - let u = - check bool_equal (fun x -> x.mind_polymorphic); - if mib1.mind_polymorphic then ( - check Univ.Instance.equal (fun x -> Univ.UContext.instance x.mind_universes); - Univ.UContext.instance mib1.mind_universes) - else Univ.Instance.empty - in - let eq_projection_body p1 p2 = - let check eq f = if not (eq (f p1) (f p2)) then error () in - check MutInd.equal (fun x -> x.proj_ind); - check (==) (fun x -> x.proj_npars); - check (==) (fun x -> x.proj_arg); - check (eq_constr) (fun x -> x.proj_type); - check (eq_constr) (fun x -> fst x.proj_eta); - check (eq_constr) (fun x -> snd x.proj_eta); - check (eq_constr) (fun x -> x.proj_body); true - in - let check_inductive_type env t1 t2 = - - (* Due to sort-polymorphism in inductive types, the conclusions of - t1 and t2, if in Type, are generated as the least upper bounds - of the types of the constructors. - - By monotonicity of the infered l.u.b. wrt subtyping (i.e. if X:U - |- T(X):s and |- M:U' and U'<=U then infer_type(T(M))<=s), each - universe in the conclusion of t1 has an bounding universe in - the conclusion of t2, so that we don't need to check the - subtyping of the conclusions of t1 and t2. - - Even if we'd like to recheck it, the inference of constraints - is not designed to deal with algebraic constraints of the form - max-univ(u1..un) <= max-univ(u'1..u'n), so that it is not easy - to recheck it (in short, we would need the actual graph of - constraints as input while type checking is currently designed - to output a set of constraints instead) *) - - (* So we cheat and replace the subtyping problem on algebraic - constraints of the form max-univ(u1..un) <= max-univ(u'1..u'n) - (that we know are necessary true) by trivial constraints that - the constraint generator knows how to deal with *) - - let (ctx1,s1) = dest_arity env t1 in - let (ctx2,s2) = dest_arity env t2 in - let s1,s2 = - match s1, s2 with - | Type _, Type _ -> (* shortcut here *) Prop Null, Prop Null - | (Prop _, Type _) | (Type _,Prop _) -> error () - | _ -> (s1, s2) in - check_conv conv_leq env - (mkArity (ctx1,s1)) (mkArity (ctx2,s2)) - in - - let check_packet p1 p2 = - let check eq f = if not (eq (f p1) (f p2)) then error () in - check - (fun a1 a2 -> Array.equal Id.equal a1 a2) - (fun p -> p.mind_consnames); - check Id.equal (fun p -> p.mind_typename); - (* nf_lc later *) - (* nf_arity later *) - (* user_lc ignored *) - (* user_arity ignored *) - check Int.equal (fun p -> p.mind_nrealargs); - (* kelim ignored *) - (* listrec ignored *) - (* finite done *) - (* nparams done *) - (* params_ctxt done because part of the inductive types *) - (* Don't check the sort of the type if polymorphic *) - check_inductive_type env - (type_of_inductive env ((mib1,p1),u)) (type_of_inductive env ((mib2,p2),u)) - in - let check_cons_types i p1 p2 = - Array.iter2 (check_conv conv env) - (arities_of_specif (kn,u) (mib1,p1)) - (arities_of_specif (kn,u) (mib2,p2)) - in - check (==) (fun mib -> mib.mind_finite); - check Int.equal (fun mib -> mib.mind_ntypes); - assert (Array.length mib1.mind_packets >= 1 - && Array.length mib2.mind_packets >= 1); - - (* Check that the expected numbers of uniform parameters are the same *) - (* No need to check the contexts of parameters: it is checked *) - (* at the time of checking the inductive arities in check_packet. *) - (* Notice that we don't expect the local definitions to match: only *) - (* the inductive types and constructors types have to be convertible *) - check Int.equal (fun mib -> mib.mind_nparams); - - (*begin - match mib2.mind_equiv with - | None -> () - | Some kn2' -> - let kn2 = scrape_mind env kn2' in - let kn1 = match mib1.mind_equiv with - None -> kn - | Some kn1' -> scrape_mind env kn1' - in - if kn1 <> kn2 then error () - end;*) - (* we check that records and their field names are preserved. *) - let record_equal x y = - match x, y with - | None, None -> true - | Some None, Some None -> true - | Some (Some (id1,p1,pb1)), Some (Some (id2,p2,pb2)) -> - Id.equal id1 id2 && - Array.for_all2 eq_con_chk p1 p2 && - Array.for_all2 eq_projection_body pb1 pb2 - | _, _ -> false - in - check record_equal (fun mib -> mib.mind_record); - if mib1.mind_record != None then begin - let rec names_prod_letin t = match t with - | Prod(n,_,t) -> n::(names_prod_letin t) - | LetIn(n,_,_,t) -> n::(names_prod_letin t) - | Cast(t,_,_) -> names_prod_letin t - | _ -> [] - in - assert (Array.length mib1.mind_packets = 1); - assert (Array.length mib2.mind_packets = 1); - assert (Array.length mib1.mind_packets.(0).mind_user_lc = 1); - assert (Array.length mib2.mind_packets.(0).mind_user_lc = 1); - check - (fun l1 l2 -> List.equal Name.equal l1 l2) - (fun mib -> names_prod_letin mib.mind_packets.(0).mind_user_lc.(0)); - end; - (* we first check simple things *) - Array.iter2 check_packet mib1.mind_packets mib2.mind_packets; - (* and constructor types in the end *) - let _ = Array.map2_i check_cons_types mib1.mind_packets mib2.mind_packets - in () - -let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 = - let error () = error_not_match l spec2 in - let check_conv f = check_conv_error error f in - let check_type env t1 t2 = - - (* If the type of a constant is generated, it may mention - non-variable algebraic universes that the general conversion - algorithm is not ready to handle. Anyway, generated types of - constants are functions of the body of the constant. If the - bodies are the same in environments that are subtypes one of - the other, the types are subtypes too (i.e. if Gamma <= Gamma', - Gamma |- A |> T, Gamma |- A' |> T' and Gamma |- A=A' then T <= T'). - Hence they don't have to be checked again *) - - let t1,t2 = - if isArity t2 then - let (ctx2,s2) = destArity t2 in - match s2 with - | Type v when not (Univ.is_univ_variable v) -> - (* The type in the interface is inferred and is made of algebraic - universes *) - begin try - let (ctx1,s1) = dest_arity env t1 in - match s1 with - | Type u when not (Univ.is_univ_variable u) -> - (* Both types are inferred, no need to recheck them. We - cheat and collapse the types to Prop *) - mkArity (ctx1,Prop Null), mkArity (ctx2,Prop Null) - | Prop _ -> - (* The type in the interface is inferred, it may be the case - that the type in the implementation is smaller because - the body is more reduced. We safely collapse the upper - type to Prop *) - mkArity (ctx1,Prop Null), mkArity (ctx2,Prop Null) - | Type _ -> - (* The type in the interface is inferred and the type in the - implementation is not inferred or is inferred but from a - more reduced body so that it is just a variable. Since - constraints of the form "univ <= max(...)" are not - expressible in the system of algebraic universes: we fail - (the user has to use an explicit type in the interface *) - error () - with UserError _ (* "not an arity" *) -> - error () end - | _ -> t1,t2 - else - (t1,t2) in - check_conv conv_leq env t1 t2 - in - match info1 with - | Constant cb1 -> - 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 (CErrors.error ( - "The kernel does not recognize yet that a parameter can be " ^ - "instantiated by an inductive type. Hint: you can rename the " ^ - "inductive type and give a definition to map the old name to the new " ^ - "name.")); - if constant_has_body cb2 then error () ; - let u = inductive_instance mind1 in - let arity1 = type_of_inductive env ((mind1,mind1.mind_packets.(i)),u) in - let typ2 = Typeops.type_of_constant_type env cb2.const_type in - check_conv conv_leq env arity1 typ2 - | IndConstr (((kn,i),j) as cstr,mind1) -> - ignore (CErrors.error ( - "The kernel does not recognize yet that a parameter can be " ^ - "instantiated by a constructor. Hint: you can rename the " ^ - "constructor and give a definition to map the old name to the new " ^ - "name.")); - if constant_has_body cb2 then error () ; - let u1 = inductive_instance mind1 in - let ty1 = type_of_constructor (cstr,u1) (mind1,mind1.mind_packets.(i)) in - let ty2 = Typeops.type_of_constant_type env cb2.const_type in - check_conv conv env ty1 ty2 - -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 - check_modtypes env mty1 mty2 subst1 subst2 false; - - -and check_signatures env mp1 sig1 sig2 subst1 subst2 = - let map1 = make_labmap mp1 sig1 in - let check_one_body (l,spec2) = - match spec2 with - | SFBconst cb2 -> - check_constant env mp1 l (get_obj mp1 map1 l) - cb2 spec2 subst1 subst2 - | SFBmind mib2 -> - check_inductive env mp1 l (get_obj mp1 map1 l) - mib2 spec2 subst1 subst2 - | SFBmodule msb2 -> - begin - match get_mod mp1 map1 l with - | Module msb -> check_modules env msb msb2 - subst1 subst2 - | _ -> error_not_match l spec2 - end - | SFBmodtype mtb2 -> - let mtb1 = - match get_mod mp1 map1 l with - | Modtype mtb -> mtb - | _ -> error_not_match l spec2 - in - let env = - add_module_type mtb2.mod_mp mtb2 - (add_module_type mtb1.mod_mp mtb1 env) - in - check_modtypes env mtb1 mtb2 subst1 subst2 true - in - List.iter check_one_body sig2 - -and check_modtypes env mtb1 mtb2 subst1 subst2 equiv = - if mtb1==mtb2 || mtb1.mod_type == mtb2.mod_type then () - else - let rec check_structure env str1 str2 equiv subst1 subst2 = - match str1,str2 with - | NoFunctor (list1), - NoFunctor (list2) -> - check_signatures env mtb1.mod_mp list1 list2 subst1 subst2; - if equiv then - check_signatures env mtb2.mod_mp list2 list1 subst1 subst2 - else - () - | MoreFunctor (arg_id1,arg_t1,body_t1), - MoreFunctor (arg_id2,arg_t2,body_t2) -> - check_modtypes env - arg_t2 arg_t1 - (map_mp arg_t1.mod_mp arg_t2.mod_mp) subst2 - equiv; - (* contravariant *) - let env = add_module_type (MPbound arg_id2) arg_t2 env in - let env = - if is_functor body_t1 then env - else - let env = shallow_remove_module mtb1.mod_mp env in - add_module {mod_mp = mtb1.mod_mp; - mod_expr = Abstract; - mod_type = body_t1; - mod_type_alg = None; - mod_constraints = mtb1.mod_constraints; - mod_retroknowledge = []; - mod_delta = mtb1.mod_delta} env - in - check_structure env body_t1 body_t2 equiv - (join (map_mbid arg_id1 (MPbound arg_id2)) subst1) - subst2 - | _ , _ -> error_incompatible_modtypes mtb1 mtb2 - in - check_structure env mtb1.mod_type mtb2.mod_type equiv subst1 subst2 - -let check_subtypes env sup super = - check_modtypes env (strengthen sup sup.mod_mp) super empty_subst - (map_mp super.mod_mp sup.mod_mp) false diff -Nru coq-doc-8.6/checker/subtyping.mli coq-doc-8.15.0/checker/subtyping.mli --- coq-doc-8.6/checker/subtyping.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/subtyping.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* module_type_body -> module_type_body -> unit - - diff -Nru coq-doc-8.6/checker/term.ml coq-doc-8.15.0/checker/term.ml --- coq-doc-8.6/checker/term.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/term.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,449 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* InProp - | Prop Pos -> InSet - | Type _ -> InType - -let family_equal = (==) - -let sort_of_univ u = - if Univ.is_type0m_univ u then Prop Null - else if Univ.is_type0_univ u then Prop Pos - else Type u - -(********************************************************************) -(* Constructions as implemented *) -(********************************************************************) - -let rec strip_outer_cast c = match c with - | Cast (c,_,_) -> strip_outer_cast c - | _ -> c - -let collapse_appl c = match c with - | App (f,cl) -> - let rec collapse_rec f cl2 = - match (strip_outer_cast f) with - | App (g,cl1) -> collapse_rec g (Array.append cl1 cl2) - | _ -> App (f,cl2) - in - collapse_rec f cl - | _ -> c - -let decompose_app c = - match collapse_appl c with - | App (f,cl) -> (f, Array.to_list cl) - | _ -> (c,[]) - - -let applist (f,l) = App (f, Array.of_list l) - - -(****************************************************************************) -(* Functions for dealing with constr terms *) -(****************************************************************************) - -(*********************) -(* Occurring *) -(*********************) - -let iter_constr_with_binders g f n c = match c with - | (Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ - | Construct _) -> () - | Cast (c,_,t) -> f n c; f n t - | Prod (_,t,c) -> f n t; f (g n) c - | Lambda (_,t,c) -> f n t; f (g n) c - | LetIn (_,b,t,c) -> f n b; f n t; f (g n) c - | App (c,l) -> f n c; Array.iter (f n) l - | Evar (_,l) -> Array.iter (f n) l - | Case (_,p,c,bl) -> f n p; f n c; Array.iter (f n) bl - | Fix (_,(_,tl,bl)) -> - Array.iter (f n) tl; - Array.iter (f (iterate g (Array.length tl) n)) bl - | CoFix (_,(_,tl,bl)) -> - Array.iter (f n) tl; - Array.iter (f (iterate g (Array.length tl) n)) bl - | Proj (p, c) -> f n c - -exception LocalOccur - -(* (closedn n M) raises FreeVar if a variable of height greater than n - occurs in M, returns () otherwise *) - -let closedn n c = - let rec closed_rec n c = match c with - | Rel m -> if m>n then raise LocalOccur - | _ -> iter_constr_with_binders succ closed_rec n c - in - try closed_rec n c; true with LocalOccur -> false - -(* [closed0 M] is true iff [M] is a (deBruijn) closed term *) - -let closed0 = closedn 0 - -(* (noccurn n M) returns true iff (Rel n) does NOT occur in term M *) - -let noccurn n term = - let rec occur_rec n c = match c with - | Rel m -> if Int.equal m n then raise LocalOccur - | _ -> iter_constr_with_binders succ occur_rec n c - in - try occur_rec n term; true with LocalOccur -> false - -(* (noccur_between n m M) returns true iff (Rel p) does NOT occur in term M - for n <= p < n+m *) - -let noccur_between n m term = - let rec occur_rec n c = match c with - | Rel(p) -> if n<=p && p iter_constr_with_binders succ occur_rec n c - in - try occur_rec n term; true with LocalOccur -> false - -(* Checking function for terms containing existential variables. - The function [noccur_with_meta] considers the fact that - each existential variable (as well as each isevar) - in the term appears applied to its local context, - which may contain the CoFix variables. These occurrences of CoFix variables - are not considered *) - -let noccur_with_meta n m term = - let rec occur_rec n c = match c with - | Rel p -> if n<=p && p - (match f with - | (Cast (Meta _,_,_)| Meta _) -> () - | _ -> iter_constr_with_binders succ occur_rec n c) - | Evar (_, _) -> () - | _ -> iter_constr_with_binders succ occur_rec n c - in - try (occur_rec n term; true) with LocalOccur -> false - - -(*********************) -(* Lifting *) -(*********************) - -let map_constr_with_binders g f l c = match c with - | (Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ - | Construct _) -> c - | Cast (c,k,t) -> Cast (f l c, k, f l t) - | Prod (na,t,c) -> Prod (na, f l t, f (g l) c) - | Lambda (na,t,c) -> Lambda (na, f l t, f (g l) c) - | LetIn (na,b,t,c) -> LetIn (na, f l b, f l t, f (g l) c) - | App (c,al) -> App (f l c, Array.map (f l) al) - | Evar (e,al) -> Evar (e, Array.map (f l) al) - | Case (ci,p,c,bl) -> Case (ci, f l p, f l c, Array.map (f l) bl) - | Fix (ln,(lna,tl,bl)) -> - let l' = iterate g (Array.length tl) l in - Fix (ln,(lna,Array.map (f l) tl,Array.map (f l') bl)) - | CoFix(ln,(lna,tl,bl)) -> - let l' = iterate g (Array.length tl) l in - CoFix (ln,(lna,Array.map (f l) tl,Array.map (f l') bl)) - | Proj (p, c) -> Proj (p, f l c) - -(* The generic lifting function *) -let rec exliftn el c = match c with - | Rel i -> Rel(reloc_rel i el) - | _ -> map_constr_with_binders el_lift exliftn el c - -(* Lifting the binding depth across k bindings *) - -let liftn k n = - match el_liftn (pred n) (el_shft k el_id) with - | ELID -> (fun c -> c) - | el -> exliftn el - -let lift k = liftn k 1 - -(*********************) -(* Substituting *) -(*********************) - -(* (subst1 M c) substitutes M for Rel(1) in c - we generalise it to (substl [M1,...,Mn] c) which substitutes in parallel - M1,...,Mn for respectively Rel(1),...,Rel(n) in c *) - -(* 1st : general case *) -type info = Closed | Open | Unknown -type 'a substituend = { mutable sinfo: info; sit: 'a } - -let rec lift_substituend depth s = - match s.sinfo with - | Closed -> s.sit - | Open -> lift depth s.sit - | Unknown -> - s.sinfo <- if closed0 s.sit then Closed else Open; - lift_substituend depth s - -let make_substituend c = { sinfo=Unknown; sit=c } - -let substn_many lamv n c = - let lv = Array.length lamv in - if Int.equal lv 0 then c - else - let rec substrec depth c = match c with - | Rel k -> - if k<=depth then c - else if k-depth <= lv then lift_substituend depth lamv.(k-depth-1) - else Rel (k-lv) - | _ -> map_constr_with_binders succ substrec depth c in - substrec n c - -let substnl laml n = - substn_many (Array.map make_substituend (Array.of_list laml)) n -let substl laml = substnl laml 0 -let subst1 lam = substl [lam] - - -(***************************************************************************) -(* Type of assumptions and contexts *) -(***************************************************************************) - -let empty_rel_context = [] -let rel_context_length = List.length -let rel_context_nhyps hyps = - let rec nhyps acc = function - | [] -> acc - | LocalAssum _ :: hyps -> nhyps (1+acc) hyps - | LocalDef _ :: hyps -> nhyps acc hyps in - nhyps 0 hyps -let fold_rel_context f l ~init = List.fold_right f l init - -let map_rel_decl f = function - | LocalAssum (n, typ) as decl -> - let typ' = f typ in - if typ' == typ then decl else - LocalAssum (n, typ') - | LocalDef (n, body, typ) as decl -> - let body' = f body in - let typ' = f typ in - if body' == body && typ' == typ then decl else - LocalDef (n, body', typ') - -let map_rel_context f = - List.smartmap (map_rel_decl f) - -let extended_rel_list n hyps = - let rec reln l p = function - | LocalAssum _ :: hyps -> reln (Rel (n+p) :: l) (p+1) hyps - | LocalDef _ :: hyps -> reln l (p+1) hyps - | [] -> l - in - reln [] 1 hyps - -(* Iterate lambda abstractions *) - -(* compose_lam [xn:Tn;..;x1:T1] b = [x1:T1]..[xn:Tn]b *) -let compose_lam l b = - let rec lamrec = function - | ([], b) -> b - | ((v,t)::l, b) -> lamrec (l, Lambda (v,t,b)) - in - lamrec (l,b) - -(* Transforms a lambda term [x1:T1]..[xn:Tn]T into the pair - ([(xn,Tn);...;(x1,T1)],T), where T is not a lambda *) -let decompose_lam = - let rec lamdec_rec l c = match c with - | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) c - | Cast (c,_,_) -> lamdec_rec l c - | _ -> l,c - in - lamdec_rec [] - -(* Decompose lambda abstractions and lets, until finding n - abstractions *) -let decompose_lam_n_assum n = - if n < 0 then - error "decompose_lam_n_assum: integer parameter must be positive"; - let rec lamdec_rec l n c = - if Int.equal n 0 then l,c - else match c with - | Lambda (x,t,c) -> lamdec_rec (LocalAssum (x,t) :: l) (n-1) c - | LetIn (x,b,t,c) -> lamdec_rec (LocalDef (x,b,t) :: l) n c - | Cast (c,_,_) -> lamdec_rec l n c - | c -> error "decompose_lam_n_assum: not enough abstractions" - in - lamdec_rec empty_rel_context n - -(* Iterate products, with or without lets *) - -(* Constructs either [(x:t)c] or [[x=b:t]c] *) -let mkProd_or_LetIn decl c = - match decl with - | LocalAssum (na,t) -> Prod (na, t, c) - | LocalDef (na,b,t) -> LetIn (na, b, t, c) - -let it_mkProd_or_LetIn = List.fold_left (fun c d -> mkProd_or_LetIn d c) - -let decompose_prod_assum = - let rec prodec_rec l c = - match c with - | Prod (x,t,c) -> prodec_rec (LocalAssum (x,t) :: l) c - | LetIn (x,b,t,c) -> prodec_rec (LocalDef (x,b,t) :: l) c - | Cast (c,_,_) -> prodec_rec l c - | _ -> l,c - in - prodec_rec empty_rel_context - -let decompose_prod_n_assum n = - if n < 0 then - error "decompose_prod_n_assum: integer parameter must be positive"; - let rec prodec_rec l n c = - if Int.equal n 0 then l,c - else match c with - | Prod (x,t,c) -> prodec_rec (LocalAssum (x,t) :: l) (n-1) c - | LetIn (x,b,t,c) -> prodec_rec (LocalDef (x,b,t) :: l) (n-1) c - | Cast (c,_,_) -> prodec_rec l n c - | c -> error "decompose_prod_n_assum: not enough assumptions" - in - prodec_rec empty_rel_context n - - -(***************************) -(* Other term constructors *) -(***************************) - -type arity = rel_context * sorts - -let mkArity (sign,s) = it_mkProd_or_LetIn (Sort s) sign - -let destArity = - let rec prodec_rec l c = - match c with - | Prod (x,t,c) -> prodec_rec (LocalAssum (x,t)::l) c - | LetIn (x,b,t,c) -> prodec_rec (LocalDef (x,b,t)::l) c - | Cast (c,_,_) -> prodec_rec l c - | Sort s -> l,s - | _ -> anomaly ~label:"destArity" (Pp.str "not an arity") - in - prodec_rec [] - -let rec isArity c = - match c with - | Prod (_,_,c) -> isArity c - | LetIn (_,b,_,c) -> isArity (subst1 b c) - | Cast (c,_,_) -> isArity c - | Sort _ -> true - | _ -> false - -(*******************************) -(* alpha conversion functions *) -(*******************************) - -(* alpha conversion : ignore print names and casts *) - -let compare_sorts s1 s2 = match s1, s2 with -| Prop c1, Prop c2 -> - begin match c1, c2 with - | Pos, Pos | Null, Null -> true - | Pos, Null -> false - | Null, Pos -> false - end -| Type u1, Type u2 -> Univ.Universe.equal u1 u2 -| Prop _, Type _ -> false -| Type _, Prop _ -> false - -let eq_puniverses f (c1,u1) (c2,u2) = - Univ.Instance.equal u1 u2 && f c1 c2 - -let compare_constr f t1 t2 = - match t1, t2 with - | Rel n1, Rel n2 -> Int.equal n1 n2 - | Meta m1, Meta m2 -> Int.equal m1 m2 - | Var id1, Var id2 -> Id.equal id1 id2 - | Sort s1, Sort s2 -> compare_sorts s1 s2 - | Cast (c1,_,_), _ -> f c1 t2 - | _, Cast (c2,_,_) -> f t1 c2 - | Prod (_,t1,c1), Prod (_,t2,c2) -> f t1 t2 && f c1 c2 - | Lambda (_,t1,c1), Lambda (_,t2,c2) -> f t1 t2 && f c1 c2 - | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> f b1 b2 && f t1 t2 && f c1 c2 - | App (c1,l1), App (c2,l2) -> - if Int.equal (Array.length l1) (Array.length l2) then - f c1 c2 && Array.for_all2 f l1 l2 - else - let (h1,l1) = decompose_app t1 in - let (h2,l2) = decompose_app t2 in - if Int.equal (List.length l1) (List.length l2) then - f h1 h2 && List.for_all2 f l1 l2 - else false - | Evar (e1,l1), Evar (e2,l2) -> Int.equal e1 e2 && Array.equal f l1 l2 - | Const c1, Const c2 -> eq_puniverses eq_con_chk c1 c2 - | Ind c1, Ind c2 -> eq_puniverses eq_ind_chk c1 c2 - | Construct ((c1,i1),u1), Construct ((c2,i2),u2) -> Int.equal i1 i2 && eq_ind_chk c1 c2 - && Univ.Instance.equal u1 u2 - | Case (_,p1,c1,bl1), Case (_,p2,c2,bl2) -> - f p1 p2 && f c1 c2 && Array.equal f bl1 bl2 - | Fix ((ln1, i1),(_,tl1,bl1)), Fix ((ln2, i2),(_,tl2,bl2)) -> - Int.equal i1 i2 && Array.equal Int.equal ln1 ln2 && - Array.equal f tl1 tl2 && Array.equal f bl1 bl2 - | CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) -> - Int.equal ln1 ln2 && Array.equal f tl1 tl2 && Array.equal f bl1 bl2 - | Proj (p1,c1), Proj(p2,c2) -> Projection.equal p1 p2 && f c1 c2 - | _ -> false - -let rec eq_constr m n = - (m == n) || - compare_constr eq_constr m n - -let eq_constr m n = eq_constr m n (* to avoid tracing a recursive fun *) - -(* Universe substitutions *) - -let map_constr f c = map_constr_with_binders (fun x -> x) (fun _ c -> f c) 0 c - -let subst_instance_constr subst c = - if Univ.Instance.is_empty subst then c - else - let f u = Univ.subst_instance_instance subst u in - let changed = ref false in - let rec aux t = - match t with - | Const (c, u) -> - if Univ.Instance.is_empty u then t - else - let u' = f u in - if u' == u then t - else (changed := true; Const (c, u')) - | Ind (i, u) -> - if Univ.Instance.is_empty u then t - else - let u' = f u in - if u' == u then t - else (changed := true; Ind (i, u')) - | Construct (c, u) -> - if Univ.Instance.is_empty u then t - else - let u' = f u in - if u' == u then t - else (changed := true; Construct (c, u')) - | Sort (Type u) -> - let u' = Univ.subst_instance_universe subst u in - if u' == u then t else - (changed := true; Sort (sort_of_univ u')) - | _ -> map_constr aux t - in - let c' = aux c in - if !changed then c' else c - -let subst_instance_context s ctx = - if Univ.Instance.is_empty s then ctx - else map_rel_context (fun x -> subst_instance_constr s x) ctx diff -Nru coq-doc-8.6/checker/term.mli coq-doc-8.15.0/checker/term.mli --- coq-doc-8.6/checker/term.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/term.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,59 +0,0 @@ -open Names -open Cic - -val family_of_sort : sorts -> sorts_family -val family_equal : sorts_family -> sorts_family -> bool - -val strip_outer_cast : constr -> constr -val collapse_appl : constr -> constr -val decompose_app : constr -> constr * constr list -val applist : constr * constr list -> constr -val iter_constr_with_binders : - ('a -> 'a) -> ('a -> constr -> unit) -> 'a -> constr -> unit -exception LocalOccur -val closedn : int -> constr -> bool -val closed0 : constr -> bool -val noccurn : int -> constr -> bool -val noccur_between : int -> int -> constr -> bool -val noccur_with_meta : int -> int -> constr -> bool -val map_constr_with_binders : - ('a -> 'a) -> ('a -> constr -> constr) -> 'a -> constr -> constr -val exliftn : Esubst.lift -> constr -> constr -val liftn : int -> int -> constr -> constr -val lift : int -> constr -> constr -type info = Closed | Open | Unknown -type 'a substituend = { mutable sinfo : info; sit : 'a; } -val lift_substituend : int -> constr substituend -> constr -val make_substituend : 'a -> 'a substituend -val substn_many : constr substituend array -> int -> constr -> constr -val substnl : constr list -> int -> constr -> constr -val substl : constr list -> constr -> constr -val subst1 : constr -> constr -> constr - -val empty_rel_context : rel_context -val rel_context_length : rel_context -> int -val rel_context_nhyps : rel_context -> int -val fold_rel_context : - (rel_declaration -> 'a -> 'a) -> rel_context -> init:'a -> 'a -val map_rel_decl : (constr -> constr) -> rel_declaration -> rel_declaration -val map_rel_context : (constr -> constr) -> rel_context -> rel_context -val extended_rel_list : int -> rel_context -> constr list -val compose_lam : (name * constr) list -> constr -> constr -val decompose_lam : constr -> (name * constr) list * constr -val decompose_lam_n_assum : int -> constr -> rel_context * constr -val mkProd_or_LetIn : rel_declaration -> constr -> constr -val it_mkProd_or_LetIn : constr -> rel_context -> constr -val decompose_prod_assum : constr -> rel_context * constr -val decompose_prod_n_assum : int -> constr -> rel_context * constr - -type arity = rel_context * sorts - -val mkArity : arity -> constr -val destArity : constr -> arity -val isArity : constr -> bool -val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool -val eq_constr : constr -> constr -> bool - -(** Instance substitution for polymorphism. *) -val subst_instance_constr : Univ.universe_instance -> constr -> constr -val subst_instance_context : Univ.universe_instance -> rel_context -> rel_context diff -Nru coq-doc-8.6/checker/type_errors.ml coq-doc-8.15.0/checker/type_errors.ml --- coq-doc-8.6/checker/type_errors.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/type_errors.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,113 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* int -> 'a - -val error_unbound_var : env -> variable -> 'a - -val error_not_type : env -> unsafe_judgment -> 'a - -val error_assumption : env -> unsafe_judgment -> 'a - -val error_reference_variables : env -> constr -> 'a - -val error_elim_arity : - env -> pinductive -> sorts_family list -> constr -> unsafe_judgment -> - (sorts_family * sorts_family * arity_error) option -> 'a - -val error_case_not_inductive : env -> unsafe_judgment -> 'a - -val error_number_branches : env -> unsafe_judgment -> int -> 'a - -val error_ill_formed_branch : env -> constr -> int -> constr -> constr -> 'a - -val error_actual_type : env -> unsafe_judgment -> constr -> 'a - -val error_cant_apply_not_functional : - env -> unsafe_judgment -> unsafe_judgment array -> 'a - -val error_cant_apply_bad_type : - env -> int * constr * constr -> - unsafe_judgment -> unsafe_judgment array -> 'a - -val error_ill_formed_rec_body : - env -> guard_error -> name array -> int -> 'a - -val error_ill_typed_rec_body : - env -> int -> name array -> unsafe_judgment array -> constr array -> 'a - -val error_unsatisfied_constraints : env -> Univ.constraints -> 'a diff -Nru coq-doc-8.6/checker/typeops.ml coq-doc-8.15.0/checker/typeops.ml --- coq-doc-8.6/checker/typeops.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/typeops.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,408 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* - (try conv_leq env t1 t2 - with NotConvertible -> raise (NotConvertibleVect i)); ()) - () - v1 - v2 - -let check_constraints cst env = - if Environ.check_constraints cst env then () - else error_unsatisfied_constraints env cst - -(* This should be a type (a priori without intension to be an assumption) *) -let type_judgment env (c,ty as j) = - match whd_all env ty with - | Sort s -> (c,s) - | _ -> error_not_type env j - -(* This should be a type intended to be assumed. The error message is *) -(* not as useful as for [type_judgment]. *) -let assumption_of_judgment env j = - try fst(type_judgment env j) - with TypeError _ -> - error_assumption env j - -(************************************************) -(* Incremental typing rules: builds a typing judgement given the *) -(* judgements for the subterms. *) - -(*s Type of sorts *) - -(* Prop and Set *) - -let judge_of_prop = Sort (Type Univ.type1_univ) - -(* Type of Type(i). *) - -let judge_of_type u = Sort (Type (Univ.super u)) - -(*s Type of a de Bruijn index. *) - -let judge_of_relative env n = - try - let LocalAssum (_,typ) | LocalDef (_,_,typ) = lookup_rel n env in - lift n typ - with Not_found -> - error_unbound_rel env n - -(* Type of constants *) - - -let type_of_constant_type_knowing_parameters env t paramtyps = - match t with - | RegularArity t -> t - | TemplateArity (sign,ar) -> - let ctx = List.rev sign in - let ctx,s = instantiate_universes env ctx ar paramtyps in - mkArity (List.rev ctx,s) - -let type_of_constant_knowing_parameters env cst paramtyps = - let ty, cu = constant_type env cst in - type_of_constant_type_knowing_parameters env ty paramtyps, cu - -let type_of_constant_type env t = - type_of_constant_type_knowing_parameters env t [||] - -let type_of_constant env cst = - type_of_constant_knowing_parameters env cst [||] - -let judge_of_constant_knowing_parameters env (kn,u as cst) paramstyp = - let _cb = - try lookup_constant kn env - with Not_found -> - failwith ("Cannot find constant: "^Constant.to_string kn) - in - let ty, cu = type_of_constant_knowing_parameters env cst paramstyp in - let () = check_constraints cu env in - ty - -let judge_of_constant env cst = - judge_of_constant_knowing_parameters env cst [||] - -(* Type of an application. *) - -let judge_of_apply env (f,funj) argjv = - let rec apply_rec n typ = function - | [] -> typ - | (h,hj)::restjl -> - (match whd_all env typ with - | Prod (_,c1,c2) -> - (try conv_leq env hj c1 - with NotConvertible -> - error_cant_apply_bad_type env (n,c1, hj) (f,funj) argjv); - apply_rec (n+1) (subst1 h c2) restjl - | _ -> - error_cant_apply_not_functional env (f,funj) argjv) - in - apply_rec 1 funj (Array.to_list argjv) - -(* Type of product *) - -let sort_of_product env domsort rangsort = - match (domsort, rangsort) with - (* Product rule (s,Prop,Prop) *) - | (_, Prop Null) -> rangsort - (* Product rule (Prop/Set,Set,Set) *) - | (Prop _, Prop Pos) -> rangsort - (* Product rule (Type,Set,?) *) - | (Type u1, Prop Pos) -> - if engagement env = ImpredicativeSet then - (* Rule is (Type,Set,Set) in the Set-impredicative calculus *) - rangsort - else - (* Rule is (Type_i,Set,Type_i) in the Set-predicative calculus *) - Type (Univ.sup u1 Univ.type0_univ) - (* Product rule (Prop,Type_i,Type_i) *) - | (Prop Pos, Type u2) -> Type (Univ.sup Univ.type0_univ u2) - (* Product rule (Prop,Type_i,Type_i) *) - | (Prop Null, Type _) -> rangsort - (* Product rule (Type_i,Type_i,Type_i) *) - | (Type u1, Type u2) -> Type (Univ.sup u1 u2) - -(* Type of a type cast *) - -(* [judge_of_cast env (c,typ1) (typ2,s)] implements the rule - - env |- c:typ1 env |- typ2:s env |- typ1 <= typ2 - --------------------------------------------------------------------- - env |- c:typ2 -*) - -let judge_of_cast env (c,cj) k tj = - let conversion = - match k with - | VMcast | NATIVEcast -> vm_conv CUMUL - | DEFAULTcast -> conv_leq in - try - conversion env cj tj - with NotConvertible -> - error_actual_type env (c,cj) tj - -(* Inductive types. *) - -(* The type is parametric over the uniform parameters whose conclusion - is in Type; to enforce the internal constraints between the - parameters and the instances of Type occurring in the type of the - constructors, we use the level variables _statically_ assigned to - the conclusions of the parameters as mediators: e.g. if a parameter - has conclusion Type(alpha), static constraints of the form alpha<=v - exist between alpha and the Type's occurring in the constructor - types; when the parameters is finally instantiated by a term of - conclusion Type(u), then the constraints u<=alpha is computed in - the App case of execute; from this constraints, the expected - dynamic constraints of the form u<=v are enforced *) - -let judge_of_inductive_knowing_parameters env (ind,u) (paramstyp:constr array) = - let specif = - try lookup_mind_specif env ind - with Not_found -> - failwith ("Cannot find inductive: "^MutInd.to_string (fst ind)) - in - type_of_inductive_knowing_parameters env (specif,u) paramstyp - -let judge_of_inductive env ind = - judge_of_inductive_knowing_parameters env ind [||] - -(* Constructors. *) - -let judge_of_constructor env (c,u) = - let ind = inductive_of_constructor c in - let specif = - try lookup_mind_specif env ind - with Not_found -> - failwith ("Cannot find inductive: "^MutInd.to_string (fst ind)) - in - type_of_constructor (c,u) specif - -(* Case. *) - -let check_branch_types env (c,cj) (lfj,explft) = - try conv_leq_vecti env lfj explft - with - NotConvertibleVect i -> - error_ill_formed_branch env c i lfj.(i) explft.(i) - | Invalid_argument _ -> - error_number_branches env (c,cj) (Array.length explft) - -let judge_of_case env ci pj (c,cj) lfj = - let indspec = - try find_rectype env cj - with Not_found -> error_case_not_inductive env (c,cj) in - let _ = check_case_info env (fst (fst indspec)) ci in - let (bty,rslty) = type_case_branches env indspec pj c in - check_branch_types env (c,cj) (lfj,bty); - rslty - -(* Projection. *) - -let judge_of_projection env p c ct = - let pb = lookup_projection p env in - let (ind,u), args = - try find_rectype env ct - with Not_found -> error_case_not_inductive env (c, ct) - in - assert(MutInd.equal pb.proj_ind (fst ind)); - let ty = subst_instance_constr u pb.proj_type in - substl (c :: List.rev args) ty - -(* Fixpoints. *) - -(* Checks the type of a general (co)fixpoint, i.e. without checking *) -(* the specific guard condition. *) - -let type_fixpoint env lna lar lbody vdefj = - let lt = Array.length vdefj in - assert (Array.length lar = lt && Array.length lbody = lt); - try - conv_leq_vecti env vdefj (Array.map (fun ty -> lift lt ty) lar) - with NotConvertibleVect i -> - let vdefj = Array.map2 (fun b ty -> b,ty) lbody vdefj in - error_ill_typed_rec_body env i lna vdefj lar - -(************************************************************************) -(************************************************************************) - - -(* let refresh_arity env ar = *) -(* let ctxt, hd = decompose_prod_assum ar in *) -(* match hd with *) -(* Sort (Type u) when not (is_univ_variable u) -> *) -(* let u' = fresh_local_univ() in *) -(* let env' = add_constraints (enforce_leq u u' empty_constraint) env in *) -(* env', mkArity (ctxt,Type u') *) -(* | _ -> env, ar *) - - -(* The typing machine. *) -let rec execute env cstr = - match cstr with - (* Atomic terms *) - | Sort (Prop _) -> judge_of_prop - - | Sort (Type u) -> judge_of_type u - - | Rel n -> judge_of_relative env n - - | Var _ -> anomaly (Pp.str "Section variable in Coqchk !") - - | Const c -> judge_of_constant env c - - (* Lambda calculus operators *) - | App (App (f,args),args') -> - execute env (App(f,Array.append args args')) - - | App (f,args) -> - let jl = execute_array env args in - let j = - match f with - | Ind ind -> - (* Sort-polymorphism of inductive types *) - judge_of_inductive_knowing_parameters env ind jl - | Const cst -> - (* Sort-polymorphism of constant *) - judge_of_constant_knowing_parameters env cst jl - | _ -> - (* No sort-polymorphism *) - execute env f - in - let jl = Array.map2 (fun c ty -> c,ty) args jl in - judge_of_apply env (f,j) jl - - | Proj (p, c) -> - let ct = execute env c in - judge_of_projection env p c ct - - | Lambda (name,c1,c2) -> - let _ = execute_type env c1 in - let env1 = push_rel (LocalAssum (name,c1)) env in - let j' = execute env1 c2 in - Prod(name,c1,j') - - | Prod (name,c1,c2) -> - let varj = execute_type env c1 in - let env1 = push_rel (LocalAssum (name,c1)) env in - let varj' = execute_type env1 c2 in - Sort (sort_of_product env varj varj') - - | LetIn (name,c1,c2,c3) -> - let j1 = execute env c1 in - (* /!\ c2 can be an inferred type => refresh - (but the pushed type is still c2) *) - let _ = - let env',c2' = (* refresh_arity env *) env, c2 in - let _ = execute_type env' c2' in - judge_of_cast env' (c1,j1) DEFAULTcast c2' in - let env1 = push_rel (LocalDef (name,c1,c2)) env in - let j' = execute env1 c3 in - subst1 c1 j' - - | Cast (c,k,t) -> - let cj = execute env c in - let _ = execute_type env t in - judge_of_cast env (c,cj) k t; - t - - (* Inductive types *) - | Ind ind -> judge_of_inductive env ind - - | Construct c -> judge_of_constructor env c - - | Case (ci,p,c,lf) -> - let cj = execute env c in - let pj = execute env p in - let lfj = execute_array env lf in - judge_of_case env ci (p,pj) (c,cj) lfj - - | Fix ((_,i as vni),recdef) -> - let fix_ty = execute_recdef env recdef i in - let fix = (vni,recdef) in - check_fix env fix; - fix_ty - - | CoFix (i,recdef) -> - let fix_ty = execute_recdef env recdef i in - let cofix = (i,recdef) in - check_cofix env cofix; - fix_ty - - (* Partial proofs: unsupported by the kernel *) - | Meta _ -> - anomaly (Pp.str "the kernel does not support metavariables") - - | Evar _ -> - anomaly (Pp.str "the kernel does not support existential variables") - -and execute_type env constr = - let j = execute env constr in - snd (type_judgment env (constr,j)) - -and execute_recdef env (names,lar,vdef) i = - let larj = execute_array env lar in - let larj = Array.map2 (fun c ty -> c,ty) lar larj in - let lara = Array.map (assumption_of_judgment env) larj in - let env1 = push_rec_types (names,lara,vdef) env in - let vdefj = execute_array env1 vdef in - type_fixpoint env1 names lara vdef vdefj; - lara.(i) - -and execute_array env = Array.map (execute env) - -(* Derived functions *) -let infer env constr = execute env constr -let infer_type env constr = execute_type env constr - -(* Typing of several terms. *) - -let check_ctxt env rels = - fold_rel_context (fun d env -> - match d with - | LocalAssum (_,ty) -> - let _ = infer_type env ty in - push_rel d env - | LocalDef (_,bd,ty) -> - let j1 = infer env bd in - let _ = infer env ty in - conv_leq env j1 ty; - push_rel d env) - rels ~init:env - -(* Polymorphic arities utils *) - -let check_kind env ar u = - match (snd (dest_prod env ar)) with - | Sort (Type u') when Univ.Universe.equal u' (Univ.Universe.make u) -> () - | _ -> failwith "not the correct sort" - -let check_polymorphic_arity env params par = - let pl = par.template_param_levels in - let rec check_p env pl params = - match pl, params with - Some u::pl, LocalAssum (na,ty)::params -> - check_kind env ty u; - check_p (push_rel (LocalAssum (na,ty)) env) pl params - | None::pl,d::params -> check_p (push_rel d env) pl params - | [], _ -> () - | _ -> failwith "check_poly: not the right number of params" in - check_p env pl (List.rev params) diff -Nru coq-doc-8.6/checker/typeops.mli coq-doc-8.15.0/checker/typeops.mli --- coq-doc-8.6/checker/typeops.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/typeops.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr -> constr -val infer_type : env -> constr -> sorts -val check_ctxt : env -> rel_context -> env -val check_polymorphic_arity : - env -> rel_context -> template_arity -> unit - -val type_of_constant_type : env -> constant_type -> constr - diff -Nru coq-doc-8.6/checker/univ.ml coq-doc-8.15.0/checker/univ.ml --- coq-doc-8.6/checker/univ.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/univ.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,1291 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* int - val eq : t -> t -> bool - val hcons : t -> t -end - -module HashedList (M : Hashconsed) : -sig - type t = private Nil | Cons of M.t * int * t - val nil : t - val cons : M.t -> t -> t -end = -struct - type t = Nil | Cons of M.t * int * t - module Self = - struct - type _t = t - type t = _t - type u = (M.t -> M.t) - let hash = function Nil -> 0 | Cons (_, h, _) -> h - let eq l1 l2 = match l1, l2 with - | Nil, Nil -> true - | Cons (x1, _, l1), Cons (x2, _, l2) -> x1 == x2 && l1 == l2 - | _ -> false - let hashcons hc = function - | Nil -> Nil - | Cons (x, h, l) -> Cons (hc x, h, l) - end - module Hcons = Hashcons.Make(Self) - let hcons = Hashcons.simple_hcons Hcons.generate Hcons.hcons M.hcons - (** No recursive call: the interface guarantees that all HLists from this - program are already hashconsed. If we get some external HList, we can - still reconstruct it by traversing it entirely. *) - let nil = Nil - let cons x l = - let h = M.hash x in - let hl = match l with Nil -> 0 | Cons (_, h, _) -> h in - let h = Hashset.Combine.combine h hl in - hcons (Cons (x, h, l)) -end - -module HList = struct - - module type S = sig - type elt - type t = private Nil | Cons of elt * int * t - val hash : t -> int - val nil : t - val cons : elt -> t -> t - val tip : elt -> t - val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a - val map : (elt -> elt) -> t -> t - val smartmap : (elt -> elt) -> t -> t - val exists : (elt -> bool) -> t -> bool - val for_all : (elt -> bool) -> t -> bool - val for_all2 : (elt -> elt -> bool) -> t -> t -> bool - val remove : elt -> t -> t - val to_list : t -> elt list - end - - module Make (H : Hashconsed) : S with type elt = H.t = - struct - type elt = H.t - include HashedList(H) - - let hash = function Nil -> 0 | Cons (_, h, _) -> h - - let tip e = cons e nil - - let rec fold f l accu = match l with - | Nil -> accu - | Cons (x, _, l) -> fold f l (f x accu) - - let rec map f = function - | Nil -> nil - | Cons (x, _, l) -> cons (f x) (map f l) - - let smartmap = map - (** Apriori hashconsing ensures that the map is equal to its argument *) - - let rec exists f = function - | Nil -> false - | Cons (x, _, l) -> f x || exists f l - - let rec for_all f = function - | Nil -> true - | Cons (x, _, l) -> f x && for_all f l - - let rec for_all2 f l1 l2 = match l1, l2 with - | Nil, Nil -> true - | Cons (x1, _, l1), Cons (x2, _, l2) -> f x1 x2 && for_all2 f l1 l2 - | _ -> false - - let rec to_list = function - | Nil -> [] - | Cons (x, _, l) -> x :: to_list l - - let rec remove x = function - | Nil -> nil - | Cons (y, _, l) -> - if H.eq x y then l - else cons y (remove x l) - - end -end - -module RawLevel = -struct - open Names - type t = - | Prop - | Set - | Level of int * DirPath.t - | Var of int - - (* Hash-consing *) - - let equal x y = - x == y || - match x, y with - | Prop, Prop -> true - | Set, Set -> true - | Level (n,d), Level (n',d') -> - Int.equal n n' && DirPath.equal d d' - | Var n, Var n' -> Int.equal n n' - | _ -> false - - let compare u v = - match u, v with - | Prop,Prop -> 0 - | Prop, _ -> -1 - | _, Prop -> 1 - | Set, Set -> 0 - | Set, _ -> -1 - | _, Set -> 1 - | Level (i1, dp1), Level (i2, dp2) -> - if i1 < i2 then -1 - else if i1 > i2 then 1 - else DirPath.compare dp1 dp2 - | Level _, _ -> -1 - | _, Level _ -> 1 - | Var n, Var m -> Int.compare n m - - let hequal x y = - x == y || - match x, y with - | Prop, Prop -> true - | Set, Set -> true - | Level (n,d), Level (n',d') -> - n == n' && d == d' - | Var n, Var n' -> n == n' - | _ -> false - - let hcons = function - | Prop as x -> x - | Set as x -> x - | Level (n,d) as x -> - let d' = Names.DirPath.hcons d in - if d' == d then x else Level (n,d') - | Var n as x -> x - - open Hashset.Combine - - let hash = function - | Prop -> combinesmall 1 0 - | Set -> combinesmall 1 1 - | Var n -> combinesmall 2 n - | Level (n, d) -> combinesmall 3 (combine n (Names.DirPath.hash d)) -end - -module Level = struct - - open Names - - type raw_level = RawLevel.t = - | Prop - | Set - | Level of int * DirPath.t - | Var of int - - (** Embed levels with their hash value *) - type t = { - hash : int; - data : RawLevel.t } - - let equal x y = - x == y || Int.equal x.hash y.hash && RawLevel.equal x.data y.data - - let hash x = x.hash - - let data x = x.data - - (** Hashcons on levels + their hash *) - - module Self = struct - type _t = t - type t = _t - type u = unit - let eq x y = x.hash == y.hash && RawLevel.hequal x.data y.data - let hash x = x.hash - let hashcons () x = - let data' = RawLevel.hcons x.data in - if x.data == data' then x else { x with data = data' } - end - - let hcons = - let module H = Hashcons.Make(Self) in - Hashcons.simple_hcons H.generate H.hcons () - - let make l = hcons { hash = RawLevel.hash l; data = l } - - let set = make Set - let prop = make Prop - let var i = make (Var i) - - let is_small x = - match data x with - | Level _ -> false - | _ -> true - - let is_prop x = - match data x with - | Prop -> true - | _ -> false - - let is_set x = - match data x with - | Set -> true - | _ -> false - - let compare u v = - if u == v then 0 - else - let c = Int.compare (hash u) (hash v) in - if c == 0 then RawLevel.compare (data u) (data v) - else c - - let to_string x = - match data x with - | Prop -> "Prop" - | Set -> "Set" - | Level (n,d) -> Names.DirPath.to_string d^"."^string_of_int n - | Var i -> "Var("^string_of_int i^")" - - let pr u = str (to_string u) - - let make m n = make (Level (n, Names.DirPath.hcons m)) - -end - -(** Level sets and maps *) -module LMap = HMap.Make (Level) -module LSet = LMap.Set - -type 'a universe_map = 'a LMap.t - -type universe_level = Level.t - -type universe_level_subst_fn = universe_level -> universe_level - -(* An algebraic universe [universe] is either a universe variable - [Level.t] or a formal universe known to be greater than some - universe variables and strictly greater than some (other) universe - variables - - Universes variables denote universes initially present in the term - to type-check and non variable algebraic universes denote the - universes inferred while type-checking: it is either the successor - of a universe present in the initial term to type-check or the - maximum of two algebraic universes -*) - -module Universe = -struct - (* Invariants: non empty, sorted and without duplicates *) - - module Expr = - struct - type t = Level.t * int - type _t = t - - (* Hashing of expressions *) - module ExprHash = - struct - type t = _t - type u = Level.t -> Level.t - let hashcons hdir (b,n as x) = - let b' = hdir b in - if b' == b then x else (b',n) - let eq l1 l2 = - l1 == l2 || - match l1,l2 with - | (b,n), (b',n') -> b == b' && n == n' - - let hash (x, n) = n + Level.hash x - - end - - module HExpr = - struct - - module H = Hashcons.Make(ExprHash) - - type t = ExprHash.t - - let hcons = - Hashcons.simple_hcons H.generate H.hcons Level.hcons - let hash = ExprHash.hash - let eq x y = x == y || - (let (u,n) = x and (v,n') = y in - Int.equal n n' && Level.equal u v) - - end - - let hcons = HExpr.hcons - - let make l = hcons (l, 0) - - let prop = make Level.prop - let set = make Level.set - let type1 = hcons (Level.set, 1) - - let is_prop = function - | (l,0) -> Level.is_prop l - | _ -> false - - let equal x y = x == y || - (let (u,n) = x and (v,n') = y in - Int.equal n n' && Level.equal u v) - - let leq (u,n) (v,n') = - let cmp = Level.compare u v in - if Int.equal cmp 0 then n <= n' - else if n <= n' then - (Level.is_prop u && Level.is_small v) - else false - - let successor (u,n) = - if Level.is_prop u then type1 - else hcons (u, n + 1) - - let addn k (u,n as x) = - if k = 0 then x - else if Level.is_prop u then - hcons (Level.set,n+k) - else hcons (u,n+k) - - let super (u,n as x) (v,n' as y) = - let cmp = Level.compare u v in - if Int.equal cmp 0 then - if n < n' then Inl true - else Inl false - else if is_prop x then Inl true - else if is_prop y then Inl false - else Inr cmp - - let to_string (v, n) = - if Int.equal n 0 then Level.to_string v - else Level.to_string v ^ "+" ^ string_of_int n - - let pr x = str(to_string x) - - let level = function - | (v,0) -> Some v - | _ -> None - - let map f (v, n as x) = - let v' = f v in - if v' == v then x - else if Level.is_prop v' && n != 0 then - hcons (Level.set, n) - else hcons (v', n) - - end - - module Huniv = HList.Make(Expr.HExpr) - type t = Huniv.t - open Huniv - - let equal x y = x == y || - (Huniv.hash x == Huniv.hash y && - Huniv.for_all2 Expr.equal x y) - - let make l = Huniv.tip (Expr.make l) - let tip x = Huniv.tip x - - let pr l = match l with - | Cons (u, _, Nil) -> Expr.pr u - | _ -> - str "max(" ++ hov 0 - (prlist_with_sep pr_comma Expr.pr (to_list l)) ++ - str ")" - - let level l = match l with - | Cons (l, _, Nil) -> Expr.level l - | _ -> None - - (* The lower predicative level of the hierarchy that contains (impredicative) - Prop and singleton inductive types *) - let type0m = tip Expr.prop - - (* The level of sets *) - let type0 = tip Expr.set - - (* When typing [Prop] and [Set], there is no constraint on the level, - hence the definition of [type1_univ], the type of [Prop] *) - let type1 = tip (Expr.successor Expr.set) - - let is_type0m x = equal type0m x - let is_type0 x = equal type0 x - - (* Returns the formal universe that lies juste above the universe variable u. - Used to type the sort u. *) - let super l = - Huniv.map (fun x -> Expr.successor x) l - - let addn n l = - Huniv.map (fun x -> Expr.addn n x) l - - let rec merge_univs l1 l2 = - match l1, l2 with - | Nil, _ -> l2 - | _, Nil -> l1 - | Cons (h1, _, t1), Cons (h2, _, t2) -> - (match Expr.super h1 h2 with - | Inl true (* h1 < h2 *) -> merge_univs t1 l2 - | Inl false -> merge_univs l1 t2 - | Inr c -> - if c <= 0 (* h1 < h2 is name order *) - then cons h1 (merge_univs t1 l2) - else cons h2 (merge_univs l1 t2)) - - let sort u = - let rec aux a l = - match l with - | Cons (b, _, l') -> - (match Expr.super a b with - | Inl false -> aux a l' - | Inl true -> l - | Inr c -> - if c <= 0 then cons a l - else cons b (aux a l')) - | Nil -> cons a l - in - fold (fun a acc -> aux a acc) u nil - - (* Returns the formal universe that is greater than the universes u and v. - Used to type the products. *) - let sup x y = merge_univs x y - - let empty = nil - - let exists = Huniv.exists - - let for_all = Huniv.for_all - - let smartmap = Huniv.smartmap - -end - -type universe = Universe.t - -(* The level of predicative Set *) -let type0m_univ = Universe.type0m -let type0_univ = Universe.type0 -let type1_univ = Universe.type1 -let is_type0m_univ = Universe.is_type0m -let is_type0_univ = Universe.is_type0 -let is_univ_variable l = Universe.level l != None -let pr_uni = Universe.pr - -let sup = Universe.sup -let super = Universe.super - -open Universe - -(* Comparison on this type is pointer equality *) -type canonical_arc = - { univ: Level.t; - lt: Level.t list; - le: Level.t list; - rank : int; - predicative : bool} - -let terminal u = {univ=u; lt=[]; le=[]; rank=0; predicative=false} - -module UMap : -sig - type key = Level.t - type +'a t - val empty : 'a t - val add : key -> 'a -> 'a t -> 'a t - val find : key -> 'a t -> 'a - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b -end = HMap.Make(Level) - -(* A Level.t is either an alias for another one, or a canonical one, - for which we know the universes that are above *) - -type univ_entry = - Canonical of canonical_arc - | Equiv of Level.t - -type universes = univ_entry UMap.t - -let enter_equiv_arc u v g = - UMap.add u (Equiv v) g - -let enter_arc ca g = - UMap.add ca.univ (Canonical ca) g - -(* Every Level.t has a unique canonical arc representative *) - -(* repr : universes -> Level.t -> canonical_arc *) -(* canonical representative : we follow the Equiv links *) - -let repr g u = - let rec repr_rec u = - let a = - try UMap.find u g - with Not_found -> anomaly ~label:"Univ.repr" - (str"Universe " ++ Level.pr u ++ str" undefined") - in - match a with - | Equiv v -> repr_rec v - | Canonical arc -> arc - in - repr_rec u - -let get_set_arc g = repr g Level.set - -exception AlreadyDeclared - -let add_universe vlev strict g = - try - let _arcv = UMap.find vlev g in - raise AlreadyDeclared - with Not_found -> - let v = terminal vlev in - let arc = - let arc = get_set_arc g in - if strict then - { arc with lt=vlev::arc.lt} - else - { arc with le=vlev::arc.le} - in - let g = enter_arc arc g in - enter_arc v g - -(* reprleq : canonical_arc -> canonical_arc list *) -(* All canonical arcv such that arcu<=arcv with arcv#arcu *) -let reprleq g arcu = - let rec searchrec w = function - | [] -> w - | v :: vl -> - let arcv = repr g v in - if List.memq arcv w || arcu==arcv then - searchrec w vl - else - searchrec (arcv :: w) vl - in - searchrec [] arcu.le - - -(* between : Level.t -> canonical_arc -> canonical_arc list *) -(* between u v = { w | u<=w<=v, w canonical } *) -(* between is the most costly operation *) - -let between g arcu arcv = - (* good are all w | u <= w <= v *) - (* bad are all w | u <= w ~<= v *) - (* find good and bad nodes in {w | u <= w} *) - (* explore b u = (b or "u is good") *) - let rec explore ((good, bad, b) as input) arcu = - if List.memq arcu good then - (good, bad, true) (* b or true *) - else if List.memq arcu bad then - input (* (good, bad, b or false) *) - else - let leq = reprleq g arcu in - (* is some universe >= u good ? *) - let good, bad, b_leq = - List.fold_left explore (good, bad, false) leq - in - if b_leq then - arcu::good, bad, true (* b or true *) - else - good, arcu::bad, b (* b or false *) - in - let good,_,_ = explore ([arcv],[],false) arcu in - good - -(* We assume compare(u,v) = LE with v canonical (see compare below). - In this case List.hd(between g u v) = repr u - Otherwise, between g u v = [] - *) - -type constraint_type = Lt | Le | Eq - -let constraint_type_ord c1 c2 = match c1, c2 with -| Lt, Lt -> 0 -| Lt, _ -> -1 -| Le, Lt -> 1 -| Le, Le -> 0 -| Le, Eq -> -1 -| Eq, Eq -> 0 -| Eq, _ -> 1 - -(** [compare_neq] : is [arcv] in the transitive upward closure of [arcu] ? - - In [strict] mode, we fully distinguish between LE and LT, while in - non-strict mode, we simply answer LE for both situations. - - If [arcv] is encountered in a LT part, we could directly answer - without visiting unneeded parts of this transitive closure. - In [strict] mode, if [arcv] is encountered in a LE part, we could only - change the default answer (1st arg [c]) from NLE to LE, since a strict - constraint may appear later. During the recursive traversal, - [lt_done] and [le_done] are universes we have already visited, - they do not contain [arcv]. The 4rd arg is [(lt_todo,le_todo)], - two lists of universes not yet considered, known to be above [arcu], - strictly or not. - - We use depth-first search, but the presence of [arcv] in [new_lt] - is checked as soon as possible : this seems to be slightly faster - on a test. -*) - -type fast_order = FastEQ | FastLT | FastLE | FastNLE - -let fast_compare_neq strict g arcu arcv = - (* [c] characterizes whether arcv has already been related - to arcu among the lt_done,le_done universe *) - let rec cmp c lt_done le_done lt_todo le_todo = match lt_todo, le_todo with - | [],[] -> c - | arc::lt_todo, le_todo -> - if List.memq arc lt_done then - cmp c lt_done le_done lt_todo le_todo - else - let rec find lt_todo lt le = match le with - | [] -> - begin match lt with - | [] -> cmp c (arc :: lt_done) le_done lt_todo le_todo - | u :: lt -> - let arc = repr g u in - if arc == arcv then - if strict then FastLT else FastLE - else find (arc :: lt_todo) lt le - end - | u :: le -> - let arc = repr g u in - if arc == arcv then - if strict then FastLT else FastLE - else find (arc :: lt_todo) lt le - in - find lt_todo arc.lt arc.le - | [], arc::le_todo -> - if arc == arcv then - (* No need to continue inspecting universes above arc: - if arcv is strictly above arc, then we would have a cycle. - But we cannot answer LE yet, a stronger constraint may - come later from [le_todo]. *) - if strict then cmp FastLE lt_done le_done [] le_todo else FastLE - else - if (List.memq arc lt_done) || (List.memq arc le_done) then - cmp c lt_done le_done [] le_todo - else - let rec find lt_todo lt = match lt with - | [] -> - let fold accu u = - let node = repr g u in - node :: accu - in - let le_new = List.fold_left fold le_todo arc.le in - cmp c lt_done (arc :: le_done) lt_todo le_new - | u :: lt -> - let arc = repr g u in - if arc == arcv then - if strict then FastLT else FastLE - else find (arc :: lt_todo) lt - in - find [] arc.lt - in - cmp FastNLE [] [] [] [arcu] - -let fast_compare g arcu arcv = - if arcu == arcv then FastEQ else fast_compare_neq true g arcu arcv - -let is_leq g arcu arcv = - arcu == arcv || - (match fast_compare_neq false g arcu arcv with - | FastNLE -> false - | (FastEQ|FastLE|FastLT) -> true) - -let is_lt g arcu arcv = - if arcu == arcv then false - else - match fast_compare_neq true g arcu arcv with - | FastLT -> true - | (FastEQ|FastLE|FastNLE) -> false - -(* Invariants : compare(u,v) = EQ <=> compare(v,u) = EQ - compare(u,v) = LT or LE => compare(v,u) = NLE - compare(u,v) = NLE => compare(v,u) = NLE or LE or LT - - Adding u>=v is consistent iff compare(v,u) # LT - and then it is redundant iff compare(u,v) # NLE - Adding u>v is consistent iff compare(v,u) = NLE - and then it is redundant iff compare(u,v) = LT *) - -(** * Universe checks [check_eq] and [check_leq], used in coqchk *) - -(** First, checks on universe levels *) - -let check_equal g u v = - let arcu = repr g u in - let arcv = repr g v in - arcu == arcv - -let check_eq_level g u v = u == v || check_equal g u v - -let is_set_arc u = Level.is_set u.univ -let is_prop_arc u = Level.is_prop u.univ - -let check_smaller g strict u v = - let arcu = repr g u in - let arcv = repr g v in - if strict then - is_lt g arcu arcv - else - is_prop_arc arcu - || (is_set_arc arcu && arcv.predicative) - || is_leq g arcu arcv - -(** Then, checks on universes *) - -type 'a check_function = universes -> 'a -> 'a -> bool - -let check_equal_expr g x y = - x == y || (let (u, n) = x and (v, m) = y in - Int.equal n m && check_equal g u v) - -let check_eq_univs g l1 l2 = - let f x1 x2 = check_equal_expr g x1 x2 in - let exists x1 l = Huniv.exists (fun x2 -> f x1 x2) l in - Huniv.for_all (fun x1 -> exists x1 l2) l1 - && Huniv.for_all (fun x2 -> exists x2 l1) l2 - -let check_eq g u v = - Universe.equal u v || check_eq_univs g u v - -let check_smaller_expr g (u,n) (v,m) = - let diff = n - m in - match diff with - | 0 -> check_smaller g false u v - | 1 -> check_smaller g true u v - | x when x < 0 -> check_smaller g false u v - | _ -> false - -let exists_bigger g ul l = - Huniv.exists (fun ul' -> - check_smaller_expr g ul ul') l - -let real_check_leq g u v = - Huniv.for_all (fun ul -> exists_bigger g ul v) u - -let check_leq g u v = - Universe.equal u v || - Universe.is_type0m u || - check_eq_univs g u v || real_check_leq g u v - -(** Enforcing new constraints : [setlt], [setleq], [merge], [merge_disc] *) - -(** To speed up tests of Set Level.t -> reason -> unit *) -(* forces u > v *) -(* this is normally an update of u in g rather than a creation. *) -let setlt g arcu arcv = - let arcu' = {arcu with lt=arcv.univ::arcu.lt} in - let g = - if is_set_arc arcu then set_predicative g arcv - else g - in - enter_arc arcu' g, arcu' - -(* checks that non-redundant *) -let setlt_if (g,arcu) v = - let arcv = repr g v in - if is_lt g arcu arcv then g, arcu - else setlt g arcu arcv - -(* setleq : Level.t -> Level.t -> unit *) -(* forces u >= v *) -(* this is normally an update of u in g rather than a creation. *) -let setleq g arcu arcv = - let arcu' = {arcu with le=arcv.univ::arcu.le} in - let g = - if is_set_arc arcu' then - set_predicative g arcv - else g - in - enter_arc arcu' g, arcu' - -(* checks that non-redundant *) -let setleq_if (g,arcu) v = - let arcv = repr g v in - if is_leq g arcu arcv then g, arcu - else setleq g arcu arcv - -(* merge : Level.t -> Level.t -> unit *) -(* we assume compare(u,v) = LE *) -(* merge u v forces u ~ v with repr u as canonical repr *) -let merge g arcu arcv = - (* we find the arc with the biggest rank, and we redirect all others to it *) - let arcu, g, v = - let best_ranked (max_rank, old_max_rank, best_arc, rest) arc = - if Level.is_small arc.univ || arc.rank >= max_rank - then (arc.rank, max_rank, arc, best_arc::rest) - else (max_rank, old_max_rank, best_arc, arc::rest) - in - match between g arcu arcv with - | [] -> anomaly (str "Univ.between") - | arc::rest -> - let (max_rank, old_max_rank, best_arc, rest) = - List.fold_left best_ranked (arc.rank, min_int, arc, []) rest in - if max_rank > old_max_rank then best_arc, g, rest - else begin - (* one redirected node also has max_rank *) - let arcu = {best_arc with rank = max_rank + 1} in - arcu, enter_arc arcu g, rest - end - in - let redirect (g,w,w') arcv = - let g' = enter_equiv_arc arcv.univ arcu.univ g in - (g',List.unionq arcv.lt w,arcv.le@w') - in - let (g',w,w') = List.fold_left redirect (g,[],[]) v in - let g_arcu = (g',arcu) in - let g_arcu = List.fold_left setlt_if g_arcu w in - let g_arcu = List.fold_left setleq_if g_arcu w' in - fst g_arcu - -(* merge_disc : Level.t -> Level.t -> unit *) -(* we assume compare(u,v) = compare(v,u) = NLE *) -(* merge_disc u v forces u ~ v with repr u as canonical repr *) -let merge_disc g arc1 arc2 = - let arcu, arcv = if arc1.rank < arc2.rank then arc2, arc1 else arc1, arc2 in - let arcu, g = - if not (Int.equal arc1.rank arc2.rank) then arcu, g - else - let arcu = {arcu with rank = succ arcu.rank} in - arcu, enter_arc arcu g - in - let g' = enter_equiv_arc arcv.univ arcu.univ g in - let g_arcu = (g',arcu) in - let g_arcu = List.fold_left setlt_if g_arcu arcv.lt in - let g_arcu = List.fold_left setleq_if g_arcu arcv.le in - fst g_arcu - -(* Universe inconsistency: error raised when trying to enforce a relation - that would create a cycle in the graph of universes. *) - -type univ_inconsistency = constraint_type * universe * universe - -exception UniverseInconsistency of univ_inconsistency - -let error_inconsistency o u v = - raise (UniverseInconsistency (o,make u,make v)) - -(* enforc_univ_eq : Level.t -> Level.t -> unit *) -(* enforc_univ_eq u v will force u=v if possible, will fail otherwise *) - -let enforce_univ_eq u v g = - let arcu = repr g u in - let arcv = repr g v in - match fast_compare g arcu arcv with - | FastEQ -> g - | FastLT -> error_inconsistency Eq v u - | FastLE -> merge g arcu arcv - | FastNLE -> - (match fast_compare g arcv arcu with - | FastLT -> error_inconsistency Eq u v - | FastLE -> merge g arcv arcu - | FastNLE -> merge_disc g arcu arcv - | FastEQ -> anomaly (Pp.str "Univ.compare")) - -(* enforce_univ_leq : Level.t -> Level.t -> unit *) -(* enforce_univ_leq u v will force u<=v if possible, will fail otherwise *) -let enforce_univ_leq u v g = - let arcu = repr g u in - let arcv = repr g v in - if is_leq g arcu arcv then g - else - match fast_compare g arcv arcu with - | FastLT -> error_inconsistency Le u v - | FastLE -> merge g arcv arcu - | FastNLE -> fst (setleq g arcu arcv) - | FastEQ -> anomaly (Pp.str "Univ.compare") - -(* enforce_univ_lt u v will force u g - | FastLE -> fst (setlt g arcu arcv) - | FastEQ -> error_inconsistency Lt u v - | FastNLE -> - match fast_compare_neq false g arcv arcu with - FastNLE -> fst (setlt g arcu arcv) - | FastEQ -> anomaly (Pp.str "Univ.compare") - | FastLE | FastLT -> error_inconsistency Lt u v - -(* Prop = Set is forbidden here. *) -let initial_universes = - let g = enter_arc (terminal Level.set) UMap.empty in - let g = enter_arc (terminal Level.prop) g in - enforce_univ_lt Level.prop Level.set g - -(* Constraints and sets of constraints. *) - -type univ_constraint = Level.t * constraint_type * Level.t - -let enforce_constraint cst g = - match cst with - | (u,Lt,v) -> enforce_univ_lt u v g - | (u,Le,v) -> enforce_univ_leq u v g - | (u,Eq,v) -> enforce_univ_eq u v g - -module UConstraintOrd = -struct - type t = univ_constraint - let compare (u,c,v) (u',c',v') = - let i = constraint_type_ord c c' in - if not (Int.equal i 0) then i - else - let i' = Level.compare u u' in - if not (Int.equal i' 0) then i' - else Level.compare v v' -end - -module Constraint = Set.Make(UConstraintOrd) - -let empty_constraint = Constraint.empty -let merge_constraints c g = - Constraint.fold enforce_constraint c g - -type constraints = Constraint.t - -(** A value with universe constraints. *) -type 'a constrained = 'a * constraints - -(** Constraint functions. *) - -type 'a constraint_function = 'a -> 'a -> constraints -> constraints - -let constraint_add_leq v u c = - (* We just discard trivial constraints like u<=u *) - if Expr.equal v u then c - else - match v, u with - | (x,n), (y,m) -> - let j = m - n in - if j = -1 (* n = m+1, v+1 <= u <-> v < u *) then - Constraint.add (x,Lt,y) c - else if j <= -1 (* n = m+k, v+k <= u <-> v+(k-1) < u *) then - if Level.equal x y then (* u+(k+1) <= u *) - raise (UniverseInconsistency (Le, Universe.tip v, Universe.tip u)) - else anomaly (Pp.str"Unable to handle arbitrary u+k <= v constraints") - else if j = 0 then - Constraint.add (x,Le,y) c - else (* j >= 1 *) (* m = n + k, u <= v+k *) - if Level.equal x y then c (* u <= u+k, trivial *) - else if Level.is_small x then c (* Prop,Set <= u+S k, trivial *) - else anomaly (Pp.str"Unable to handle arbitrary u <= v+k constraints") - -let check_univ_leq_one u v = Universe.exists (Expr.leq u) v - -let check_univ_leq u v = - Universe.for_all (fun u -> check_univ_leq_one u v) u - -let enforce_leq u v c = - match v with - | Universe.Huniv.Cons (v, _, Universe.Huniv.Nil) -> - Universe.Huniv.fold (fun u -> constraint_add_leq u v) u c - | _ -> anomaly (Pp.str"A universe bound can only be a variable") - -let enforce_leq u v c = - if check_univ_leq u v then c - else enforce_leq u v c - -let check_constraint g (l,d,r) = - match d with - | Eq -> check_equal g l r - | Le -> check_smaller g false l r - | Lt -> check_smaller g true l r - -let check_constraints c g = - Constraint.for_all (check_constraint g) c - -(**********************************************************************) -(** Universe polymorphism *) -(**********************************************************************) - -(** A universe level substitution, note that no algebraic universes are - involved *) - -type universe_level_subst = universe_level universe_map - -(** A full substitution might involve algebraic universes *) -type universe_subst = universe universe_map - -let level_subst_of f = - fun l -> - try let u = f l in - match Universe.level u with - | None -> l - | Some l -> l - with Not_found -> l - -module Instance : sig - type t = Level.t array - - val empty : t - val is_empty : t -> bool - val equal : t -> t -> bool - val subst_fn : universe_level_subst_fn -> t -> t - val subst : universe_level_subst -> t -> t - val pr : t -> Pp.std_ppcmds - val check_eq : t check_function -end = -struct - type t = Level.t array - - let empty : t = [||] - - module HInstancestruct = - struct - type _t = t - type t = _t - type u = Level.t -> Level.t - - let hashcons huniv a = - let len = Array.length a in - if Int.equal len 0 then empty - else begin - for i = 0 to len - 1 do - let x = Array.unsafe_get a i in - let x' = huniv x in - if x == x' then () - else Array.unsafe_set a i x' - done; - a - end - - let eq t1 t2 = - t1 == t2 || - (Int.equal (Array.length t1) (Array.length t2) && - let rec aux i = - (Int.equal i (Array.length t1)) || (t1.(i) == t2.(i) && aux (i + 1)) - in aux 0) - - let hash a = - let accu = ref 0 in - for i = 0 to Array.length a - 1 do - let l = Array.unsafe_get a i in - let h = Level.hash l in - accu := Hashset.Combine.combine !accu h; - done; - (* [h] must be positive. *) - let h = !accu land 0x3FFFFFFF in - h - end - - module HInstance = Hashcons.Make(HInstancestruct) - - let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons Level.hcons - - let empty = hcons [||] - - let is_empty x = Int.equal (Array.length x) 0 - - let subst_fn fn t = - let t' = CArray.smartmap fn t in - if t' == t then t else hcons t' - - let subst s t = - let t' = - CArray.smartmap (fun x -> try LMap.find x s with Not_found -> x) t - in if t' == t then t else hcons t' - - let pr = - prvect_with_sep spc Level.pr - - let equal t u = - t == u || - (Array.is_empty t && Array.is_empty u) || - (CArray.for_all2 Level.equal t u - (* Necessary as universe instances might come from different modules and - unmarshalling doesn't preserve sharing *)) - - let check_eq g t1 t2 = - t1 == t2 || - (Int.equal (Array.length t1) (Array.length t2) && - let rec aux i = - (Int.equal i (Array.length t1)) || (check_eq_level g t1.(i) t2.(i) && aux (i + 1)) - in aux 0) - -end - -type universe_instance = Instance.t - -type 'a puniverses = 'a * Instance.t -(** A context of universe levels with universe constraints, - representiong local universe variables and constraints *) - -module UContext = -struct - type t = Instance.t constrained - - (** Universe contexts (variables as a list) *) - let empty = (Instance.empty, Constraint.empty) - let make x = x - let instance (univs, cst) = univs - let constraints (univs, cst) = cst -end - -type universe_context = UContext.t - -module ContextSet = -struct - type t = LSet.t constrained - let empty = LSet.empty, Constraint.empty - let constraints (_, cst) = cst - let levels (ctx, _) = ctx - let make ctx cst = (ctx, cst) -end -type universe_context_set = ContextSet.t - -(** Substitutions. *) - -let is_empty_subst = LMap.is_empty -let empty_level_subst = LMap.empty -let is_empty_level_subst = LMap.is_empty - -(** Substitution functions *) - -(** With level to level substitutions. *) -let subst_univs_level_level subst l = - try LMap.find l subst - with Not_found -> l - -let subst_univs_level_universe subst u = - let f x = Universe.Expr.map (fun u -> subst_univs_level_level subst u) x in - let u' = Universe.smartmap f u in - if u == u' then u - else Universe.sort u' - -(** Substitute instance inst for ctx in csts *) - -let subst_instance_level s l = - match l.Level.data with - | Level.Var n -> s.(n) - | _ -> l - -let subst_instance_instance s i = - Array.smartmap (fun l -> subst_instance_level s l) i - -let subst_instance_universe s u = - let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in - let u' = Universe.smartmap f u in - if u == u' then u - else Universe.sort u' - -let subst_instance_constraint s (u,d,v as c) = - let u' = subst_instance_level s u in - let v' = subst_instance_level s v in - if u' == u && v' == v then c - else (u',d,v') - -let subst_instance_constraints s csts = - Constraint.fold - (fun c csts -> Constraint.add (subst_instance_constraint s c) csts) - csts Constraint.empty - -let make_abstract_instance (ctx, _) = - Array.mapi (fun i l -> Level.var i) ctx - -(** Substitute instance inst for ctx in csts *) -let instantiate_univ_context (ctx, csts) = - (ctx, subst_instance_constraints ctx csts) - -let instantiate_univ_constraints u (_, csts) = - subst_instance_constraints u csts - -(** With level to universe substitutions. *) -type universe_subst_fn = universe_level -> universe - -let make_subst subst = fun l -> LMap.find l subst - -let subst_univs_expr_opt fn (l,n) = - Universe.addn n (fn l) - -let subst_univs_universe fn ul = - let subst, nosubst = - Universe.Huniv.fold (fun u (subst,nosubst) -> - try let a' = subst_univs_expr_opt fn u in - (a' :: subst, nosubst) - with Not_found -> (subst, u :: nosubst)) - ul ([], []) - in - if CList.is_empty subst then ul - else - let substs = - List.fold_left Universe.merge_univs Universe.empty subst - in - List.fold_left (fun acc u -> Universe.merge_univs acc (Universe.Huniv.tip u)) - substs nosubst - -let merge_context strict ctx g = - let g = Array.fold_left - (* Be lenient, module typing reintroduces universes and - constraints due to includes *) - (fun g v -> try add_universe v strict g with AlreadyDeclared -> g) - g (UContext.instance ctx) - in merge_constraints (UContext.constraints ctx) g - -let merge_context_set strict ctx g = - let g = LSet.fold - (fun v g -> try add_universe v strict g with AlreadyDeclared -> g) - (ContextSet.levels ctx) g - in merge_constraints (ContextSet.constraints ctx) g - -(** Pretty-printing *) - -let pr_arc = function - | _, Canonical {univ=u; lt=[]; le=[]} -> - mt () - | _, Canonical {univ=u; lt=lt; le=le} -> - let opt_sep = match lt, le with - | [], _ | _, [] -> mt () - | _ -> spc () - in - Level.pr u ++ str " " ++ - v 0 - (pr_sequence (fun v -> str "< " ++ Level.pr v) lt ++ - opt_sep ++ - pr_sequence (fun v -> str "<= " ++ Level.pr v) le) ++ - fnl () - | u, Equiv v -> - Level.pr u ++ str " = " ++ Level.pr v ++ fnl () - -let pr_universes g = - let graph = UMap.fold (fun u a l -> (u,a)::l) g [] in - prlist pr_arc graph diff -Nru coq-doc-8.6/checker/univ.mli coq-doc-8.15.0/checker/univ.mli --- coq-doc-8.6/checker/univ.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/univ.mli 1970-01-01 00:00:00.000000000 +0000 @@ -1,238 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* int -> t - (** Create a new universe level from a unique identifier and an associated - module path. *) - - val equal : t -> t -> bool -end - -type universe_level = Level.t -(** Alias name. *) - -module Universe : -sig - type t - (** Type of universes. A universe is defined as a set of level expressions. - A level expression is built from levels and successors of level expressions, i.e.: - le ::= l + n, n \in N. - - A universe is said atomic if it consists of a single level expression with - no increment, and algebraic otherwise (think the least upper bound of a set of - level expressions). - *) - - val equal : t -> t -> bool - (** Equality function on formal universes *) - - val make : Level.t -> t - (** Create a universe representing the given level. *) - -end - -type universe = Universe.t - -(** Alias name. *) - -val pr_uni : universe -> Pp.std_ppcmds - -(** The universes hierarchy: Type 0- = Prop <= Type 0 = Set <= Type 1 <= ... - Typing of universes: Type 0-, Type 0 : Type 1; Type i : Type (i+1) if i>0 *) -val type0m_univ : universe -val type0_univ : universe -val type1_univ : universe - -val is_type0_univ : universe -> bool -val is_type0m_univ : universe -> bool -val is_univ_variable : universe -> bool - -val sup : universe -> universe -> universe -val super : universe -> universe - -(** {6 Graphs of universes. } *) - -type universes - -type 'a check_function = universes -> 'a -> 'a -> bool -val check_leq : universe check_function -val check_eq : universe check_function - -(** The initial graph of universes: Prop < Set *) -val initial_universes : universes - -(** Adds a universe to the graph, ensuring it is >= or > Set. - @raises AlreadyDeclared if the level is already declared in the graph. *) - -exception AlreadyDeclared - -val add_universe : universe_level -> bool -> universes -> universes - -(** {6 Constraints. } *) - -type constraint_type = Lt | Le | Eq -type univ_constraint = universe_level * constraint_type * universe_level - -module Constraint : Set.S with type elt = univ_constraint - -type constraints = Constraint.t - -val empty_constraint : constraints - -(** A value with universe constraints. *) -type 'a constrained = 'a * constraints - -(** Enforcing constraints. *) - -type 'a constraint_function = 'a -> 'a -> constraints -> constraints - -val enforce_leq : universe constraint_function - -(** {6 ... } *) -(** Merge of constraints in a universes graph. - The function [merge_constraints] merges a set of constraints in a given - universes graph. It raises the exception [UniverseInconsistency] if the - constraints are not satisfiable. *) - -(** Type explanation is used to decorate error messages to provide - useful explanation why a given constraint is rejected. It is composed - of a path of universes and relation kinds [(r1,u1);..;(rn,un)] means - .. <(r1) u1 <(r2) ... <(rn) un (where <(ri) is the relation symbol - denoted by ri, currently only < and <=). The lowest end of the chain - is supposed known (see UniverseInconsistency exn). The upper end may - differ from the second univ of UniverseInconsistency because all - universes in the path are canonical. Note that each step does not - necessarily correspond to an actual constraint, but reflect how the - system stores the graph and may result from combination of several - constraints... -*) -type univ_inconsistency = constraint_type * universe * universe - -exception UniverseInconsistency of univ_inconsistency - -val merge_constraints : constraints -> universes -> universes - -val check_constraints : constraints -> universes -> bool - -(** {6 Support for universe polymorphism } *) - -(** Polymorphic maps from universe levels to 'a *) -module LMap : CSig.MapS with type key = universe_level -module LSet : CSig.SetS with type elt = universe_level -type 'a universe_map = 'a LMap.t - -(** {6 Substitution} *) - -type universe_subst_fn = universe_level -> universe -type universe_level_subst_fn = universe_level -> universe_level - -(** A full substitution, might involve algebraic universes *) -type universe_subst = universe universe_map -type universe_level_subst = universe_level universe_map - -val level_subst_of : universe_subst_fn -> universe_level_subst_fn - -(** {6 Universe instances} *) - -module Instance : -sig - type t - (** A universe instance represents a vector of argument universes - to a polymorphic definition (constant, inductive or constructor). *) - - val empty : t - val is_empty : t -> bool - - val equal : t -> t -> bool - (** Equality (note: instances are hash-consed, this is O(1)) *) - - val subst_fn : universe_level_subst_fn -> t -> t - (** Substitution by a level-to-level function. *) - - val subst : universe_level_subst -> t -> t - (** Substitution by a level-to-level function. *) - - val pr : t -> Pp.std_ppcmds - (** Pretty-printing, no comments *) - - val check_eq : t check_function - (** Check equality of instances w.r.t. a universe graph *) -end - -type universe_instance = Instance.t - -type 'a puniverses = 'a * universe_instance - -(** A vector of universe levels with universe constraints, - representiong local universe variables and associated constraints *) - -module UContext : -sig - type t - - val empty : t - val make : universe_instance constrained -> t - val instance : t -> Instance.t - val constraints : t -> constraints - -end - -module ContextSet : - sig - type t - val make : LSet.t -> constraints -> t - val empty : t - val constraints : t -> constraints - end - -type universe_context = UContext.t -type universe_context_set = ContextSet.t - -val merge_context : bool -> universe_context -> universes -> universes -val merge_context_set : bool -> universe_context_set -> universes -> universes - -val empty_level_subst : universe_level_subst -val is_empty_level_subst : universe_level_subst -> bool - -(** Substitution of universes. *) -val subst_univs_level_level : universe_level_subst -> universe_level -> universe_level -val subst_univs_level_universe : universe_level_subst -> universe -> universe - -(** Level to universe substitutions. *) - -val is_empty_subst : universe_subst -> bool -val make_subst : universe_subst -> universe_subst_fn - -val subst_univs_universe : universe_subst_fn -> universe -> universe - -(** Substitution of instances *) -val subst_instance_instance : universe_instance -> universe_instance -> universe_instance -val subst_instance_universe : universe_instance -> universe -> universe -val subst_instance_constraints : universe_instance -> constraints -> constraints - -(* val make_instance_subst : universe_instance -> universe_level_subst *) -(* val make_inverse_instance_subst : universe_instance -> universe_level_subst *) - -(** Get the instantiated graph. *) -val instantiate_univ_context : universe_context -> universe_context -val instantiate_univ_constraints : universe_instance -> universe_context -> constraints - -(** Build the relative instance corresponding to the context *) -val make_abstract_instance : universe_context -> universe_instance - -(** {6 Pretty-printing of universes. } *) - -val pr_universes : universes -> Pp.std_ppcmds diff -Nru coq-doc-8.6/checker/validate.ml coq-doc-8.15.0/checker/validate.ml --- coq-doc-8.6/checker/validate.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/validate.ml 2022-01-13 11:55:53.000000000 +0000 @@ -1,37 +1,46 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Obj.no_scan_tag then - if t = Obj.string_tag then - Format.print_string ("\""^String.escaped(Obj.magic o)^"\"") - else - Format.print_string "?" - else - (let n = Obj.size o in - Format.print_string ("#"^string_of_int t^"("); - Format.open_hvbox 0; - for i = 0 to n-1 do - pr_obj_rec (Obj.field o i); - if i<>n-1 then (Format.print_string ","; Format.print_cut()) - done; - Format.close_box(); - Format.print_string ")") - else Format.print_string "?" +let rec pr_obj_rec mem o = match o with +| Int i -> + Format.print_int i +| Ptr p -> + let v = LargeArray.get mem p in + begin match v with + | Struct (tag, data) -> + let n = Array.length data in + Format.print_string ("#"^string_of_int tag^"("); + Format.open_hvbox 0; + for i = 0 to n-1 do + pr_obj_rec mem (Array.get data i); + if i<>n-1 then (Format.print_string ","; Format.print_cut()) + done; + Format.close_box(); + Format.print_string ")" + | String s -> + Format.print_string ("\""^String.escaped s^"\"") + | Int64 _ + | Float64 _ -> + Format.print_string "?" + end +| Atm tag -> + Format.print_string ("#"^string_of_int tag^"()"); +| Fun addr -> + Format.printf "fun@%x" addr -let pr_obj o = pr_obj_rec o; Format.print_newline() +let pr_obj mem o = pr_obj_rec mem o; Format.print_newline() (**************************************************************************) (* Obj low-level validators *) @@ -46,63 +55,116 @@ let mt_ec : error_context = [] let (/) (ctx:error_context) s : error_context = s::ctx -exception ValidObjError of string * error_context * Obj.t -let fail ctx o s = raise (ValidObjError(s,ctx,o)) +exception ValidObjError of string * error_context * data +let fail _mem ctx o s = raise (ValidObjError(s,ctx,o)) -type func = error_context -> Obj.t -> unit +let is_block mem o = match o with +| Ptr _ | Atm _ -> true +| Fun _ | Int _ -> false + +let is_int _mem o = match o with +| Int _ -> true +| Fun _ | Ptr _ | Atm _ -> false + +let is_int64 mem o = match o with +| Int _ | Fun _ | Atm _ -> false +| Ptr p -> + match LargeArray.get mem p with + | Int64 _ -> true + | Float64 _ | Struct _ | String _ -> false + +let is_float64 mem o = match o with +| Int _ | Fun _ | Atm _ -> false +| Ptr p -> + match LargeArray.get mem p with + | Float64 _ -> true + | Int64 _ | Struct _ | String _ -> false + +let get_int _mem = function +| Int i -> i +| Fun _ | Ptr _ | Atm _ -> assert false + +let tag mem o = match o with +| Atm tag -> tag +| Fun _ -> Obj.out_of_heap_tag +| Int _ -> Obj.int_tag +| Ptr p -> + match LargeArray.get mem p with + | Struct (tag, _) -> tag + | String _ -> Obj.string_tag + | Float64 _ -> Obj.double_tag + | Int64 _ -> Obj.custom_tag + +let size mem o = match o with +| Atm _ -> 0 +| Fun _ | Int _ -> assert false +| Ptr p -> + match LargeArray.get mem p with + | Struct (tag, blk) -> Array.length blk + | String _ | Float64 _ | Int64 _ -> assert false + +let field mem o i = match o with +| Atm _ | Fun _ | Int _ -> assert false +| Ptr p -> + match LargeArray.get mem p with + | Struct (tag, blk) -> Array.get blk i + | String _ | Float64 _ | Int64 _ -> assert false (* Check that object o is a block with tag t *) -let val_tag t ctx o = - if Obj.is_block o && Obj.tag o = t then () - else fail ctx o ("expected tag "^string_of_int t) - -let val_block ctx o = - if Obj.is_block o then - (if Obj.tag o > Obj.no_scan_tag then - fail ctx o "block: found no scan tag") - else fail ctx o "expected block obj" - -let val_dyn ctx o = - let fail () = fail ctx o "expected a Dyn.t" in - if not (Obj.is_block o) then fail () - else if not (Obj.size o = 2) then fail () - else if not (Obj.tag (Obj.field o 0) = Obj.int_tag) then fail () +let val_tag t mem ctx o = + if is_block mem o && tag mem o = t then () + else fail mem ctx o ("expected tag "^string_of_int t) + +let val_block mem ctx o = + if is_block mem o then + (if tag mem o > Obj.no_scan_tag then + fail mem ctx o "block: found no scan tag") + else fail mem ctx o "expected block obj" + +let val_dyn mem ctx o = + let fail () = fail mem ctx o "expected a Dyn.t" in + if not (is_block mem o) then fail () + else if not (size mem o = 2) then fail () + else if not (tag mem (field mem o 0) = Obj.int_tag) then fail () else () open Values -let rec val_gen v ctx o = match v with - | Tuple (name,vs) -> val_tuple ~name vs ctx o - | Sum (name,cc,vv) -> val_sum name cc vv ctx o - | Array v -> val_array v ctx o - | List v0 -> val_sum "list" 1 [|[|Annot ("elem",v0);v|]|] ctx o - | Opt v -> val_sum "option" 1 [|[|v|]|] ctx o - | Int -> if not (Obj.is_int o) then fail ctx o "expected an int" +let rec val_gen v mem ctx o = match v with + | Tuple (name,vs) -> val_tuple ~name vs mem ctx o + | Sum (name,cc,vv) -> val_sum name cc vv mem ctx o + | Array v -> val_array v mem ctx o + | List v0 -> val_sum "list" 1 [|[|Annot ("elem",v0);v|]|] mem ctx o + | Opt v -> val_sum "option" 1 [|[|v|]|] mem ctx o + | Int -> if not (is_int mem o) then fail mem ctx o "expected an int" | String -> - (try val_tag Obj.string_tag ctx o - with Failure _ -> fail ctx o "expected a string") + (try val_tag Obj.string_tag mem ctx o + with Failure _ -> fail mem ctx o "expected a string") | Any -> () - | Fail s -> fail ctx o ("unexpected object " ^ s) - | Annot (s,v) -> val_gen v (ctx/CtxAnnot s) o - | Dyn -> val_dyn ctx o + | Fail s -> fail mem ctx o ("unexpected object " ^ s) + | Annot (s,v) -> val_gen v mem (ctx/CtxAnnot s) o + | Dyn -> val_dyn mem ctx o + | Proxy { contents = v } -> val_gen v mem ctx o + | Int64 -> val_int64 mem ctx o + | Float64 -> val_float64 mem ctx o (* Check that an object is a tuple (or a record). vs is an array of value representation for each field. Its size corresponds to the expected size of the object. *) -and val_tuple ?name vs ctx o = +and val_tuple ?name vs mem ctx o = let ctx = match name with | Some n -> ctx/CtxType n | _ -> ctx in let n = Array.length vs in let val_fld i v = - val_gen v (ctx/(CtxField i)) (Obj.field o i) in - val_block ctx o; - if Obj.size o = n then Array.iteri val_fld vs + val_gen v mem (ctx/(CtxField i)) (field mem o i) in + val_block mem ctx o; + if size mem o = n then Array.iteri val_fld vs else - fail ctx o - ("tuple size: found "^string_of_int (Obj.size o)^ - ", expected "^string_of_int n) + fail mem ctx o + ("tuple size: found "^string_of_int (size mem 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 @@ -110,42 +172,46 @@ 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. *) -and val_sum name cc vv ctx o = +and val_sum name cc vv mem ctx o = let ctx = ctx/CtxType name in - if Obj.is_block o then - (val_block ctx o; + if is_block mem o then + (val_block mem ctx o; let n = Array.length vv in - let i = Obj.tag o in + let i = tag mem o in let ctx' = if n=1 then ctx else ctx/CtxTag 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 i < n then val_tuple vv.(i) mem ctx' o + else fail mem ctx' o ("sum: unexpected tag")) + else if is_int mem o then + let (n:int) = get_int mem o in (if n<0 || n>=cc then - fail ctx o ("bad constant constructor "^string_of_int n)) - else fail ctx o "not a sum" + fail mem ctx o ("bad constant constructor "^string_of_int n)) + else fail mem ctx o "not a sum" (* Check the o is an array of values satisfying f. *) -and val_array v ctx o = - val_block (ctx/CtxType "array") o; - for i = 0 to Obj.size o - 1 do - val_gen v ctx (Obj.field o i) +and val_array v mem ctx o = + val_block mem (ctx/CtxType "array") o; + for i = 0 to size mem o - 1 do + val_gen v mem ctx (field mem o i) done +and val_int64 mem ctx o = + if not (is_int64 mem o) then + fail mem ctx o "not a 63-bit unsigned integer" + +and val_float64 mem ctx o = + if not (is_float64 mem o) then + fail mem ctx o "not a 64-bit float" + let print_frame = function | CtxType t -> t | CtxAnnot t -> t | CtxField i -> Printf.sprintf "fld=%i" i | CtxTag i -> Printf.sprintf "tag=%i" i -let validate debug v x = - let o = Obj.repr x in - try val_gen v mt_ec o +let validate v (o, mem) = + try val_gen v mem mt_ec o with ValidObjError(msg,ctx,obj) -> - if debug then begin - let ctx = List.rev_map print_frame ctx in - print_endline ("Validation failed: "^msg); - print_endline ("Context: "^String.concat"/"ctx); - pr_obj obj - end; - failwith "vo structure validation failed" + let rctx = List.rev_map print_frame ctx in + print_endline ("Context: "^String.concat"/"rctx); + pr_obj mem obj; + failwith ("Validation failed: "^msg^" (in "^(print_frame (List.hd ctx))^")") diff -Nru coq-doc-8.6/checker/validate.mli coq-doc-8.15.0/checker/validate.mli --- coq-doc-8.6/checker/validate.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/validate.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,13 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* data * obj LargeArray.t -> unit diff -Nru coq-doc-8.6/checker/values.ml coq-doc-8.15.0/checker/values.ml --- coq-doc-8.6/checker/values.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/checker/values.ml 2022-01-13 11:55:53.000000000 +0000 @@ -1,35 +1,24 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* value) : value = + let self = ref Any in + let ans = f (Proxy self) in + let () = self := ans in + ans + (** Some pseudo-constructors *) let v_tuple name v = Tuple(name,v) @@ -54,7 +53,7 @@ let v_pair v1 v2 = v_tuple "*" [|v1; v2|] let v_bool = v_enum "bool" 2 -let v_ref v = v_tuple "ref" [|v|] +let v_unit = v_enum "unit" 1 let v_set v = let rec s = Sum ("Set.t",1, @@ -69,12 +68,7 @@ let v_hset v = v_map Int (v_set v) let v_hmap vk vd = v_map Int (v_map vk vd) -(* lib/future *) -let v_computation f = - Annot ("Future.computation", - v_ref - (v_sum "Future.comput" 0 - [| [| Fail "Future.ongoing" |]; [| f |] |])) +let v_pred v = v_pair v_bool (v_set v) (** kernel/names *) @@ -86,19 +80,19 @@ [|[|v_dp|]; [|v_uid|]; [|v_mp;v_id|]|]) -let v_kn = v_tuple "kernel_name" [|Any;v_mp;v_dp;v_id;Int|] +let v_kn = v_tuple "kernel_name" [|v_mp;v_id;Int|] let v_cst = v_sum "cst|mind" 0 [|[|v_kn|];[|v_kn;v_kn|]|] let v_ind = v_tuple "inductive" [|v_cst;Int|] let v_cons = v_tuple "constructor" [|v_ind;Int|] (** kernel/univ *) - -let v_raw_level = v_sum "raw_level" 2 (* Prop, Set *) - [|(*Level*)[|Int;v_dp|]; (*Var*)[|Int|]|] -let v_level = v_tuple "level" [|Int;v_raw_level|] +let v_level_global = v_tuple "Level.Global.t" [|v_dp;String;Int|] +let v_raw_level = v_sum "raw_level" 3 (* SProp, Prop, Set *) + [|(*Level*)[|v_level_global|]; (*Var*)[|Int|]|] +let v_level = v_tuple "level" [|Int;v_raw_level|] let v_expr = v_tuple "levelexpr" [|v_level;Int|] -let rec v_univ = Sum ("universe", 1, [| [|v_expr; Int; v_univ|] |]) +let v_univ = List v_expr let v_cstrs = Annot @@ -107,55 +101,74 @@ (v_tuple "univ_constraint" [|v_level;v_enum "order_request" 3;v_level|])) +let v_variance = v_enum "variance" 3 + let v_instance = Annot ("instance", Array v_level) -let v_context = v_tuple "universe_context" [|v_instance;v_cstrs|] +let v_abs_context = v_tuple "abstract_universe_context" [|Array v_name; v_cstrs|] let v_context_set = v_tuple "universe_context_set" [|v_hset v_level;v_cstrs|] (** kernel/term *) -let v_sort = v_sum "sort" 0 [|[|v_enum "cnt" 2|];[|v_univ|]|] -let v_sortfam = v_enum "sorts_family" 3 +let v_sort = v_sum "sort" 3 (*SProp, Prop, Set*) [|[|v_univ(*Type*)|]|] +let v_sortfam = v_enum "sorts_family" 4 + +let v_relevance = v_sum "relevance" 2 [||] +let v_binder_annot x = v_tuple "binder_annot" [|x;v_relevance|] let v_puniverses v = v_tuple "punivs" [|v;v_instance|] -let v_boollist = List v_bool +let v_boollist = List v_bool let v_caseinfo = let v_cstyle = v_enum "case_style" 5 in let v_cprint = v_tuple "case_printing" [|v_boollist;Array v_boollist;v_cstyle|] in - v_tuple "case_info" [|v_ind;Int;Array Int;Array Int;v_cprint|] + v_tuple "case_info" [|v_ind;Int;Array Int;Array Int;v_relevance;v_cprint|] + +let v_cast = v_enum "cast_kind" 3 + +let v_proj_repr = v_tuple "projection_repr" [|v_ind;Int;Int;v_id|] +let v_proj = v_tuple "projection" [|v_proj_repr; v_bool|] -let v_cast = v_enum "cast_kind" 4 -let v_proj = v_tuple "projection" [|v_cst; v_bool|] +let v_uint63 = + if Sys.word_size == 64 then Int else Int64 let rec v_constr = Sum ("constr",0,[| [|Int|]; (* Rel *) - [|Fail "Var"|]; (* Var *) + [|v_id|]; (* Var *) [|Fail "Meta"|]; (* Meta *) [|Fail "Evar"|]; (* Evar *) [|v_sort|]; (* Sort *) [|v_constr;v_cast;v_constr|]; (* Cast *) - [|v_name;v_constr;v_constr|]; (* Prod *) - [|v_name;v_constr;v_constr|]; (* Lambda *) - [|v_name;v_constr;v_constr;v_constr|]; (* LetIn *) + [|v_binder_annot v_name;v_constr;v_constr|]; (* Prod *) + [|v_binder_annot v_name;v_constr;v_constr|]; (* Lambda *) + [|v_binder_annot v_name;v_constr;v_constr;v_constr|]; (* LetIn *) [|v_constr;Array v_constr|]; (* App *) [|v_puniverses v_cst|]; (* Const *) [|v_puniverses v_ind|]; (* Ind *) [|v_puniverses v_cons|]; (* Construct *) - [|v_caseinfo;v_constr;v_constr;Array v_constr|]; (* Case *) + [|v_caseinfo;v_instance; Array v_constr; v_case_return; v_case_invert; v_constr; Array v_case_branch|]; (* Case *) [|v_fix|]; (* Fix *) [|v_cofix|]; (* CoFix *) - [|v_proj;v_constr|] (* Proj *) + [|v_proj;v_constr|]; (* Proj *) + [|v_uint63|]; (* Int *) + [|Float64|]; (* Float *) + [|v_instance;Array v_constr;v_constr;v_constr|] (* Array *) |]) and v_prec = Tuple ("prec_declaration", - [|Array v_name; Array v_constr; Array v_constr|]) + [|Array (v_binder_annot v_name); Array v_constr; Array v_constr|]) and v_fix = Tuple ("pfixpoint", [|Tuple ("fix2",[|Array Int;Int|]);v_prec|]) and v_cofix = Tuple ("pcofixpoint",[|Int;v_prec|]) +and v_case_invert = Sum ("case_inversion", 1, [|[|Array v_constr|]|]) -let v_rdecl = v_sum "rel_declaration" 0 [| [|v_name; v_constr|]; (* LocalAssum *) - [|v_name; v_constr; v_constr|] |] (* LocalDef *) +and v_case_branch = Tuple ("case_branch", [|Array (v_binder_annot v_name); v_constr|]) + +and v_case_return = Tuple ("case_return", [|Array (v_binder_annot v_name); v_constr|]) + +let v_rdecl = v_sum "rel_declaration" 0 + [| [|v_binder_annot v_name; v_constr|]; (* LocalAssum *) + [|v_binder_annot v_name; v_constr; v_constr|] |] (* LocalDef *) let v_rctxt = List v_rdecl let v_section_ctxt = v_enum "emptylist" 1 @@ -163,8 +176,10 @@ (** kernel/mod_subst *) +let v_univ_abstracted v = v_tuple "univ_abstracted" [|v;v_abs_context|] + let v_delta_hint = - v_sum "delta_hint" 0 [|[|Int; Opt v_constr|];[|v_kn|]|] + v_sum "delta_hint" 0 [|[|Int; Opt (v_univ_abstracted v_constr)|];[|v_kn|]|] let v_resolver = v_tuple "delta_resolver" @@ -174,60 +189,78 @@ let v_mp_resolver = v_tuple "" [|v_mp;v_resolver|] let v_subst = - v_tuple "substitution" - [|v_map v_mp v_mp_resolver; - v_map v_uid v_mp_resolver|] - + Annot ("substitution", v_map v_mp v_mp_resolver) (** kernel/lazyconstr *) -let v_substituted v_a = - v_tuple "substituted" [|v_a; List v_subst|] +let v_ndecl = v_sum "named_declaration" 0 + [| [|v_binder_annot v_id; v_constr|]; (* LocalAssum *) + [|v_binder_annot v_id; v_constr; v_constr|] |] (* LocalDef *) + +let v_nctxt = List v_ndecl + +let v_work_list = + let v_abstr = v_pair v_instance (Array v_id) in + Tuple ("work_list", [|v_hmap v_cst v_abstr; v_hmap v_cst v_abstr|]) -let v_cstr_subst = v_substituted v_constr +let v_abstract = + Tuple ("abstract", [| v_nctxt; v_instance; v_abs_context |]) -(** NB: Second constructor [Direct] isn't supposed to appear in a .vo *) -let v_lazy_constr = - v_sum "lazy_constr" 0 [|[|List v_subst;v_dp;Int|]|] +let v_cooking_info = + Tuple ("cooking_info", [|v_work_list; v_abstract|]) +let v_opaque = + v_sum "opaque" 0 [|[|List v_subst; List v_cooking_info; v_dp; Int|]|] (** kernel/declarations *) -let v_impredicative_set = v_enum "impr-set" 2 -let v_engagement = v_impredicative_set +let v_conv_level = + v_sum "conv_level" 2 [|[|Int|]|] -let v_pol_arity = - v_tuple "polymorphic_arity" [|List(Opt v_level);v_univ|] +let v_oracle = + v_tuple "oracle" [| + v_map v_id v_conv_level; + v_hmap v_cst v_conv_level; + v_pred v_id; + v_pred v_cst; + |] -let v_cst_type = - v_sum "constant_type" 0 [|[|v_constr|]; [|v_pair v_rctxt v_pol_arity|]|] +let v_template_arity = + v_tuple "template_arity" [|v_univ|] + +let v_template_universes = + v_tuple "template_universes" [|List(Opt v_level);v_context_set|] + +let v_primitive = + v_enum "primitive" 54 (* Number of constructors of the CPrimitives.t type *) let v_cst_def = v_sum "constant_def" 0 - [|[|Opt Int|]; [|v_cstr_subst|]; [|v_lazy_constr|]|] - -let v_projbody = - v_tuple "projection_body" - [|v_cst;Int;Int;v_constr; - v_tuple "proj_eta" [|v_constr;v_constr|]; - v_constr|] + [|[|Opt Int|]; [|v_constr|]; [|v_opaque|]; [|v_primitive|]|] let v_typing_flags = - v_tuple "typing_flags" [|v_bool; v_bool|] + v_tuple "typing_flags" + [|v_bool; v_bool; v_bool; + v_oracle; v_bool; v_bool; + v_bool; v_bool; v_bool; v_bool; v_bool; v_bool|] + +let v_univs = v_sum "universes" 1 [|[|v_abs_context|]|] let v_cb = v_tuple "constant_body" [|v_section_ctxt; v_cst_def; - v_cst_type; + v_constr; + v_relevance; Any; - v_bool; - v_context; - Opt v_projbody; + v_univs; v_bool; v_typing_flags|] +let v_nested = v_sum "nested" 0 + [|[|v_ind|] (* NestedInd *);[|v_cst|] (* NestedPrimitive *)|] + let v_recarg = v_sum "recarg" 1 (* Norec *) - [|[|v_ind|] (* Mrec *);[|v_ind|] (* Imbr *)|] + [|[|v_ind|] (* Mrec *);[|v_nested|] (* Nested *)|] let rec v_wfp = Sum ("wf_paths",0, [|[|Int;Int|]; (* Rtree.Param *) @@ -239,7 +272,7 @@ v_tuple "monomorphic_inductive_arity" [|v_constr;v_sort|] let v_ind_arity = v_sum "inductive_arity" 0 - [|[|v_mono_ind_arity|];[|v_pol_arity|]|] + [|[|v_mono_ind_arity|];[|v_template_arity|]|] let v_one_ind = v_tuple "one_inductive_body" [|v_id; @@ -249,43 +282,59 @@ Array v_constr; Int; Int; - List v_sortfam; - Array v_constr; + v_sortfam; + Array (v_pair v_rctxt v_constr); Array Int; Array Int; v_wfp; + v_relevance; Int; Int; Any|] let v_finite = v_enum "recursivity_kind" 3 -let v_mind_record = Annot ("mind_record", - Opt (Opt (v_tuple "record" [| v_id; Array v_cst; Array v_projbody |]))) + +let v_record_info = + v_sum "record_info" 2 + [| [| Array (v_tuple "record" [| v_id; Array v_id; Array v_relevance; Array v_constr |]) |] |] let v_ind_pack = v_tuple "mutual_inductive_body" [|Array v_one_ind; - v_mind_record; + v_record_info; v_finite; Int; v_section_ctxt; Int; Int; v_rctxt; - v_bool; - v_context; + v_univs; (* universes *) + Opt v_template_universes; + Opt (Array v_variance); + Opt (Array v_variance); Opt v_bool; v_typing_flags|] -let v_with = - Sum ("with_declaration_body",0, - [|[|List v_id;v_mp|]; - [|List v_id;v_tuple "with_def" [|v_constr;v_context|]|]|]) +let v_prim_ind = v_enum "prim_ind" 6 +(* Number of "Register ... as kernel.ind_..." in PrimInt63.v and PrimFloat.v *) + +let v_prim_type = v_enum "prim_type" 3 +(* Number of constructors of prim_type in "kernel/cPrimitives.ml" *) + +let v_retro_action = + v_sum "retro_action" 0 [| + [|v_prim_ind; v_ind|]; + [|v_prim_type; v_cst|]; + [|v_cst|]; + |] + +let v_retroknowledge = + v_sum "module_retroknowledge" 1 [|[|List v_retro_action|]|] let rec v_mae = Sum ("module_alg_expr",0, [|[|v_mp|]; (* SEBident *) [|v_mae;v_mp|]; (* SEBapply *) - [|v_mae;v_with|] (* SEBwith *) + [|v_mae; Any|] (* SEBwith *) |]) let rec v_sfb = @@ -308,26 +357,46 @@ Sum ("module_impl",2, (* Abstract, FullStruct *) [|[|v_mexpr|]; (* Algebraic *) [|v_sign|]|]) (* Struct *) -and v_noimpl = v_enum "no_impl" 1 (* Abstract is mandatory for mtb *) +and v_noimpl = v_unit and v_module = Tuple ("module_body", - [|v_mp;v_impl;v_sign;Opt v_mexpr;v_context_set;v_resolver;Any|]) + [|v_mp;v_impl;v_sign;Opt v_mexpr;v_resolver;v_retroknowledge|]) and v_modtype = Tuple ("module_type_body", - [|v_mp;v_noimpl;v_sign;Opt v_mexpr;v_context_set;v_resolver;Any|]) + [|v_mp;v_noimpl;v_sign;Opt v_mexpr;v_resolver;v_unit|]) (** kernel/safe_typing *) let v_vodigest = Sum ("module_impl",0, [| [|String|]; [|String;String|] |]) let v_deps = Array (v_tuple "dep" [|v_dp;v_vodigest|]) let v_compiled_lib = - v_tuple "compiled" [|v_dp;v_module;v_deps;v_engagement;Any|] + v_tuple "compiled" [|v_dp;v_module;v_context_set;v_deps|] (** Library objects *) let v_obj = Dyn -let v_libobj = Tuple ("libobj", [|v_id;v_obj|]) -let v_libobjs = List v_libobj + +let v_open_filter = Sum ("open_filter",1,[|[|v_pred String|]|]) + +let rec v_aobjs = Sum("algebraic_objects", 0, + [| [|v_libobjs|]; + [|v_mp;v_subst|] + |]) +and v_substobjs = + Tuple("*", [|List v_uid;v_aobjs|]) +and v_libobjt = Sum("Libobject.t",0, + [| [| v_substobjs |]; + [| v_substobjs |]; + [| v_aobjs |]; + [| v_libobjs |]; + [| List (v_pair v_open_filter v_mp)|]; + [| v_obj |] + |]) + +and v_libobj = Tuple ("libobj", [|v_id;v_libobjt|]) + +and v_libobjs = List v_libobj + let v_libraryobjs = Tuple ("library_objects",[|v_libobjs;v_libobjs|]) (** STM objects *) @@ -337,18 +406,16 @@ let v_state = Tuple ("state", [|v_states; Any; v_bool|]) let v_vcs = - let data = Opt Any in - let vcs = + let vcs self = Tuple ("vcs", [|Any; Any; Tuple ("dag", [|Any; Any; v_map Any (Tuple ("state_info", - [|Any; Any; Opt v_state; v_pair data Any|])) + [|Any; Any; Opt v_state; v_pair (Opt self) Any|])) |]) |]) in - let () = Obj.set_field (Obj.magic data) 0 (Obj.magic vcs) in - vcs + fix vcs let v_uuid = Any let v_request id doc = @@ -360,30 +427,14 @@ (** Toplevel structures in a vo (see Cic.mli) *) let v_libsum = - Tuple ("summary", [|v_dp;Array v_dp;v_deps|]) + Tuple ("summary", [|v_dp;v_deps;String|]) let v_lib = Tuple ("library",[|v_compiled_lib;v_libraryobjs|]) -let v_opaques = Array (v_computation v_constr) -let v_univopaques = - Opt (Tuple ("univopaques",[|Array (v_computation v_context_set);v_context_set;v_bool|])) - -(** Registering dynamic values *) +let v_delayed_universes = + Sum ("delayed_universes", 0, [| [| v_unit |]; [| Int; v_context_set |] |]) -module IntOrd = -struct - type t = int - let compare (x : t) (y : t) = compare x y -end - -module IntMap = Map.Make(IntOrd) - -let dyn_table : value IntMap.t ref = ref IntMap.empty - -let register_dyn name t = - dyn_table := IntMap.add name t !dyn_table - -let find_dyn name = - try IntMap.find name !dyn_table - with Not_found -> Any +let v_opaquetable = Array (Opt (v_pair v_constr v_delayed_universes)) +let v_univopaques = + Opt (Tuple ("univopaques",[|v_context_set;v_bool|])) diff -Nru coq-doc-8.6/checker/values.mli coq-doc-8.15.0/checker/values.mli --- coq-doc-8.6/checker/values.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/values.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,51 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* if v < 0 || v >= max then let () = Printf.printf "Out-of-range input! (only %d children)\n%!" max in read_num max else Some v - with Failure "int_of_string" -> + | exception Failure _ -> Printf.printf "Unrecognized input! enters the -th child, u goes up 1 level, x exits\n%!"; read_num max @@ -75,48 +79,55 @@ type obj = data - let memory = ref [||] - let sizes = ref [||] + let memory = ref LargeArray.empty + let sizes = ref LargeArray.empty (** size, in words *) let ws = Sys.word_size / 8 - let rec init_size seen = function - | Int _ | Atm _ | Fun _ -> 0 + let rec init_size seen k = function + | Int _ | Atm _ | Fun _ -> k 0 | Ptr p -> - if seen.(p) then 0 + if LargeArray.get seen p then k 0 else - let () = seen.(p) <- true in - match (!memory).(p) with + let () = LargeArray.set seen p true in + match LargeArray.get !memory p with | Struct (tag, os) -> - let fold accu o = accu + 1 + init_size seen o in - let size = Array.fold_left fold 1 os in - let () = (!sizes).(p) <- size in - size + let len = Array.length os in + let rec fold i accu k = + if i == len then k accu + else + init_size seen (fun n -> fold (succ i) (accu + 1 + n) k) os.(i) + in + fold 0 1 (fun size -> let () = LargeArray.set !sizes p size in k size) + | Int64 _ -> k 0 + | Float64 _ -> k 0 | String s -> let size = 2 + (String.length s / ws) in - let () = (!sizes).(p) <- size in - size + let () = LargeArray.set !sizes p size in + k size let size = function | Int _ | Atm _ | Fun _ -> 0 - | Ptr p -> (!sizes).(p) + | Ptr p -> LargeArray.get !sizes p let repr = function | Int i -> INT i | Atm t -> BLOCK (t, [||]) | Fun _ -> OTHER | Ptr p -> - match (!memory).(p) with + match LargeArray.get !memory p with | Struct (tag, os) -> BLOCK (tag, os) + | Int64 _ -> OTHER (* TODO: pretty-print int63 values *) + | Float64 _ -> OTHER (* TODO: pretty-print float64 values *) | String s -> STRING s let input ch = let obj, mem = parse_channel ch in let () = memory := mem in - let () = sizes := Array.make (Array.length mem) (-1) in - let seen = Array.make (Array.length mem) false in - let _ = init_size seen obj in + let () = sizes := LargeArray.make (LargeArray.length mem) (-1) in + let seen = LargeArray.make (LargeArray.length mem) false in + let () = init_size seen ignore obj in obj let oid = function @@ -145,26 +156,32 @@ |String -> "string" |Annot (s,v) -> s^"/"^get_name ~extra v |Dyn -> "" + | Proxy v -> get_name ~extra !v + | Int64 -> "Int64" + | Float64 -> "Float64" (** For tuples, its quite handy to display the inner 1st string (if any). Cf. [structure_body] for instance *) +exception TupleString of string let get_string_in_tuple o = try for i = 0 to Array.length o - 1 do match Repr.repr o.(i) with | STRING s -> - failwith (Printf.sprintf " [..%s..]" s) + let len = min max_string_length (String.length s) in + raise (TupleString (Printf.sprintf " [..%s..]" (String.sub s 0 len))) | _ -> () done; "" - with Failure s -> s + with TupleString s -> s (** Some details : tags, integer value for non-block, etc etc *) let rec get_details v o = match v, Repr.repr o with | (String | Any), STRING s -> - Printf.sprintf " [%s]" (String.escaped s) + let len = min max_string_length (String.length s) in + Printf.sprintf " [%s]" (String.escaped (String.sub s 0 len)) |Tuple (_,v), BLOCK (_, o) -> get_string_in_tuple o |(Sum _|Any), BLOCK (tag, _) -> Printf.sprintf " [tag=%i]" tag @@ -191,20 +208,20 @@ else raise Exit let access_list v o pos = - let rec loop o pos = match Repr.repr o with - | INT 0 -> [] + let rec loop o pos accu = match Repr.repr o with + | INT 0 -> List.rev accu | BLOCK (0, [|hd; tl|]) -> - (v, hd, 0 :: pos) :: loop tl (1 :: pos) + loop tl (1 :: pos) ((v, hd, 0 :: pos) :: accu) | _ -> raise Exit in - Array.of_list (loop o pos) + Array.of_list (loop o pos []) let access_block o = match Repr.repr o with | BLOCK (tag, os) -> (tag, os) | _ -> raise Exit -let access_int o = match Repr.repr o with INT i -> i | _ -> raise Exit (** raises Exit if the object has not the expected structure *) +exception Forbidden let rec get_children v o pos = match v with |Tuple (_, v) -> let (_, os) = access_block o in @@ -225,18 +242,29 @@ | BLOCK (0, [|x|]) -> [|(v, x, 0 :: pos)|] | _ -> raise Exit end - |String | Int -> [||] + | String -> + begin match Repr.repr o with + | STRING _ -> [||] + | _ -> raise Exit + end + | Int -> + begin match Repr.repr o with + | INT _ -> [||] + | _ -> raise Exit + end |Annot (s,v) -> get_children v o pos |Any -> raise Exit |Dyn -> begin match Repr.repr o with | BLOCK (0, [|id; o|]) -> - let n = access_int id in - let tpe = find_dyn n in + let tpe = Any in [|(Int, id, 0 :: pos); (tpe, o, 1 :: pos)|] | _ -> raise Exit end - |Fail s -> failwith "forbidden" + |Fail s -> raise Forbidden + | Proxy v -> get_children !v o pos + | Int64 -> raise Exit + | Float64 -> raise Exit let get_children v o pos = try get_children v o pos @@ -257,9 +285,10 @@ let push name v o p = stk := { nam = name; typ = v; obj = o; pos = p } :: !stk +exception EmptyStack let pop () = match !stk with | i::s -> stk := s; i - | _ -> failwith "empty stack" + | _ -> raise EmptyStack let rec visit v o pos = Printf.printf "\nDepth %d Pos %s Context %s\n" @@ -283,8 +312,8 @@ push (get_name v) v o pos; visit v' o' pos' with - | Failure "empty stack" -> () - | Failure "forbidden" -> let info = pop () in visit info.typ info.obj info.pos + | EmptyStack -> () + | Forbidden -> let info = pop () in visit info.typ info.obj info.pos | Failure _ | Invalid_argument _ -> visit v o pos end @@ -313,22 +342,70 @@ } let parse_header chan = - let magic = String.create 4 in - let () = for i = 0 to 3 do magic.[i] <- input_char chan done in + let magic = really_input_string chan 4 in let length = input_binary_int chan in let objects = input_binary_int chan in let size32 = input_binary_int chan in let size64 = input_binary_int chan in { magic; length; size32; size64; objects } +module ObjFile = +struct + type segment = { name : string; - mutable pos : int; - typ : Values.value; + pos : int64; + len : int64; + hash : Digest.t; mutable header : header; } -let make_seg name typ = { name; typ; pos = 0; header = dummy_header } +let input_int32 ch = + let accu = ref 0l in + for _i = 0 to 3 do + let c = input_byte ch in + accu := Int32.add (Int32.shift_left !accu 8) (Int32.of_int c) + done; + !accu + +let input_int64 ch = + let accu = ref 0L in + for _i = 0 to 7 do + let c = input_byte ch in + accu := Int64.add (Int64.shift_left !accu 8) (Int64.of_int c) + done; + !accu + +let input_segment_summary ch = + let nlen = input_int32 ch in + let name = really_input_string ch (Int32.to_int nlen) in + let pos = input_int64 ch in + let len = input_int64 ch in + let hash = Digest.input ch in + { name; pos; len; hash; header = dummy_header } + +let rec input_segment_summaries ch n accu = + if Int32.equal n 0l then Array.of_list (List.rev accu) + else + let s = input_segment_summary ch in + let accu = s :: accu in + input_segment_summaries ch (Int32.pred n) accu + +let parse_segments ch = + let magic = input_int32 ch in + let version = input_int32 ch in + let summary_pos = input_int64 ch in + let () = LargeFile.seek_in ch summary_pos in + let nsum = input_int32 ch in + let seg = input_segment_summaries ch nsum [] in + for i = 0 to Array.length seg - 1 do + let () = LargeFile.seek_in ch seg.(i).pos in + let header = parse_header ch in + seg.(i).header <- header + done; + (magic, version, seg) + +end let visit_vo f = Printf.printf "\nWelcome to votour !\n"; @@ -336,48 +413,42 @@ Printf.printf "Object sizes are in words (%d bits)\n" Sys.word_size; Printf.printf "At prompt, enters the -th child, u goes up 1 level, x exits\n\n%!"; - let segments = [| - make_seg "summary" Values.v_libsum; - make_seg "library" Values.v_lib; - make_seg "univ constraints of opaque proofs" Values.v_univopaques; - make_seg "discharging info" (Opt Any); - make_seg "STM tasks" (Opt Values.v_stm_seg); - make_seg "opaque proofs" Values.v_opaques; - |] in + let known_segments = [ + "summary", Values.v_libsum; + "library", Values.v_lib; + "universes", Values.v_univopaques; + "tasks", (Opt Values.v_stm_seg); + "opaques", Values.v_opaquetable; + ] in let repr = if Sys.word_size = 64 then (module ReprMem : S) else (module ReprObj : S) - (** On 32-bit machines, representation may exceed the max size of arrays *) + (* On 32-bit machines, representation may exceed the max size of arrays *) in let module Repr = (val repr : S) in let module Visit = Visit(Repr) in while true do let ch = open_in_bin f in - let magic = input_binary_int ch in - Printf.printf "File format: %d\n%!" magic; - for i=0 to Array.length segments - 1 do - let pos = input_binary_int ch in - segments.(i).pos <- pos_in ch; - let header = parse_header ch in - segments.(i).header <- header; - seek_in ch pos; - ignore(Digest.input ch); - done; + let (_magic, version, segments) = ObjFile.parse_segments ch in + Printf.printf "File format: %ld\n%!" version; Printf.printf "The file has %d segments, choose the one to visit:\n" (Array.length segments); - Array.iteri (fun i { name; pos; header } -> + Array.iteri (fun i ObjFile.{ name; pos; header } -> let size = if Sys.word_size = 64 then header.size64 else header.size32 in - Printf.printf " %d: %s, starting at byte %d (size %iw)\n" i name pos size) + Printf.printf " %d: %s, starting at byte %Ld (size %iw)\n" i name pos size) segments; match read_num (Array.length segments) with | Some seg -> - seek_in ch segments.(seg).pos; + let seg = segments.(seg) in + let open ObjFile in + LargeFile.seek_in ch seg.pos; let o = Repr.input ch in let () = Visit.init () in - Visit.visit segments.(seg).typ o [] + let typ = try List.assoc seg.name known_segments with Not_found -> Any in + Visit.visit typ o [] | None -> () done -let main = +let () = if not !Sys.interactive then Arg.parse [] visit_vo ("votour: guided tour of a Coq .vo or .vi file\n"^ diff -Nru coq-doc-8.6/checker/votour.mli coq-doc-8.15.0/checker/votour.mli --- coq-doc-8.6/checker/votour.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/checker/votour.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,12 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a -> int) -> 'a array -> 'a array -> int + val equal : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool + val equal_norefl : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool + val is_empty : 'a array -> bool + val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool + val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool + val for_all3 : ('a -> 'b -> 'c -> bool) -> + 'a array -> 'b array -> 'c array -> bool + val for_all4 : ('a -> 'b -> 'c -> 'd -> bool) -> + 'a array -> 'b array -> 'c array -> 'd array -> bool + val for_all_i : (int -> 'a -> bool) -> int -> 'a array -> bool + val findi : (int -> 'a -> bool) -> 'a array -> int option + val hd : 'a array -> 'a + val tl : 'a array -> 'a array + val last : 'a array -> 'a + val cons : 'a -> 'a array -> 'a array + val rev : 'a array -> unit + val fold_right_i : + (int -> 'b -> 'a -> 'a) -> 'b array -> 'a -> 'a + val fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a + val fold_right2 : + ('a -> 'b -> 'c -> 'c) -> 'a array -> 'b array -> 'c -> 'c + val fold_right3 : + ('a -> 'b -> 'c -> 'd -> 'd) -> 'a array -> 'b array -> 'c array -> 'd -> 'd + val fold_left2 : + ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a + val fold_left3 : + ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a + val fold_left4 : + ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a + val fold_left2_i : + (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a + val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a + val map_to_list : ('a -> 'b) -> 'a array -> 'b list + val map_of_list : ('a -> 'b) -> 'a list -> 'b array + val chop : int -> 'a array -> 'a array * 'a array + val split : ('a * 'b) array -> 'a array * 'b array + val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array + val map3 : + ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array + val map3_i : + (int -> 'a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array + val map_left : ('a -> 'b) -> 'a array -> 'b array + val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit + val iter3 : ('a -> 'b -> 'c -> unit) -> 'a array -> 'b array -> 'c array -> unit + val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array + val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c + val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array + val fold_left2_map_i : (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array + val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c + val distinct : 'a array -> bool + val rev_of_list : 'a list -> 'a array + val rev_to_list : 'a array -> 'a list + val filter_with : bool list -> 'a array -> 'a array + module Smart : + sig + val map : ('a -> 'a) -> 'a array -> 'a array + val map_i : (int -> 'a -> 'a) -> 'a array -> 'a array + val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array + val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array + val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array + end + module Fun1 : + sig + val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array + val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit + val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit + module Smart : + sig + val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array + end + end +end + +include Array + +let uget = Array.unsafe_get + +(* Arrays *) + +let compare cmp v1 v2 = + if v1 == v2 then 0 + else + let len = Array.length v1 in + let c = Int.compare len (Array.length v2) in + if c <> 0 then c else + let rec loop i = + if i < 0 then 0 + else + let x = uget v1 i in + let y = uget v2 i in + let c = cmp x y in + if c <> 0 then c + else loop (i - 1) + in + loop (len - 1) + +let equal_norefl cmp t1 t2 = + let len = Array.length t1 in + if not (Int.equal len (Array.length t2)) then false + else + let rec aux i = + if i < 0 then true + else + let x = uget t1 i in + let y = uget t2 i in + cmp x y && aux (pred i) + in + aux (len - 1) + +let equal cmp t1 t2 = + if t1 == t2 then true else equal_norefl cmp t1 t2 + + +let is_empty array = Int.equal (Array.length array) 0 + +let exists2 f v1 v2 = + let rec exrec = function + | -1 -> false + | n -> f (uget v1 n) (uget v2 n) || (exrec (n-1)) + in + let lv1 = Array.length v1 in + lv1 = Array.length v2 && exrec (lv1-1) + +let for_all2 f v1 v2 = + let rec allrec = function + | -1 -> true + | n -> + let ans = f (uget v1 n) (uget v2 n) in + ans && (allrec (n-1)) + in + let lv1 = Array.length v1 in + lv1 = Array.length v2 && allrec (pred lv1) + +let for_all3 f v1 v2 v3 = + let rec allrec = function + | -1 -> true + | n -> + let ans = f (uget v1 n) + (uget v2 n) (uget v3 n) + in + ans && (allrec (n-1)) + in + let lv1 = Array.length v1 in + lv1 = Array.length v2 && lv1 = Array.length v3 && allrec (pred lv1) + +let for_all4 f v1 v2 v3 v4 = + let rec allrec = function + | -1 -> true + | n -> + let ans = f (uget v1 n) + (uget v2 n) (uget v3 n) (uget v4 n) + in + ans && (allrec (n-1)) + in + let lv1 = Array.length v1 in + lv1 = Array.length v2 && + lv1 = Array.length v3 && + lv1 = Array.length v4 && + allrec (pred lv1) + +let for_all_i f i v = + let len = Array.length v in + let rec allrec i n = + n = len || f i (uget v n) && allrec (i+1) (n+1) in + allrec i 0 + +exception Found of int + +let findi (pred: int -> 'a -> bool) (arr: 'a array) : int option = + try + for i=0 to Array.length arr - 1 do + if pred i (uget arr i) then raise (Found i) done; + None + with Found i -> Some i + +let hd v = + match Array.length v with + | 0 -> failwith "Array.hd" + | _ -> uget v 0 + +let tl v = + match Array.length v with + | 0 -> failwith "Array.tl" + | n -> Array.sub v 1 (pred n) + +let last v = + match Array.length v with + | 0 -> failwith "Array.last" + | n -> uget v (pred n) + +let cons e v = + let len = Array.length v in + let ans = Array.make (Array.length v + 1) e in + let () = Array.blit v 0 ans 1 len in + ans + +let rev t = + let n=Array.length t in + if n <=0 then () + else + for i = 0 to pred (n/2) do + let tmp = uget t ((pred n)-i) in + Array.unsafe_set t ((pred n)-i) (uget t i); + Array.unsafe_set t i tmp + done + +let fold_right_i f v a = + let rec fold a n = + if n=0 then a + else + let k = n-1 in + fold (f k (uget v k) a) k in + fold a (Array.length v) + +let fold_left_i f v a = + let n = Array.length a in + let rec fold i v = if i = n then v else fold (succ i) (f i v (uget a i)) in + fold 0 v + +let fold_right2 f v1 v2 a = + let lv1 = Array.length v1 in + let rec fold a n = + if n=0 then a + else + let k = n-1 in + fold (f (uget v1 k) (uget v2 k) a) k in + if Array.length v2 <> lv1 then invalid_arg "Array.fold_right2"; + fold a lv1 + +let fold_left2 f a v1 v2 = + let lv1 = Array.length v1 in + let rec fold a n = + if n >= lv1 then a else fold (f a (uget v1 n) (uget v2 n)) (succ n) + in + if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2"; + fold a 0 + +let fold_left2_i f a v1 v2 = + let lv1 = Array.length v1 in + let rec fold a n = + if n >= lv1 then a else fold (f n a (uget v1 n) (uget v2 n)) (succ n) + in + if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2_i"; + fold a 0 + +let fold_right3 f v1 v2 v3 a = + let lv1 = Array.length v1 in + let rec fold a n = + if n=0 then a + else + let k = n-1 in + fold (f (uget v1 k) (uget v2 k) (uget v3 k) a) k in + if Array.length v2 <> lv1 || Array.length v3 <> lv1 then invalid_arg "Array.fold_right3"; + fold a lv1 + +let fold_left3 f a v1 v2 v3 = + let lv1 = Array.length v1 in + let rec fold a n = + if n >= lv1 then a + else fold (f a (uget v1 n) (uget v2 n) (uget v3 n)) (succ n) + in + if Array.length v2 <> lv1 || Array.length v3 <> lv1 then + invalid_arg "Array.fold_left3"; + fold a 0 + +let fold_left4 f a v1 v2 v3 v4 = + let lv1 = Array.length v1 in + let rec fold a n = + if n >= lv1 then a + else fold (f a (uget v1 n) (uget v2 n) (uget v3 n) (uget v4 n)) (succ n) + in + if Array.length v2 <> lv1 || Array.length v3 <> lv1 || Array.length v4 <> lv1 then + invalid_arg "Array.fold_left4"; + fold a 0 + +let fold_left_from n f a v = + let len = Array.length v in + let () = if n < 0 then invalid_arg "Array.fold_left_from" in + let rec fold a n = + if n >= len then a else fold (f a (uget v n)) (succ n) + in + fold a n + +let rev_of_list = function +| [] -> [| |] +| x :: l -> + let len = List.length l in + let ans = Array.make (succ len) x in + let rec set i = function + | [] -> () + | x :: l -> + Array.unsafe_set ans i x; + set (pred i) l + in + let () = set (len - 1) l in + ans + +let map_to_list = CList.map_of_array + +let map_of_list f l = + let len = List.length l in + let rec fill i v = function + | [] -> () + | x :: l -> + Array.unsafe_set v i (f x); + fill (succ i) v l + in + match l with + | [] -> [||] + | x :: l -> + let ans = Array.make len (f x) in + let () = fill 1 ans l in + ans + +let chop n v = + let vlen = Array.length v in + if n > vlen then failwith "Array.chop"; + (Array.sub v 0 n, Array.sub v n (vlen-n)) + +let split v = + (Array.map fst v, Array.map snd v) + +let map2_i f v1 v2 = + let len1 = Array.length v1 in + let len2 = Array.length v2 in + let () = if not (Int.equal len1 len2) then invalid_arg "Array.map2" in + if Int.equal len1 0 then + [| |] + else begin + let res = Array.make len1 (f 0 (uget v1 0) (uget v2 0)) in + for i = 1 to pred len1 do + Array.unsafe_set res i (f i (uget v1 i) (uget v2 i)) + done; + res + end + +let map3 f v1 v2 v3 = + let len1 = Array.length v1 in + let () = + if len1 <> Array.length v2 || len1 <> Array.length v3 + then invalid_arg "Array.map3" + in + if Int.equal len1 0 then + [| |] + else begin + let res = Array.make len1 (f (uget v1 0) (uget v2 0) (uget v3 0)) in + for i = 1 to pred len1 do + Array.unsafe_set res i (f (uget v1 i) (uget v2 i) (uget v3 i)) + done; + res + end + +let map3_i f v1 v2 v3 = + let len1 = Array.length v1 in + let len2 = Array.length v2 in + let len3 = Array.length v3 in + let () = if not (Int.equal len1 len2 && Int.equal len1 len3) then invalid_arg "Array.map3_i" in + if Int.equal len1 0 then + [| |] + else begin + let res = Array.make len1 (f 0 (uget v1 0) (uget v2 0) (uget v3 0)) in + for i = 1 to pred len1 do + Array.unsafe_set res i (f i (uget v1 i) (uget v2 i) (uget v3 i)) + done; + res + end + +let map_left f a = (* Ocaml does not guarantee Array.map is LR *) + let l = Array.length a in (* (even if so), then we rewrite it *) + if Int.equal l 0 then [||] else begin + let r = Array.make l (f (uget a 0)) in + for i = 1 to l - 1 do + Array.unsafe_set r i (f (uget a i)) + done; + r + end + +let iter2_i f v1 v2 = + let len1 = Array.length v1 in + let len2 = Array.length v2 in + let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in + for i = 0 to len1 - 1 do f i (uget v1 i) (uget v2 i) done + +let iter3 f v1 v2 v3 = + let len1 = Array.length v1 in + let len2 = Array.length v2 in + let len3 = Array.length v3 in + let () = if not (Int.equal len2 len1) || not (Int.equal len1 len3) then invalid_arg "Array.iter3" in + for i = 0 to len1 - 1 do f (uget v1 i) (uget v2 i) (uget v3 i) done + +let map_right f a = + let l = length a in + if l = 0 then [||] else begin + let r = Array.make l (f (unsafe_get a (l-1))) in + for i = l-2 downto 0 do + unsafe_set r i (f (unsafe_get a i)) + done; + r + end + +let map2_right f a b = + let l = length a in + if l <> length b then invalid_arg "CArray.map2_right: length mismatch"; + if l = 0 then [||] else begin + let r = Array.make l (f (unsafe_get a (l-1)) (unsafe_get b (l-1))) in + for i = l-2 downto 0 do + unsafe_set r i (f (unsafe_get a i) (unsafe_get b i)) + done; + r + end + +let fold_right_map f v e = + let e' = ref e in + let v' = map_right (fun x -> let (y,e) = f x !e' in e' := e; y) v in + (v',!e') + +let fold_left_map f e v = + let e' = ref e in + let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in + (!e',v') + +let fold_right2_map f v1 v2 e = + let e' = ref e in + let v' = + map2_right (fun x1 x2 -> let (y,e) = f x1 x2 !e' in e' := e; y) v1 v2 + in + (v',!e') + +let fold_left2_map f e v1 v2 = + let e' = ref e in + let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in + (!e',v') + +let fold_left2_map_i f e v1 v2 = + let e' = ref e in + let v' = map2_i (fun idx x1 x2 -> let (e,y) = f idx !e' x1 x2 in e' := e; y) v1 v2 in + (!e',v') + +let distinct v = + let visited = Hashtbl.create 23 in + try + Array.iter + (fun x -> + if Hashtbl.mem visited x then raise Exit + else Hashtbl.add visited x x) + v; + true + with Exit -> false + +let rev_to_list a = + let rec tolist i res = + if i >= Array.length a then res else tolist (i+1) (uget a i :: res) in + tolist 0 [] + +let filter_with filter v = + Array.of_list (CList.filter_with filter (Array.to_list v)) + +module Smart = +struct + + (* If none of the elements is changed by f we return ar itself. + The while loop looks for the first such an element. + If found, we break here and the new array is produced, + but f is not re-applied to elements that are already checked *) + let map f (ar : 'a array) = + let len = Array.length ar in + let i = ref 0 in + let break = ref true in + let temp = ref None in + while !break && (!i < len) do + let v = Array.unsafe_get ar !i in + let v' = f v in + if v == v' then incr i + else begin + break := false; + temp := Some v'; + end + done; + if !i < len then begin + (* The array is not the same as the original one *) + let ans : 'a array = Array.copy ar in + let v = match !temp with None -> assert false | Some x -> x in + Array.unsafe_set ans !i v; + incr i; + while !i < len do + let v = Array.unsafe_get ans !i in + let v' = f v in + if v != v' then Array.unsafe_set ans !i v'; + incr i + done; + ans + end else ar + + (* Same as map_i but smart *) + let map_i f (ar : 'a array) = + let len = Array.length ar in + let i = ref 0 in + let break = ref true in + let temp = ref None in + while !break && (!i < len) do + let v = Array.unsafe_get ar !i in + let v' = f !i v in + if v == v' then incr i + else begin + break := false; + temp := Some v'; + end + done; + if !i < len then begin + (* The array is not the same as the original one *) + let ans : 'a array = Array.copy ar in + let v = match !temp with None -> assert false | Some x -> x in + Array.unsafe_set ans !i v; + incr i; + while !i < len do + let v = Array.unsafe_get ans !i in + let v' = f !i v in + if v != v' then Array.unsafe_set ans !i v'; + incr i + done; + ans + end else ar + + let map2 f aux_ar ar = + let len = Array.length ar in + let aux_len = Array.length aux_ar in + let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.map2" in + let i = ref 0 in + let break = ref true in + let temp = ref None in + while !break && (!i < len) do + let v = Array.unsafe_get ar !i in + let w = Array.unsafe_get aux_ar !i in + let v' = f w v in + if v == v' then incr i + else begin + break := false; + temp := Some v'; + end + done; + if !i < len then begin + (* The array is not the same as the original one *) + let ans : 'a array = Array.copy ar in + let v = match !temp with None -> assert false | Some x -> x in + Array.unsafe_set ans !i v; + incr i; + while !i < len do + let v = Array.unsafe_get ans !i in + let w = Array.unsafe_get aux_ar !i in + let v' = f w v in + if v != v' then Array.unsafe_set ans !i v'; + incr i + done; + ans + end else ar + + (** Same as [Smart.map] but threads a state meanwhile *) + let fold_left_map f accu (ar : 'a array) = + let len = Array.length ar in + let i = ref 0 in + let break = ref true in + let r = ref accu in + (* This variable is never accessed unset *) + let temp = ref None in + while !break && (!i < len) do + let v = Array.unsafe_get ar !i in + let (accu, v') = f !r v in + r := accu; + if v == v' then incr i + else begin + break := false; + temp := Some v'; + end + done; + if !i < len then begin + let ans : 'a array = Array.copy ar in + let v = match !temp with None -> assert false | Some x -> x in + Array.unsafe_set ans !i v; + incr i; + while !i < len do + let v = Array.unsafe_get ar !i in + let (accu, v') = f !r v in + r := accu; + if v != v' then Array.unsafe_set ans !i v'; + incr i + done; + !r, ans + end else !r, ar + + (** Same as [Smart.map2] but threads a state meanwhile *) + let fold_left2_map f accu aux_ar ar = + let len = Array.length ar in + let aux_len = Array.length aux_ar in + let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.fold_left2_map" in + let i = ref 0 in + let break = ref true in + let r = ref accu in + (* This variable is never accessed unset *) + let temp = ref None in + while !break && (!i < len) do + let v = Array.unsafe_get ar !i in + let w = Array.unsafe_get aux_ar !i in + let (accu, v') = f !r w v in + r := accu; + if v == v' then incr i + else begin + break := false; + temp := Some v'; + end + done; + if !i < len then begin + let ans : 'a array = Array.copy ar in + let v = match !temp with None -> assert false | Some x -> x in + Array.unsafe_set ans !i v; + incr i; + while !i < len do + let v = Array.unsafe_get ar !i in + let w = Array.unsafe_get aux_ar !i in + let (accu, v') = f !r w v in + r := accu; + if v != v' then Array.unsafe_set ans !i v'; + incr i + done; + !r, ans + end else !r, ar + +end + +module Fun1 = +struct + + let map f arg v = match v with + | [| |] -> [| |] + | _ -> + let len = Array.length v in + let x0 = Array.unsafe_get v 0 in + let ans = Array.make len (f arg x0) in + for i = 1 to pred len do + let x = Array.unsafe_get v i in + Array.unsafe_set ans i (f arg x) + done; + ans + + let iter f arg v = + let len = Array.length v in + for i = 0 to pred len do + let x = uget v i in + f arg x + done + + let iter2 f arg v1 v2 = + let len1 = Array.length v1 in + let len2 = Array.length v2 in + let () = if not (Int.equal len2 len1) then invalid_arg "Array.Fun1.iter2" in + for i = 0 to pred len1 do + let x1 = uget v1 i in + let x2 = uget v2 i in + f arg x1 x2 + done + + module Smart = + struct + + let map f arg (ar : 'a array) = + let len = Array.length ar in + let i = ref 0 in + let break = ref true in + let temp = ref None in + while !break && (!i < len) do + let v = Array.unsafe_get ar !i in + let v' = f arg v in + if v == v' then incr i + else begin + break := false; + temp := Some v'; + end + done; + if !i < len then begin + (* The array is not the same as the original one *) + let ans : 'a array = Array.copy ar in + let v = match !temp with None -> assert false | Some x -> x in + Array.unsafe_set ans !i v; + incr i; + while !i < len do + let v = Array.unsafe_get ans !i in + let v' = f arg v in + if v != v' then Array.unsafe_set ans !i v'; + incr i + done; + ans + end else ar + + end + +end diff -Nru coq-doc-8.6/clib/cArray.mli coq-doc-8.15.0/clib/cArray.mli --- coq-doc-8.6/clib/cArray.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cArray.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,183 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a -> int) -> 'a array -> 'a array -> int + (** First size comparison, then lexicographic order. *) + + val equal : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool + (** Lift equality to array type. *) + + val equal_norefl : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool + (** Like {!equal} but does not assume that equality is reflexive: no + optimisation is performed if both arrays are physically the + same. *) + + val is_empty : 'a array -> bool + (** True whenever the array is empty. *) + + val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool + + val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool + val for_all3 : ('a -> 'b -> 'c -> bool) -> + 'a array -> 'b array -> 'c array -> bool + val for_all4 : ('a -> 'b -> 'c -> 'd -> bool) -> + 'a array -> 'b array -> 'c array -> 'd array -> bool + val for_all_i : (int -> 'a -> bool) -> int -> 'a array -> bool + + val findi : (int -> 'a -> bool) -> 'a array -> int option + + val hd : 'a array -> 'a + (** First element of an array, or [Failure "Array.hd"] if empty. *) + + val tl : 'a array -> 'a array + (** Remaining part of [hd], or [Failure "Array.tl"] if empty. *) + + val last : 'a array -> 'a + (** Last element of an array, or [Failure "Array.last"] if empty. *) + + val cons : 'a -> 'a array -> 'a array + (** Append an element on the left. *) + + val rev : 'a array -> unit + (** In place reversal. *) + + val fold_right_i : + (int -> 'b -> 'a -> 'a) -> 'b array -> 'a -> 'a + val fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a + val fold_right2 : + ('a -> 'b -> 'c -> 'c) -> 'a array -> 'b array -> 'c -> 'c + val fold_right3 : + ('a -> 'b -> 'c -> 'd -> 'd) -> 'a array -> 'b array -> 'c array -> 'd -> 'd + val fold_left2 : + ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a + val fold_left3 : + ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a + val fold_left4 : + ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a + val fold_left2_i : + (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a + val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a + + val map_to_list : ('a -> 'b) -> 'a array -> 'b list + (** Composition of [map] and [to_list]. *) + + val map_of_list : ('a -> 'b) -> 'a list -> 'b array + (** Composition of [map] and [of_list]. *) + + val chop : int -> 'a array -> 'a array * 'a array + (** [chop i a] returns [(a1, a2)] s.t. [a = a1 + a2] and [length a1 = n]. + Raise [Failure "Array.chop"] if [i] is not a valid index. *) + + val split : ('a * 'b) array -> 'a array * 'b array + + val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array + val map3 : + ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array + val map3_i : + (int -> 'a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array + + val map_left : ('a -> 'b) -> 'a array -> 'b array + (** As [map] but guaranteed to be left-to-right. *) + + val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit + (** Iter on two arrays. Raise [Invalid_argument "Array.iter2_i"] if sizes differ. *) + + val iter3 : ('a -> 'b -> 'c -> unit) -> 'a array -> 'b array -> 'c array -> unit + (** Iter on three arrays. Raise [Invalid_argument "Array.iter3"] if sizes differ. *) + + val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array + (** [fold_left_map f e_0 [|l_1...l_n|] = e_n,[|k_1...k_n|]] + where [(e_i,k_i)=f e_{i-1} l_i]; see also [Smart.fold_left_map] *) + + val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c + (** Same, folding on the right *) + + val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array + (** Same with two arrays, folding on the left; see also [Smart.fold_left2_map] *) + + val fold_left2_map_i : + (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array + (** Same than [fold_left2_map] but passing the index of the array *) + + val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c + (** Same with two arrays, folding on the right *) + + val distinct : 'a array -> bool + (** Return [true] if every element of the array is unique (for default + equality). *) + + val rev_of_list : 'a list -> 'a array + (** [rev_of_list l] is equivalent to [Array.of_list (List.rev l)]. *) + + val rev_to_list : 'a array -> 'a list + (** [rev_to_list a] is equivalent to [List.rev (List.of_array a)]. *) + + val filter_with : bool list -> 'a array -> 'a array + (** [filter_with b a] selects elements of [a] whose corresponding element in + [b] is [true]. Raise [Invalid_argument _] when sizes differ. *) + + module Smart : + sig + val map : ('a -> 'a) -> 'a array -> 'a array + (** [Smart.map f a] behaves as [map f a] but returns [a] instead of a copy when + [f x == x] for all [x] in [a]. *) + + val map_i : (int -> 'a -> 'a) -> 'a array -> 'a array + + val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array + (** [Smart.map2 f a b] behaves as [map2 f a b] but returns [a] instead of a copy when + [f x y == y] for all [x] in [a] and [y] in [b] pointwise. *) + + val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array + (** [Smart.fold_left_mapf a b] behaves as [fold_left_map] but + returns [b] as second component instead of a copy of [b] when + the output array is pointwise the same as the input array [b] *) + + val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array + (** [Smart.fold_left2_map f a b c] behaves as [fold_left2_map] but + returns [c] as second component instead of a copy of [c] when + the output array is pointwise the same as the input array [c] *) + + end + (** The functions defined in this module are optimized specializations + of the main ones, when the returned array is of same type as one of + the original array. *) + + module Fun1 : + sig + val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array + (** [Fun1.map f x v = map (f x) v] *) + + val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit + (** [Fun1.iter f x v = iter (f x) v] *) + + val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit + (** [Fun1.iter2 f x v1 v2 = iter (f x) v1 v2] *) + + module Smart : + sig + val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array + (** [Fun1.Smart.map f x v = Smart.map (f x) v] *) + end + + end + (** The functions defined in this module are the same as the main ones, except + that they are all higher-order, and their function arguments have an + additional parameter. This allows us to prevent closure creation in critical + cases. *) + +end + +include ExtS diff -Nru coq-doc-8.6/clib/cEphemeron.ml coq-doc-8.15.0/clib/cEphemeron.ml --- coq-doc-8.6/clib/cEphemeron.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cEphemeron.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,106 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* a | _ -> b *) + if x.0 == constr_Y then a else b + + and the polymorphic comparison function works like: + + let equal = fun (c1, ...) (c2, ...) -> + c1.id == c2.id + + In every new extension constructor, the name field is a constant + string and the id field is filled with an unique[1] value returned + by %caml_fresh_oo_id. Moreover, every value of an extensible variant + type is allocated as a new block. + + [1]: On 64-bit systems. On 32-bit systems, calling %caml_fresh_oo_id + 2**30 times will result in a wraparound. Note that this does + not affect soundness because constructors are compared by + physical equality during matching. See OCaml PR7809 for code + demonstrating this. + + An extensible variant can be marshalled and unmarshalled, and + is guaranteed to not be equal to itself after unmarshalling, + since the id field is filled with another unique value. + + Note that the explanation above is purely informative and we + do not depend on the exact representation of extensible variants, + only on the fact that no two constructor representations ever + alias. In particular, if the definition of constr is replaced with: + + type constr = int + + (where the value is truly unique for every created constructor), + correctness is preserved. + *) +type 'a typ = .. + +(* Erases the contained type so that the key can be put in a hash table. *) +type boxkey = Box : 'a typ -> boxkey [@@unboxed] + +(* Carry the type we just erased with the actual key. *) +type 'a key = 'a typ * boxkey + +module EHashtbl = Ephemeron.K1.Make(struct + type t = boxkey + let equal = (==) + let hash = Hashtbl.hash +end) + +type value = { get : 'k. 'k typ -> 'k } [@@unboxed] + +let values : value EHashtbl.t = + EHashtbl.create 1001 + +let create : type v. v -> v key = + fun value -> + let module M = struct + type _ typ += Typ : v typ + + let get : type k. k typ -> k = + fun typ -> + match typ with + | Typ -> value + | _ -> assert false + + let boxkey = Box Typ + let key = Typ, boxkey + let value = { get } + end in + EHashtbl.add values M.boxkey M.value; + M.key + +(* Avoid raising Not_found *) +exception InvalidKey +let get (typ, boxkey) = + try (EHashtbl.find values boxkey).get typ + with Not_found -> raise InvalidKey + +let default (typ, boxkey) default = + try (EHashtbl.find values boxkey).get typ + with Not_found -> default + +let clean () = EHashtbl.clean values diff -Nru coq-doc-8.6/clib/cEphemeron.mli coq-doc-8.15.0/clib/cEphemeron.mli --- coq-doc-8.6/clib/cEphemeron.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cEphemeron.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,54 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a key + +exception InvalidKey + +val get : 'a key -> 'a +(** May raise InvalidKey *) + +val default : 'a key -> 'a -> 'a +(** Never fails. *) + +val clean : unit -> unit diff -Nru coq-doc-8.6/clib/cList.ml coq-doc-8.15.0/clib/cList.ml --- coq-doc-8.6/clib/cList.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cList.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,1058 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* int +type 'a eq = 'a -> 'a -> bool + +module type S = module type of List + +module type ExtS = +sig + include S + val compare : 'a cmp -> 'a list cmp + val equal : 'a eq -> 'a list eq + val is_empty : 'a list -> bool + val mem_f : 'a eq -> 'a -> 'a list -> bool + val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool + val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool + val exists_i : (int -> 'a -> bool) -> int -> 'a list -> bool + val prefix_of : 'a eq -> 'a list -> 'a list -> bool + val same_length : 'a list -> 'b list -> bool + val interval : int -> int -> int list + val make : int -> 'a -> 'a list + val addn : int -> 'a -> 'a list -> 'a list + val init : int -> (int -> 'a) -> 'a list + val append : 'a list -> 'a list -> 'a list + val concat : 'a list list -> 'a list + val flatten : 'a list list -> 'a list + val assign : 'a list -> int -> 'a -> 'a list + val filter : ('a -> bool) -> 'a list -> 'a list + val filter2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list + val filteri : + (int -> 'a -> bool) -> 'a list -> 'a list + val filter_with : bool list -> 'a list -> 'a list + val map_filter : ('a -> 'b option) -> 'a list -> 'b list + val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list + val partitioni : + (int -> 'a -> bool) -> 'a list -> 'a list * 'a list + val map : ('a -> 'b) -> 'a list -> 'b list + val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val map_left : ('a -> 'b) -> 'a list -> 'b list + val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list + val map2_i : + (int -> 'a -> 'b -> 'c) -> int -> 'a list -> 'b list -> 'c list + val map3 : + ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list + val map4 : + ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list -> 'd list -> 'e list + val map_of_array : ('a -> 'b) -> 'a array -> 'b list + val map_append : ('a -> 'b list) -> 'a list -> 'b list + val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list + val extend : bool list -> 'a -> 'a list -> 'a list + val count : ('a -> bool) -> 'a list -> int + val index : 'a eq -> 'a -> 'a list -> int + val safe_index : 'a eq -> 'a -> 'a list -> int option + val index0 : 'a eq -> 'a -> 'a list -> int + val fold_left_until : ('c -> 'a -> 'c CSig.until) -> 'c -> 'a list -> 'c + val fold_right_i : (int -> 'a -> 'b -> 'b) -> int -> 'a list -> 'b -> 'b + val fold_left_i : (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a + val fold_right_and_left : + ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a + val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a + val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a + val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list + val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a + val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list + val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a + val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list + val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list + val except : 'a eq -> 'a -> 'a list -> 'a list + val remove : 'a eq -> 'a -> 'a list -> 'a list + val remove_first : ('a -> bool) -> 'a list -> 'a list + val extract_first : ('a -> bool) -> 'a list -> 'a list * 'a + val find_map : ('a -> 'b option) -> 'a list -> 'b + exception IndexOutOfRange + val goto : int -> 'a list -> 'a list * 'a list + val split_when : ('a -> bool) -> 'a list -> 'a list * 'a list + val sep_last : 'a list -> 'a * 'a list + val drop_last : 'a list -> 'a list + val last : 'a list -> 'a + val lastn : int -> 'a list -> 'a list + val chop : int -> 'a list -> 'a list * 'a list + val firstn : int -> 'a list -> 'a list + val skipn : int -> 'a list -> 'a list + val skipn_at_least : int -> 'a list -> 'a list + val drop_prefix : 'a eq -> 'a list -> 'a list -> 'a list + val insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list + val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list + val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list + val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b + val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list + val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool + val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list + val split : ('a * 'b) list -> 'a list * 'b list + val combine : 'a list -> 'b list -> ('a * 'b) list + val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list + val split4 : ('a * 'b * 'c * 'd) list -> 'a list * 'b list * 'c list * 'd list + val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list + val add_set : 'a eq -> 'a -> 'a list -> 'a list + val eq_set : 'a eq -> 'a list -> 'a list -> bool + val subset : 'a list -> 'a list -> bool + val merge_set : 'a cmp -> 'a list -> 'a list -> 'a list + val intersect : 'a eq -> 'a list -> 'a list -> 'a list + val union : 'a eq -> 'a list -> 'a list -> 'a list + val unionq : 'a list -> 'a list -> 'a list + val subtract : 'a eq -> 'a list -> 'a list -> 'a list + val subtractq : 'a list -> 'a list -> 'a list + val distinct : 'a list -> bool + val distinct_f : 'a cmp -> 'a list -> bool + val duplicates : 'a eq -> 'a list -> 'a list + val uniquize_key : ('a -> 'b) -> 'a list -> 'a list + val uniquize : 'a list -> 'a list + val sort_uniquize : 'a cmp -> 'a list -> 'a list + val min : 'a cmp -> 'a list -> 'a + val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + val cartesians : ('a -> 'b -> 'b) -> 'b -> 'a list list -> 'b list + val combinations : 'a list list -> 'a list list + val cartesians_filter : + ('a -> 'b -> 'b option) -> 'b -> 'a list list -> 'b list + + module Smart : + sig + val map : ('a -> 'a) -> 'a list -> 'a list + end + + module type MonoS = sig + type elt + val equal : elt list -> elt list -> bool + val mem : elt -> elt list -> bool + val assoc : elt -> (elt * 'a) list -> 'a + val mem_assoc : elt -> (elt * 'a) list -> bool + val remove_assoc : elt -> (elt * 'a) list -> (elt * 'a) list + val mem_assoc_sym : elt -> ('a * elt) list -> bool + end + +end + +include List + +(** Tail-rec implementation of usual functions. This is a well-known trick used + in, for instance, ExtLib and Batteries. *) + +type 'a cell = { + head : 'a; + mutable tail : 'a list; +} + +external cast : 'a cell -> 'a list = "%identity" + +(** Extensions and redefinitions of OCaml Stdlib *) + +(** {6 Equality, testing} *) + +let rec same_length l1 l2 = match l1, l2 with +| [], [] -> true +| _ :: l1, _ :: l2 -> same_length l1 l2 +| ([], _ :: _) | (_ :: _, []) -> false + +let rec compare cmp l1 l2 = + if l1 == l2 then 0 else + match l1,l2 with + | [], [] -> 0 + | _::_, [] -> 1 + | [], _::_ -> -1 + | x1::l1, x2::l2 -> + match cmp x1 x2 with + | 0 -> compare cmp l1 l2 + | c -> c + +let rec equal cmp l1 l2 = + l1 == l2 || + match l1, l2 with + | [], [] -> true + | x1 :: l1, x2 :: l2 -> cmp x1 x2 && equal cmp l1 l2 + | _ -> false + +let is_empty = function + | [] -> true + | _ -> false + +let mem_f cmp x l = + List.exists (cmp x) l + +let for_all_i p = + let rec for_all_p i = function + | [] -> true + | a::l -> p i a && for_all_p (i+1) l + in + for_all_p + +let for_all2eq f l1 l2 = + try List.for_all2 f l1 l2 with Invalid_argument _ -> false + +let exists_i p = + let rec exists_p i = function + | [] -> false + | a::l -> p i a || exists_p (i+1) l + in + exists_p + +let prefix_of cmp prefl l = + let rec prefrec = function + | (h1::t1, h2::t2) -> cmp h1 h2 && prefrec (t1,t2) + | ([], _) -> true + | _ -> false + in + prefrec (prefl,l) + +(** {6 Creating lists} *) + +let interval n m = + let rec interval_n (l,m) = + if n > m then l else interval_n (m::l, pred m) + in + interval_n ([], m) + +let addn n v = + let rec aux n l = + if Int.equal n 0 then l + else aux (pred n) (v :: l) + in + if n < 0 then invalid_arg "List.addn" + else aux n + +let make n v = + addn n v [] + +let rec init_loop len f p i = + if Int.equal i len then () + else + let c = { head = f i; tail = [] } in + p.tail <- cast c; + init_loop len f c (succ i) + +let init len f = + if len < 0 then invalid_arg "List.init" + else if Int.equal len 0 then [] + else + let c = { head = f 0; tail = [] } in + init_loop len f c 1; + cast c + +let rec append_loop p tl = function + | [] -> p.tail <- tl + | x :: l -> + let c = { head = x; tail = [] } in + p.tail <- cast c; + append_loop c tl l + +let append l1 l2 = match l1 with + | [] -> l2 + | x :: l -> + let c = { head = x; tail = [] } in + append_loop c l2 l; + cast c + +let rec copy p = function + | [] -> p + | x :: l -> + let c = { head = x; tail = [] } in + p.tail <- cast c; + copy c l + +let rec concat_loop p = function + | [] -> () + | x :: l -> concat_loop (copy p x) l + +let concat l = + let dummy = { head = Obj.magic 0; tail = [] } in + concat_loop dummy l; + dummy.tail + +let flatten = concat + +(** {6 Lists as arrays} *) + +let assign l n e = + let rec assrec stk l i = match l, i with + | (h :: t, 0) -> List.rev_append stk (e :: t) + | (h :: t, n) -> assrec (h :: stk) t (pred n) + | ([], _) -> failwith "List.assign" + in + assrec [] l n + +(** {6 Filtering} *) + +let rec filter_loop f p = function + | [] -> () + | x :: l' as l -> + let b = f x in + filter_loop f p l'; + if b then if p.tail == l' then p.tail <- l else p.tail <- x :: p.tail + +let rec filter f = function + | [] -> [] + | x :: l' as l -> + if f x then + let c = { head = x; tail = [] } in + filter_loop f c l'; + if c.tail == l' then l else cast c + else + filter f l' + +let rec filter2_loop f p q l1 l2 = match l1, l2 with + | [], [] -> () + | x :: l1', y :: l2' -> + let b = f x y in + filter2_loop f p q l1' l2'; + if b then + if p.tail == l1' then begin + p.tail <- l1; + q.tail <- l2 + end + else begin + p.tail <- x :: p.tail; + q.tail <- y :: q.tail + end + | _ -> invalid_arg "List.filter2" + +let rec filter2 f l1 l2 = match l1, l2 with + | [], [] -> ([],[]) + | x1 :: l1', x2 :: l2' -> + let b = f x1 x2 in + if b then + let c1 = { head = x1; tail = [] } in + let c2 = { head = x2; tail = [] } in + filter2_loop f c1 c2 l1' l2'; + if c1.tail == l1' then (l1, l2) else (cast c1, cast c2) + else + filter2 f l1' l2' + | _ -> invalid_arg "List.filter2" + +let filteri p = + let rec filter_i_rec i = function + | [] -> [] + | x :: l -> let l' = filter_i_rec (succ i) l in if p i x then x :: l' else l' + in + filter_i_rec 0 + +let rec filter_with_loop filter p l = match filter, l with + | [], [] -> () + | b :: filter, x :: l' -> + filter_with_loop filter p l'; + if b then if p.tail == l' then p.tail <- l else p.tail <- x :: p.tail + | _ -> invalid_arg "List.filter_with" + +let rec filter_with filter l = match filter, l with + | [], [] -> [] + | b :: filter, x :: l' -> + if b then + let c = { head = x; tail = [] } in + filter_with_loop filter c l'; + if c.tail == l' then l else cast c + else filter_with filter l' + | _ -> invalid_arg "List.filter_with" + +let rec map_filter_loop f p = function + | [] -> () + | x :: l -> + match f x with + | None -> map_filter_loop f p l + | Some y -> + let c = { head = y; tail = [] } in + p.tail <- cast c; + map_filter_loop f c l + +let rec map_filter f = function + | [] -> [] + | x :: l' -> + match f x with + | None -> map_filter f l' + | Some y -> + let c = { head = y; tail = [] } in + map_filter_loop f c l'; + cast c + +let rec map_filter_i_loop f i p = function + | [] -> () + | x :: l -> + match f i x with + | None -> map_filter_i_loop f (succ i) p l + | Some y -> + let c = { head = y; tail = [] } in + p.tail <- cast c; + map_filter_i_loop f (succ i) c l + +let rec map_filter_i_loop' f i = function + | [] -> [] + | x :: l' -> + match f i x with + | None -> map_filter_i_loop' f (succ i) l' + | Some y -> + let c = { head = y; tail = [] } in + map_filter_i_loop f (succ i) c l'; + cast c + +let map_filter_i f l = + map_filter_i_loop' f 0 l + +let partitioni p = + let rec aux i = function + | [] -> [], [] + | x :: l -> + let (l1, l2) = aux (succ i) l in + if p i x then (x :: l1, l2) + else (l1, x :: l2) + in + aux 0 + +(** {6 Applying functorially} *) + +let rec map_loop f p = function + | [] -> () + | x :: l -> + let c = { head = f x; tail = [] } in + p.tail <- cast c; + map_loop f c l + +let map f = function + | [] -> [] + | x :: l -> + let c = { head = f x; tail = [] } in + map_loop f c l; + cast c + +let rec map2_loop f p l1 l2 = match l1, l2 with + | [], [] -> () + | x :: l1, y :: l2 -> + let c = { head = f x y; tail = [] } in + p.tail <- cast c; + map2_loop f c l1 l2 + | _ -> invalid_arg "List.map2" + +let map2 f l1 l2 = match l1, l2 with + | [], [] -> [] + | x :: l1, y :: l2 -> + let c = { head = f x y; tail = [] } in + map2_loop f c l1 l2; + cast c + | _ -> invalid_arg "List.map2" + +(** Like OCaml [List.mapi] but tail-recursive *) + +let rec map_i_loop f i p = function + | [] -> () + | x :: l -> + let c = { head = f i x; tail = [] } in + p.tail <- cast c; + map_i_loop f (succ i) c l + +let map_i f i = function + | [] -> [] + | x :: l -> + let c = { head = f i x; tail = [] } in + map_i_loop f (succ i) c l; + cast c + +let map_left = map + +let map2_i f i l1 l2 = + let rec map_i i = function + | ([], []) -> [] + | (h1 :: t1, h2 :: t2) -> let v = f i h1 h2 in v :: map_i (succ i) (t1,t2) + | (_, _) -> invalid_arg "map2_i" + in + map_i i (l1,l2) + +let rec map3_loop f p l1 l2 l3 = match l1, l2, l3 with + | [], [], [] -> () + | x :: l1, y :: l2, z :: l3 -> + let c = { head = f x y z; tail = [] } in + p.tail <- cast c; + map3_loop f c l1 l2 l3 + | _ -> invalid_arg "List.map3" + +let map3 f l1 l2 l3 = match l1, l2, l3 with + | [], [], [] -> [] + | x :: l1, y :: l2, z :: l3 -> + let c = { head = f x y z; tail = [] } in + map3_loop f c l1 l2 l3; + cast c + | _ -> invalid_arg "List.map3" + +let rec map4_loop f p l1 l2 l3 l4 = match l1, l2, l3, l4 with + | [], [], [], [] -> () + | x :: l1, y :: l2, z :: l3, t :: l4 -> + let c = { head = f x y z t; tail = [] } in + p.tail <- cast c; + map4_loop f c l1 l2 l3 l4 + | _ -> invalid_arg "List.map4" + +let map4 f l1 l2 l3 l4 = match l1, l2, l3, l4 with + | [], [], [], [] -> [] + | x :: l1, y :: l2, z :: l3, t :: l4 -> + let c = { head = f x y z t; tail = [] } in + map4_loop f c l1 l2 l3 l4; + cast c + | _ -> invalid_arg "List.map4" + +let rec map_of_array_loop f p a i l = + if Int.equal i l then () + else + let c = { head = f (Array.unsafe_get a i); tail = [] } in + p.tail <- cast c; + map_of_array_loop f c a (i + 1) l + +let map_of_array f a = + let l = Array.length a in + if Int.equal l 0 then [] + else + let c = { head = f (Array.unsafe_get a 0); tail = [] } in + map_of_array_loop f c a 1 l; + cast c + +let map_append f l = flatten (map f l) + +let map_append2 f l1 l2 = flatten (map2 f l1 l2) + +let rec extend l a l' = match l,l' with + | true :: l, b :: l' -> b :: extend l a l' + | false :: l, l' -> a :: extend l a l' + | [], [] -> [] + | _ -> invalid_arg "extend" + +let count f l = + let rec aux acc = function + | [] -> acc + | h :: t -> if f h then aux (acc + 1) t else aux acc t + in + aux 0 l + +(** {6 Finding position} *) + +let rec index_f f x l n = match l with + | [] -> raise Not_found + | y :: l -> if f x y then n else index_f f x l (succ n) + +let index f x l = index_f f x l 1 + +let safe_index f x l = try Some (index f x l) with Not_found -> None + +let index0 f x l = index_f f x l 0 + +(** {6 Folding} *) + +let fold_left_until f accu s = + let rec aux accu = function + | [] -> accu + | x :: xs -> match f accu x with CSig.Stop x -> x | CSig.Cont i -> aux i xs + in + aux accu s + +let fold_right_i f i l = + let rec it_f i l a = match l with + | [] -> a + | b :: l -> f (i-1) b (it_f (i-1) l a) + in + it_f (List.length l + i) l + +let fold_left_i f = + let rec it_list_f i a = function + | [] -> a + | b :: l -> it_list_f (i+1) (f i a b) l + in + it_list_f + +let rec fold_left3 f accu l1 l2 l3 = + match (l1, l2, l3) with + | ([], [], []) -> accu + | (a1 :: l1, a2 :: l2, a3 :: l3) -> fold_left3 f (f accu a1 a2 a3) l1 l2 l3 + | (_, _, _) -> invalid_arg "List.fold_left3" + +let rec fold_left4 f accu l1 l2 l3 l4 = + match (l1, l2, l3, l4) with + | ([], [], [], []) -> accu + | (a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4) -> fold_left4 f (f accu a1 a2 a3 a4) l1 l2 l3 l4 + | (_,_, _, _) -> invalid_arg "List.fold_left4" + +(* [fold_right_and_left f [a1;...;an] hd = + f (f (... (f (f hd + an + [an-1;...;a1]) + an-1 + [an-2;...;a1]) + ...) + a2 + [a1]) + a1 + []] *) + +let fold_right_and_left f l hd = + let rec aux tl = function + | [] -> hd + | a :: l -> let hd = aux (a :: tl) l in f hd a tl + in + aux [] l + +(* Match sets as lists according to a matching function, also folding a side effect *) +let rec fold_left2_set e f x l1 l2 = + match l1 with + | a1 :: l1 -> + let rec find seen = function + | [] -> raise e + | a2 :: l2 -> + try fold_left2_set e f (f x a1 a2 l1 l2) l1 (List.rev_append seen l2) + with e' when e' = e -> find (a2 :: seen) l2 in + find [] l2 + | [] -> + if l2 = [] then x else raise e + +(* Poor man's monadic map *) +let rec fold_left_map f e = function + | [] -> (e,[]) + | h :: t -> + let e',h' = f e h in + let e'',t' = fold_left_map f e' t in + e'',h' :: t' + +(* (* tail-recursive version of the above function *) +let fold_left_map f e l = + let g (e,b') h = + let (e',h') = f e h in + (e',h'::b') + in + let (e',lrev) = List.fold_left g (e,[]) l in + (e',List.rev lrev) +*) + +(* The same, based on fold_right, with the effect accumulated on the right *) +let fold_right_map f l e = + List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e) + +let on_snd f (x,y) = (x,f y) + +let fold_left2_map f e l l' = + on_snd List.rev @@ + List.fold_left2 (fun (e,l) x x' -> + let (e,y) = f e x x' in + (e, y::l) + ) (e, []) l l' + +let fold_right2_map f l l' e = + List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e) + +let fold_left3_map f e l l' l'' = + on_snd List.rev @@ + fold_left3 (fun (e,l) x x' x'' -> let (e,y) = f e x x' x'' in (e,y::l)) (e,[]) l l' l'' + +let fold_left4_map f e l1 l2 l3 l4 = + on_snd List.rev @@ + fold_left4 (fun (e,l) x1 x2 x3 x4 -> let (e,y) = f e x1 x2 x3 x4 in (e,y::l)) (e,[]) l1 l2 l3 l4 + +(** {6 Splitting} *) + +let except cmp x l = + List.filter (fun y -> not (cmp x y)) l + +let remove = except (* Alias *) + +let rec remove_first p = function + | b :: l when p b -> l + | b :: l -> b :: remove_first p l + | [] -> raise Not_found + +let extract_first p li = + let rec loop rev_left = function + | [] -> raise Not_found + | x :: right -> + if p x then List.rev_append rev_left right, x + else loop (x :: rev_left) right + in + loop [] li + +let insert p v l = + let rec insrec = function + | [] -> [v] + | h :: tl -> if p v h then v :: h :: tl else h :: insrec tl + in + insrec l + +let rec find_map f = function + | [] -> raise Not_found + | x :: l -> + match f x with + | None -> find_map f l + | Some y -> y + +(* FIXME: again, generic hash function *) + +let subset l1 l2 = + let t2 = Hashtbl.create 151 in + List.iter (fun x -> Hashtbl.add t2 x ()) l2; + let rec look = function + | [] -> true + | x :: ll -> try Hashtbl.find t2 x; look ll with Not_found -> false + in + look l1 + +(** [goto i l] splits [l] into two lists [(l1,l2)] such that + [(List.rev l1)++l2=l] and [l1] has length [i]. It raises + [IndexOutOfRange] when [i] is negative or greater than the + length of [l]. *) +exception IndexOutOfRange +let goto n l = + let rec goto i acc = function + | tl when Int.equal i 0 -> (acc, tl) + | h :: t -> goto (pred i) (h :: acc) t + | [] -> raise IndexOutOfRange + in + goto n [] l + +(* [chop i l] splits [l] into two lists [(l1,l2)] such that + [l1++l2=l] and [l1] has length [i]. + It raises [Failure] when [i] is negative or greater than the length of [l] *) + +let chop n l = + try let (h,t) = goto n l in (List.rev h,t) + with IndexOutOfRange -> failwith "List.chop" + (* spiwack: should raise [IndexOutOfRange] but I'm afraid of missing + a try/with when replacing the exception. *) + +(* [split_when p l] splits [l] into two lists [(l1,a::l2)] such that + [l1++(a::l2)=l], [p a=true] and [p b = false] for every element [b] of [l1]. + If there is no such [a], then it returns [(l,[])] instead *) +let split_when p = + let rec split_when_loop x y = + match y with + | [] -> (List.rev x,[]) + | (a :: l) -> if (p a) then (List.rev x,y) else split_when_loop (a :: x) l + in + split_when_loop [] + +let firstn n l = + let rec aux acc n l = + match n, l with + | 0, _ -> List.rev acc + | n, h :: t -> aux (h :: acc) (pred n) t + | _ -> failwith "firstn" + in + aux [] n l + +let rec sep_last = function + | [] -> failwith "sep_last" + | hd :: [] -> (hd,[]) + | hd :: tl -> let (l,tl) = sep_last tl in (l,hd :: tl) + +(* Drop the last element of a list *) + +let rec drop_last = function + | [] -> failwith "drop_last" + | hd :: [] -> [] + | hd :: tl -> hd :: drop_last tl + +let rec last = function + | [] -> failwith "List.last" + | hd :: [] -> hd + | _ :: tl -> last tl + +let lastn n l = + let len = List.length l in + let rec aux m l = + if Int.equal m n then l else aux (m - 1) (List.tl l) + in + if len < n then failwith "lastn" else aux len l + +let rec skipn n l = match n,l with + | 0, _ -> l + | _, [] -> failwith "List.skipn" + | n, _ :: l -> skipn (pred n) l + +let skipn_at_least n l = + try skipn n l with Failure _ when n >= 0 -> [] + +(** if [l=p++t] then [drop_prefix p l] is [t] else [l] *) + +let drop_prefix cmp p l = + let rec drop_prefix_rec = function + | (h1 :: tp, h2 :: tl) when cmp h1 h2 -> drop_prefix_rec (tp,tl) + | ([], tl) -> tl + | _ -> l + in + drop_prefix_rec (p,l) + +let share_tails l1 l2 = + let rec shr_rev acc = function + | (x1 :: l1, x2 :: l2) when x1 == x2 -> shr_rev (x1 :: acc) (l1,l2) + | (l1, l2) -> (List.rev l1, List.rev l2, acc) + in + shr_rev [] (List.rev l1, List.rev l2) + +(** {6 Association lists} *) + +let map_assoc f = map (fun (x,a) -> (x,f a)) + +let rec assoc_f f a = function + | (x, e) :: xs -> if f a x then e else assoc_f f a xs + | [] -> raise Not_found + +let remove_assoc_f f a l = + try remove_first (fun (x,_) -> f a x) l with Not_found -> l + +let mem_assoc_f f a l = List.exists (fun (x,_) -> f a x) l + +(** {6 Operations on lists of tuples} *) + +let rec split_loop p q = function + | [] -> () + | (x, y) :: l -> + let cl = { head = x; tail = [] } in + let cr = { head = y; tail = [] } in + p.tail <- cast cl; + q.tail <- cast cr; + split_loop cl cr l + +let split = function + | [] -> [], [] + | (x, y) :: l -> + let cl = { head = x; tail = [] } in + let cr = { head = y; tail = [] } in + split_loop cl cr l; + (cast cl, cast cr) + +let rec combine_loop p l1 l2 = match l1, l2 with + | [], [] -> () + | x :: l1, y :: l2 -> + let c = { head = (x, y); tail = [] } in + p.tail <- cast c; + combine_loop c l1 l2 + | _ -> invalid_arg "List.combine" + +let combine l1 l2 = match l1, l2 with + | [], [] -> [] + | x :: l1, y :: l2 -> + let c = { head = (x, y); tail = [] } in + combine_loop c l1 l2; + cast c + | _ -> invalid_arg "List.combine" + +let rec split3_loop p q r = function + | [] -> () + | (x, y, z) :: l -> + let cp = { head = x; tail = [] } in + let cq = { head = y; tail = [] } in + let cr = { head = z; tail = [] } in + p.tail <- cast cp; + q.tail <- cast cq; + r.tail <- cast cr; + split3_loop cp cq cr l + +let split3 = function + | [] -> [], [], [] + | (x, y, z) :: l -> + let cp = { head = x; tail = [] } in + let cq = { head = y; tail = [] } in + let cr = { head = z; tail = [] } in + split3_loop cp cq cr l; + (cast cp, cast cq, cast cr) + +(** XXX TODO tailrec *) +let rec split4 = function + | [] -> ([], [], [], []) + | (a,b,c,d)::l -> + let (ra, rb, rc, rd) = split4 l in (a::ra, b::rb, c::rc, d::rd) + +let rec combine3_loop p l1 l2 l3 = match l1, l2, l3 with + | [], [], [] -> () + | x :: l1, y :: l2, z :: l3 -> + let c = { head = (x, y, z); tail = [] } in + p.tail <- cast c; + combine3_loop c l1 l2 l3 + | _ -> invalid_arg "List.combine3" + +let combine3 l1 l2 l3 = match l1, l2, l3 with + | [], [], [] -> [] + | x :: l1, y :: l2, z :: l3 -> + let c = { head = (x, y, z); tail = [] } in + combine3_loop c l1 l2 l3; + cast c + | _ -> invalid_arg "List.combine3" + +(** {6 Operations on lists seen as sets, preserving uniqueness of elements} *) + +(** Add an element, preserving uniqueness of elements *) + +let add_set cmp x l = + if mem_f cmp x l then l else x :: l + +(** List equality up to permutation (but considering multiple occurrences) *) + +let eq_set cmp l1 l2 = + let rec aux l1 = function + | [] -> is_empty l1 + | a :: l2 -> aux (remove_first (cmp a) l1) l2 + in + try aux l1 l2 with Not_found -> false + +let rec merge_set cmp l1 l2 = match l1, l2 with + | [], l2 -> l2 + | l1, [] -> l1 + | h1 :: t1, h2 :: t2 -> + let c = cmp h1 h2 in + if Int.equal c 0 + then h1 :: merge_set cmp t1 t2 + else if c <= 0 + then h1 :: merge_set cmp t1 l2 + else h2 :: merge_set cmp l1 t2 + +let intersect cmp l1 l2 = + filter (fun x -> mem_f cmp x l2) l1 + +let union cmp l1 l2 = + let rec urec = function + | [] -> l2 + | a :: l -> if mem_f cmp a l2 then urec l else a :: urec l + in + urec l1 + +let subtract cmp l1 l2 = + if is_empty l2 then l1 + else List.filter (fun x -> not (mem_f cmp x l2)) l1 + +let unionq l1 l2 = union (==) l1 l2 +let subtractq l1 l2 = subtract (==) l1 l2 + +(** {6 Uniqueness and duplication} *) + +(* FIXME: we should avoid relying on the generic hash function, + just as we'd better avoid Pervasives.compare *) + +let distinct l = + let visited = Hashtbl.create 23 in + let rec loop = function + | h :: t -> + if Hashtbl.mem visited h then false + else + begin + Hashtbl.add visited h h; + loop t + end + | [] -> true + in + loop l + +let distinct_f cmp l = + let rec loop = function + | a :: b :: _ when Int.equal (cmp a b) 0 -> false + | a :: l -> loop l + | [] -> true + in loop (List.sort cmp l) + +(* FIXME: again, generic hash function *) + +let uniquize_key f l = + let visited = Hashtbl.create 23 in + let rec aux acc changed = function + | h :: t -> + let x = f h in + if Hashtbl.mem visited x then aux acc true t else + begin + Hashtbl.add visited x x; + aux (h :: acc) changed t + end + | [] -> if changed then List.rev acc else l + in + aux [] false l + +let uniquize l = uniquize_key (fun x -> x) l + +(** [sort_uniquize] might be an alternative to the hashtbl-based + [uniquize], when the order of the elements is irrelevant *) + +let rec uniquize_sorted cmp = function + | a :: b :: l when Int.equal (cmp a b) 0 -> uniquize_sorted cmp (a :: l) + | a :: l -> a :: uniquize_sorted cmp l + | [] -> [] + +let sort_uniquize cmp l = + uniquize_sorted cmp (List.sort cmp l) + +let min cmp l = + let rec aux cur = function + | [] -> cur + | x :: l -> if cmp x cur < 0 then aux x l else aux cur l + in + match l with + | x :: l -> aux x l + | [] -> raise Not_found + +let rec duplicates cmp = function + | [] -> [] + | x :: l -> + let l' = duplicates cmp l in + if mem_f cmp x l then add_set cmp x l' else l' + +(** {6 Cartesian product} *) + +(* A generic cartesian product: for any operator (**), + [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]], + and so on if there are more elements in the lists. *) + +let cartesian op l1 l2 = + map_append (fun x -> map (op x) l2) l1 + +(* [cartesians] is an n-ary cartesian product: it iterates + [cartesian] over a list of lists. *) + +let cartesians op init ll = + List.fold_right (cartesian op) ll [init] + +(* combinations [[a;b];[c;d]] gives [[a;c];[a;d];[b;c];[b;d]] *) + +let combinations l = + cartesians (fun x l -> x :: l) [] l + +(* Keep only those products that do not return None *) + +let cartesian_filter op l1 l2 = + map_append (fun x -> map_filter (op x) l2) l1 + +(* Keep only those products that do not return None *) + +let cartesians_filter op init ll = + List.fold_right (cartesian_filter op) ll [init] + +(* Factorize lists of pairs according to the left argument *) +let rec factorize_left cmp = function + | (a,b) :: l -> + let al,l' = partition (fun (a',_) -> cmp a a') l in + (a,(b :: map snd al)) :: factorize_left cmp l' + | [] -> [] + +module Smart = +struct + + let rec map f l = match l with + | [] -> l + | h :: tl -> + let h' = f h in + let tl' = map f tl in + if h' == h && tl' == tl then l else h' :: tl' + +end + +module type MonoS = sig + type elt + val equal : elt list -> elt list -> bool + val mem : elt -> elt list -> bool + val assoc : elt -> (elt * 'a) list -> 'a + val mem_assoc : elt -> (elt * 'a) list -> bool + val remove_assoc : elt -> (elt * 'a) list -> (elt * 'a) list + val mem_assoc_sym : elt -> ('a * elt) list -> bool +end diff -Nru coq-doc-8.6/clib/cList.mli coq-doc-8.15.0/clib/cList.mli --- coq-doc-8.6/clib/cList.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cList.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,428 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* int +type 'a eq = 'a -> 'a -> bool + +(** Module type [S] is the one from OCaml Stdlib. *) +module type S = module type of List + +module type ExtS = +sig + include S + + (** {6 Equality, testing} *) + + val compare : 'a cmp -> 'a list cmp + (** Lexicographic order on lists. *) + + val equal : 'a eq -> 'a list eq + (** Lift equality to list type. *) + + val is_empty : 'a list -> bool + (** Check whether a list is empty *) + + val mem_f : 'a eq -> 'a -> 'a list -> bool + (** Same as [List.mem], for some specific equality *) + + val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool + (** Same as [List.for_all] but with an index *) + + val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool + (** Same as [List.for_all2] but returning [false] when of different length *) + + val exists_i : (int -> 'a -> bool) -> int -> 'a list -> bool + (** Same as [List.exists] but with an index *) + + val prefix_of : 'a eq -> 'a list eq + (** [prefix_of eq l1 l2] returns [true] if [l1] is a prefix of [l2], [false] + otherwise. It uses [eq] to compare elements *) + + val same_length : 'a list -> 'b list -> bool + (** A more efficient variant of [for_all2eq (fun _ _ -> true)] *) + + (** {6 Creating lists} *) + + val interval : int -> int -> int list + (** [interval i j] creates the list [[i; i + 1; ...; j]], or [[]] when + [j <= i]. *) + + val make : int -> 'a -> 'a list + (** [make n x] returns a list made of [n] times [x]. Raise + [Invalid_argument _] if [n] is negative. *) + + val addn : int -> 'a -> 'a list -> 'a list + (** [addn n x l] adds [n] times [x] on the left of [l]. *) + + val init : int -> (int -> 'a) -> 'a list + (** [init n f] constructs the list [f 0; ... ; f (n - 1)]. Raise + [Invalid_argument _] if [n] is negative *) + + val append : 'a list -> 'a list -> 'a list + (** Like OCaml's [List.append] but tail-recursive. *) + + val concat : 'a list list -> 'a list + (** Like OCaml's [List.concat] but tail-recursive. *) + + val flatten : 'a list list -> 'a list + (** Synonymous of [concat] *) + + (** {6 Lists as arrays} *) + + val assign : 'a list -> int -> 'a -> 'a list + (** [assign l i x] sets the [i]-th element of [l] to [x], starting + from [0]. Raise [Failure _] if [i] is out of range. *) + + (** {6 Filtering} *) + + val filter : ('a -> bool) -> 'a list -> 'a list + (** Like OCaml [List.filter] but tail-recursive and physically returns + the original list if the predicate holds for all elements. *) + + val filter2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list + (** Like [List.filter] but with 2 arguments, raise [Invalid_argument _] + if the lists are not of same length. *) + + val filteri : (int -> 'a -> bool) -> 'a list -> 'a list + (** Like [List.filter] but with an index starting from [0] *) + + val filter_with : bool list -> 'a list -> 'a list + (** [filter_with bl l] selects elements of [l] whose corresponding element in + [bl] is [true]. Raise [Invalid_argument _] if sizes differ. *) + + val map_filter : ('a -> 'b option) -> 'a list -> 'b list + (** Like [map] but keeping only non-[None] elements *) + + val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list + (** Like [map_filter] but with an index starting from [0] *) + + val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list + (** Like [List.partition] but with an index starting from [0] *) + + (** {6 Applying functorially} *) + + val map : ('a -> 'b) -> 'a list -> 'b list + (** Like OCaml [List.map] but tail-recursive *) + + val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + (** Like OCaml [List.map2] but tail-recursive *) + + val map_left : ('a -> 'b) -> 'a list -> 'b list + (** As [map] but ensures the left-to-right order of evaluation. *) + + val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list + (** Like OCaml [List.mapi] but tail-recursive. Alternatively, like + [map] but with an index *) + + val map2_i : + (int -> 'a -> 'b -> 'c) -> int -> 'a list -> 'b list -> 'c list + (** Like [map2] but with an index *) + + val map3 : + ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list + (** Like [map] but for 3 lists. *) + + val map4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list -> + 'd list -> 'e list + (** Like [map] but for 4 lists. *) + + val map_of_array : ('a -> 'b) -> 'a array -> 'b list + (** [map_of_array f a] behaves as [List.map f (Array.to_list a)] *) + + val map_append : ('a -> 'b list) -> 'a list -> 'b list + (** [map_append f [x1; ...; xn]] returns [f x1 @ ... @ f xn]. *) + + val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list + (** Like [map_append] but for two lists; raises [Invalid_argument _] + if the two lists do not have the same length. *) + + val extend : bool list -> 'a -> 'a list -> 'a list + (** [extend l a [a1..an]] assumes that the number of [true] in [l] is [n]; + it extends [a1..an] by inserting [a] at the position of [false] in [l] *) + + val count : ('a -> bool) -> 'a list -> int + (** Count the number of elements satisfying a predicate *) + + (** {6 Finding position} *) + + val index : 'a eq -> 'a -> 'a list -> int + (** [index] returns the 1st index of an element in a list (counting from 1). *) + + val safe_index : 'a eq -> 'a -> 'a list -> int option + (** [safe_index] returns the 1st index of an element in a list (counting from 1) + and None otherwise. *) + + val index0 : 'a eq -> 'a -> 'a list -> int + (** [index0] behaves as [index] except that it starts counting at 0. *) + + (** {6 Folding} *) + + val fold_left_until : ('c -> 'a -> 'c CSig.until) -> 'c -> 'a list -> 'c + (** acts like [fold_left f acc s] while [f] returns + [Cont acc']; it stops returning [c] as soon as [f] returns [Stop c]. *) + + val fold_right_i : (int -> 'a -> 'b -> 'b) -> int -> 'a list -> 'b -> 'b + (** Like [List.fold_right] but with an index *) + + val fold_left_i : (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a + (** Like [List.fold_left] but with an index *) + + val fold_right_and_left : ('b -> 'a -> 'a list -> 'b) -> 'a list -> 'b -> 'b + (** [fold_right_and_left f [a1;...;an] hd] is + [f (f (... (f (f hd an [an-1;...;a1]) an-1 [an-2;...;a1]) ...) a2 [a1]) a1 []] *) + + val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a + (** Like [List.fold_left] but for 3 lists; raise [Invalid_argument _] if + not all lists of the same size *) + + val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a + (** Fold sets, i.e. lists up to order; the folding function tells + when elements match by returning a value and raising the given + exception otherwise; sets should have the same size; raise the + given exception if no pairing of the two sets is found;; + complexity in O(n^2) *) + + val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list + (** [fold_left_map f e_0 [a1;...;an]] is [e_n,[k_1...k_n]] + where [(e_i,k_i)] is [f e_{i-1} ai] for each i<=n *) + + val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a + (** Same, folding on the right *) + + val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list + (** Same with two lists, folding on the left *) + + val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a + (** Same with two lists, folding on the right *) + + val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list + (** Same with three lists, folding on the left *) + + val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list + (** Same with four lists, folding on the left *) + + (** {6 Splitting} *) + + val except : 'a eq -> 'a -> 'a list -> 'a list + (** [except eq a l] Remove all occurrences of [a] in [l] *) + + val remove : 'a eq -> 'a -> 'a list -> 'a list + (** Alias of [except] *) + + val remove_first : ('a -> bool) -> 'a list -> 'a list + (** Remove the first element satisfying a predicate, or raise [Not_found] *) + + val extract_first : ('a -> bool) -> 'a list -> 'a list * 'a + (** Remove and return the first element satisfying a predicate, + or raise [Not_found] *) + + val find_map : ('a -> 'b option) -> 'a list -> 'b + (** Returns the first element that is mapped to [Some _]. Raise [Not_found] if + there is none. *) + + exception IndexOutOfRange + val goto: int -> 'a list -> 'a list * 'a list + (** [goto i l] splits [l] into two lists [(l1,l2)] such that + [(List.rev l1)++l2=l] and [l1] has length [i]. It raises + [IndexOutOfRange] when [i] is negative or greater than the + length of [l]. *) + + val split_when : ('a -> bool) -> 'a list -> 'a list * 'a list + (** [split_when p l] splits [l] into two lists [(l1,a::l2)] such that + [l1++(a::l2)=l], [p a=true] and [p b = false] for every element [b] of [l1]. + if there is no such [a], then it returns [(l,[])] instead. *) + + val sep_last : 'a list -> 'a * 'a list + (** [sep_last l] returns [(a,l')] such that [l] is [l'@[a]]. + It raises [Failure _] if the list is empty. *) + + val drop_last : 'a list -> 'a list + (** Remove the last element of the list. It raises [Failure _] if the + list is empty. This is the second part of [sep_last]. *) + + val last : 'a list -> 'a + (** Return the last element of the list. It raises [Failure _] if the + list is empty. This is the first part of [sep_last]. *) + + val lastn : int -> 'a list -> 'a list + (** [lastn n l] returns the [n] last elements of [l]. It raises + [Failure _] if [n] is less than 0 or larger than the length of [l] *) + + val chop : int -> 'a list -> 'a list * 'a list + (** [chop i l] splits [l] into two lists [(l1,l2)] such that + [l1++l2=l] and [l1] has length [i]. It raises [Failure _] when + [i] is negative or greater than the length of [l]. *) + + val firstn : int -> 'a list -> 'a list + (** [firstn n l] Returns the [n] first elements of [l]. It raises + [Failure _] if [n] negative or too large. This is the first part + of [chop]. *) + + val skipn : int -> 'a list -> 'a list + (** [skipn n l] drops the [n] first elements of [l]. It raises + [Failure _] if [n] is less than 0 or larger than the length of [l]. + This is the second part of [chop]. *) + + val skipn_at_least : int -> 'a list -> 'a list + (** Same as [skipn] but returns [] if [n] is larger than the length of + the list. *) + + val drop_prefix : 'a eq -> 'a list -> 'a list -> 'a list + (** [drop_prefix eq l1 l] returns [l2] if [l=l1++l2] else return [l]. *) + + val insert : 'a eq -> 'a -> 'a list -> 'a list + (** Insert at the (first) position so that if the list is ordered wrt to the + total order given as argument, the order is preserved *) + + val share_tails : 'a list -> 'a list -> 'a list * 'a list * 'a list + (** [share_tails l1 l2] returns [(l1',l2',l)] such that [l1] is + [l1'\@l] and [l2] is [l2'\@l] and [l] is maximal amongst all such + decompositions *) + + (** {6 Association lists} *) + + val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list + (** Applies a function on the codomain of an association list *) + + val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b + (** Like [List.assoc] but using the equality given as argument *) + + val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list + (** Remove first matching element; unchanged if no such element *) + + val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool + (** Like [List.mem_assoc] but using the equality given as argument *) + + val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list + (** Create a list of associations from a list of pairs *) + + (** {6 Operations on lists of tuples} *) + + val split : ('a * 'b) list -> 'a list * 'b list + (** Like OCaml's [List.split] but tail-recursive. *) + + val combine : 'a list -> 'b list -> ('a * 'b) list + (** Like OCaml's [List.combine] but tail-recursive. *) + + val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list + (** Like [split] but for triples *) + + val split4 : ('a * 'b * 'c * 'd) list -> 'a list * 'b list * 'c list * 'd list + (** Like [split] but for quads *) + + val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list + (** Like [combine] but for triples *) + + (** {6 Operations on lists seen as sets, preserving uniqueness of elements} *) + + val add_set : 'a eq -> 'a -> 'a list -> 'a list + (** [add_set x l] adds [x] in [l] if it is not already there, or returns [l] + otherwise. *) + + val eq_set : 'a eq -> 'a list eq + (** Test equality up to permutation. It respects multiple occurrences + and thus works also on multisets. *) + + val subset : 'a list eq + (** Tell if a list is a subset of another up to permutation. It expects + each element to occur only once. *) + + val merge_set : 'a cmp -> 'a list -> 'a list -> 'a list + (** Merge two sorted lists and preserves the uniqueness property. *) + + val intersect : 'a eq -> 'a list -> 'a list -> 'a list + (** Return the intersection of two lists, assuming and preserving + uniqueness of elements *) + + val union : 'a eq -> 'a list -> 'a list -> 'a list + (** Return the union of two lists, assuming and preserving + uniqueness of elements *) + + val unionq : 'a list -> 'a list -> 'a list + (** [union] specialized to physical equality *) + + val subtract : 'a eq -> 'a list -> 'a list -> 'a list + (** Remove from the first list all elements from the second list. *) + + val subtractq : 'a list -> 'a list -> 'a list + (** [subtract] specialized to physical equality *) + + (** {6 Uniqueness and duplication} *) + + val distinct : 'a list -> bool + (** Return [true] if all elements of the list are distinct. *) + + val distinct_f : 'a cmp -> 'a list -> bool + (** Like [distinct] but using the equality given as argument *) + + val duplicates : 'a eq -> 'a list -> 'a list + (** Return the list of unique elements which appear at least twice. Elements + are kept in the order of their first appearance. *) + + val uniquize_key : ('a -> 'b) -> 'a list -> 'a list + (** Return the list of elements without duplicates using the + function to associate a comparison key to each element. + This is the list unchanged if there was none. *) + + val uniquize : 'a list -> 'a list + (** Return the list of elements without duplicates. + This is the list unchanged if there was none. *) + + val sort_uniquize : 'a cmp -> 'a list -> 'a list + (** Return a sorted version of a list without duplicates + according to some comparison function. *) + + val min : 'a cmp -> 'a list -> 'a + (** Return minimum element according to some comparison function. + + @raise Not_found on an empty list. *) + + (** {6 Cartesian product} *) + + val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list + (** A generic binary cartesian product: for any operator (**), + [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]], + and so on if there are more elements in the lists. *) + + val cartesians : ('a -> 'b -> 'b) -> 'b -> 'a list list -> 'b list + (** [cartesians op init l] is an n-ary cartesian product: it builds + the list of all [op a1 .. (op an init) ..] for [a1], ..., [an] in + the product of the elements of the lists *) + + val combinations : 'a list list -> 'a list list + (** [combinations l] returns the list of [n_1] * ... * [n_p] tuples + [[a11;...;ap1];...;[a1n_1;...;apn_pd]] whenever [l] is a list + [[a11;..;a1n_1];...;[ap1;apn_p]]; otherwise said, it is + [cartesians (::) [] l] *) + + val cartesians_filter : + ('a -> 'b -> 'b option) -> 'b -> 'a list list -> 'b list + (** Like [cartesians op init l] but keep only the tuples for which + [op] returns [Some _] on all the elements of the tuple. *) + + module Smart : + sig + val map : ('a -> 'a) -> 'a list -> 'a list + (** [Smart.map f [a1...an] = List.map f [a1...an]] but if for all i + [f ai == ai], then [Smart.map f l == l] *) + end + + module type MonoS = sig + type elt + val equal : elt list -> elt list -> bool + val mem : elt -> elt list -> bool + val assoc : elt -> (elt * 'a) list -> 'a + val mem_assoc : elt -> (elt * 'a) list -> bool + val remove_assoc : elt -> (elt * 'a) list -> (elt * 'a) list + val mem_assoc_sym : elt -> ('a * elt) list -> bool + end +end + +include ExtS diff -Nru coq-doc-8.6/clib/cMap.ml coq-doc-8.15.0/clib/cMap.ml --- coq-doc-8.6/clib/cMap.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cMap.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,336 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module type MonadS = +sig + type +'a t + val return : 'a -> 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +module type S = Map.S + +module type ExtS = +sig + include CSig.MapS + module Set : CSig.SetS with type elt = key + val get : key -> 'a t -> 'a + val set : key -> 'a -> 'a t -> 'a t + val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t + val domain : 'a t -> Set.t + val bind : (key -> 'a) -> Set.t -> 'a t + val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val height : 'a t -> int + val filter_range : (key -> int) -> 'a t -> 'a t + val update: key -> ('a option -> 'a option) -> 'a t -> 'a t + module Smart : + sig + val map : ('a -> 'a) -> 'a t -> 'a t + val mapi : (key -> 'a -> 'a) -> 'a t -> 'a t + end + module Unsafe : + sig + val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t + end + module Monad(M : MonadS) : + sig + val fold : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t + val fold_left : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t + val fold_right : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t + end +end + +module MapExt (M : Map.OrderedType) : +sig + type 'a map = 'a Map.Make(M).t + val set : M.t -> 'a -> 'a map -> 'a map + val get : M.t -> 'a map -> 'a + val modify : M.t -> (M.t -> 'a -> 'a) -> 'a map -> 'a map + val domain : 'a map -> Set.Make(M).t + val bind : (M.t -> 'a) -> Set.Make(M).t -> 'a map + val fold_left : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b + val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b + val height : 'a map -> int + val filter_range : (M.t -> int) -> 'a map -> 'a map + val update: M.t -> ('a option -> 'a option) -> 'a map -> 'a map + module Smart : + sig + val map : ('a -> 'a) -> 'a map -> 'a map + val mapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map + end + module Unsafe : + sig + val map : (M.t -> 'a -> M.t * 'b) -> 'a map -> 'b map + end + module Monad(MS : MonadS) : + sig + val fold : (M.t -> 'a -> 'b -> 'b MS.t) -> 'a map -> 'b -> 'b MS.t + val fold_left : (M.t -> 'a -> 'b -> 'b MS.t) -> 'a map -> 'b -> 'b MS.t + val fold_right : (M.t -> 'a -> 'b -> 'b MS.t) -> 'a map -> 'b -> 'b MS.t + end +end = +struct + (** This unsafe module is a way to access to the actual implementations of + OCaml sets and maps without reimplementing them ourselves. It is quite + dubious that these implementations will ever be changed... Nonetheless, + if this happens, we can still implement a less clever version of [domain]. + *) + + module F = Map.Make(M) + type 'a map = 'a F.t + + module S = Set.Make(M) + type set = S.t + + type 'a _map = + | MEmpty + | MNode of {l:'a map; v:F.key; d:'a; r:'a map; h:int} + + type _set = + | SEmpty + | SNode of set * M.t * set * int + + let map_prj : 'a map -> 'a _map = Obj.magic + let map_inj : 'a _map -> 'a map = Obj.magic + let set_prj : set -> _set = Obj.magic + let set_inj : _set -> set = Obj.magic + + let rec set k v (s : 'a map) : 'a map = match map_prj s with + | MEmpty -> raise Not_found + | MNode {l; v=k'; d=v'; r; h} -> + let c = M.compare k k' in + if c < 0 then + let l' = set k v l in + if l == l' then s + else map_inj (MNode {l=l'; v=k'; d=v'; r; h}) + else if c = 0 then + if v' == v then s + else map_inj (MNode {l; v=k'; d=v; r; h}) + else + let r' = set k v r in + if r == r' then s + else map_inj (MNode {l; v=k'; d=v'; r=r'; h}) + + let rec get k (s:'a map) : 'a = match map_prj s with + | MEmpty -> assert false + | MNode {l; v=k'; d=v; r; h} -> + let c = M.compare k k' in + if c < 0 then get k l + else if c = 0 then v + else get k r + + let rec modify k f (s : 'a map) : 'a map = match map_prj s with + | MEmpty -> raise Not_found + | MNode {l; v; d; r; h} -> + let c = M.compare k v in + if c < 0 then + let l' = modify k f l in + if l == l' then s + else map_inj (MNode {l=l'; v; d; r; h}) + else if c = 0 then + let d' = f v d in + if d' == d then s + else map_inj (MNode {l; v; d=d'; r; h}) + else + let r' = modify k f r in + if r == r' then s + else map_inj (MNode {l; v; d; r=r'; h}) + + let rec domain (s : 'a map) : set = match map_prj s with + | MEmpty -> set_inj SEmpty + | MNode {l; v; r; h; _} -> + set_inj (SNode (domain l, v, domain r, h)) + (** This function is essentially identity, but OCaml current stdlib does not + take advantage of the similarity of the two structures, so we introduce + this unsafe loophole. *) + + let rec bind f (s : set) : 'a map = match set_prj s with + | SEmpty -> map_inj MEmpty + | SNode (l, k, r, h) -> + map_inj (MNode { l=bind f l; v=k; d=f k; r=bind f r; h}) + (** Dual operation of [domain]. *) + + let rec fold_left f (s : 'a map) accu = match map_prj s with + | MEmpty -> accu + | MNode {l; v=k; d=v; r; h} -> + let accu = f k v (fold_left f l accu) in + fold_left f r accu + + let rec fold_right f (s : 'a map) accu = match map_prj s with + | MEmpty -> accu + | MNode {l; v=k; d=v; r; h} -> + let accu = f k v (fold_right f r accu) in + fold_right f l accu + + let height s = match map_prj s with + | MEmpty -> 0 + | MNode {h;_} -> h + + (* Filter based on a range *) + let filter_range in_range m = + let rec aux m = function + | MEmpty -> m + | MNode {l; v; d; r; _} -> + let vr = in_range v in + (* the range is below the current value *) + if vr < 0 then aux m (map_prj l) + (* the range is above the current value *) + else if vr > 0 then aux m (map_prj r) + (* The current value is in the range *) + else + let m = aux m (map_prj l) in + let m = aux m (map_prj r) in + F.add v d m + in aux F.empty (map_prj m) + + (* Imported from OCaml upstream until we can bump the version *) + let create l x d r = + let hl = height l and hr = height r in + map_inj @@ MNode{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)} + + let bal l x d r = + let hl = match map_prj l with MEmpty -> 0 | MNode {h} -> h in + let hr = match map_prj r with MEmpty -> 0 | MNode {h} -> h in + if hl > hr + 2 then begin + match map_prj l with + | MEmpty -> invalid_arg "Map.bal" + | MNode{l=ll; v=lv; d=ld; r=lr} -> + if height ll >= height lr then + create ll lv ld (create lr x d r) + else begin + match map_prj lr with + | MEmpty -> invalid_arg "Map.bal" + | MNode{l=lrl; v=lrv; d=lrd; r=lrr}-> + create (create ll lv ld lrl) lrv lrd (create lrr x d r) + end + end else if hr > hl + 2 then begin + match map_prj r with + | MEmpty -> invalid_arg "Map.bal" + | MNode{l=rl; v=rv; d=rd; r=rr} -> + if height rr >= height rl then + create (create l x d rl) rv rd rr + else begin + match map_prj rl with + | MEmpty -> invalid_arg "Map.bal" + | MNode{l=rll; v=rlv; d=rld; r=rlr} -> + create (create l x d rll) rlv rld (create rlr rv rd rr) + end + end else + map_inj @@ MNode{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)} + + let rec remove_min_binding m = match map_prj m with + | MEmpty -> invalid_arg "Map.remove_min_elt" + | MNode {l;v;d;r;_} -> + match map_prj l with + | MEmpty -> r + | _ -> bal (remove_min_binding l) v d r + + let merge t1 t2 = + match (map_prj t1, map_prj t2) with + (MEmpty, t) -> map_inj t + | (t, MEmpty) -> map_inj t + | (_, _) -> + let (x, d) = F.min_binding t2 in + bal t1 x d (remove_min_binding t2) + + let rec update x f m = match map_prj m with + | MEmpty -> + begin match f None with + | None -> map_inj MEmpty + | Some data -> map_inj @@ MNode{l=map_inj MEmpty; v=x; d=data; r=map_inj MEmpty; h=1} + end + | MNode {l; v; d; r; h} as m -> + let c = M.compare x v in + if c = 0 then begin + match f (Some d) with + | None -> merge l r + | Some data -> + if d == data then map_inj m else + map_inj @@ MNode{l; v=x; d=data; r; h} + end else if c < 0 then + let ll = update x f l in + if l == ll then map_inj m else bal ll v d r + else + let rr = update x f r in + if r == rr then map_inj m else bal l v d rr + + (* End of Imported OCaml *) + + module Smart = + struct + + let rec map f (s : 'a map) = match map_prj s with + | MEmpty -> map_inj MEmpty + | MNode {l; v=k; d=v; r; h} -> + let l' = map f l in + let r' = map f r in + let v' = f v in + if l == l' && r == r' && v == v' then s + else map_inj (MNode {l=l'; v=k; d=v'; r=r'; h}) + + let rec mapi f (s : 'a map) = match map_prj s with + | MEmpty -> map_inj MEmpty + | MNode {l; v=k; d=v; r; h} -> + let l' = mapi f l in + let r' = mapi f r in + let v' = f k v in + if l == l' && r == r' && v == v' then s + else map_inj (MNode {l=l'; v=k; d=v'; r=r'; h}) + + end + + module Unsafe = + struct + + let rec map f (s : 'a map) : 'b map = match map_prj s with + | MEmpty -> map_inj MEmpty + | MNode {l; v=k; d=v; r; h} -> + let (k, v) = f k v in + map_inj (MNode {l=map f l; v=k; d=v; r=map f r; h}) + + end + + module Monad(M : MonadS) = + struct + + open M + + let rec fold_left f s accu = match map_prj s with + | MEmpty -> return accu + | MNode {l; v=k; d=v; r; h} -> + fold_left f l accu >>= fun accu -> + f k v accu >>= fun accu -> + fold_left f r accu + + let rec fold_right f s accu = match map_prj s with + | MEmpty -> return accu + | MNode {l; v=k; d=v; r; h} -> + fold_right f r accu >>= fun accu -> + f k v accu >>= fun accu -> + fold_right f l accu + + let fold = fold_left + + end + +end + +module Make(M : Map.OrderedType) = +struct + include Map.Make(M) + include MapExt(M) +end diff -Nru coq-doc-8.6/clib/cMap.mli coq-doc-8.15.0/clib/cMap.mli --- coq-doc-8.6/clib/cMap.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cMap.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,111 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module type MonadS = +sig + type +'a t + val return : 'a -> 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t +end + +module type S = Map.S + +module type ExtS = +sig + include CSig.MapS + (** The underlying Map library *) + + module Set : CSig.SetS with type elt = key + (** Sets used by the domain function *) + + val get : key -> 'a t -> 'a + (** Same as {!find} but fails an assertion instead of raising [Not_found] *) + + val set : key -> 'a -> 'a t -> 'a t + (** Same as [add], but expects the key to be present, and thus faster. + @raise Not_found when the key is unbound in the map. *) + + val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t + (** Apply the given function to the binding of the given key. + @raise Not_found when the key is unbound in the map. *) + + val domain : 'a t -> Set.t + (** Recover the set of keys defined in the map. *) + + val bind : (key -> 'a) -> Set.t -> 'a t + (** [bind f s] transform the set [x1; ...; xn] into [x1 := f x1; ...; + xn := f xn]. *) + + val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + (** Alias for {!fold}, to easily track where we depend on fold order. *) + + val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + (** Folding keys in decreasing order. *) + + val height : 'a t -> int + (** An indication of the logarithmic size of a map *) + + val filter_range : (key -> int) -> 'a t -> 'a t + (** [find_range in_range m] Given a comparison function [in_range x], + that tests if [x] is below, above, or inside a given range + [filter_range] returns the submap of [m] whose keys are in + range. Note that [in_range] has to define a continouous range. *) + + val update: key -> ('a option -> 'a option) -> 'a t -> 'a t + (** [update x f m] returns a map containing the same bindings as + [m], except for the binding of [x]. Depending on the value of + [y] where [y] is [f (find_opt x m)], the binding of [x] is + added, removed or updated. If [y] is [None], the binding is + removed if it exists; otherwise, if [y] is [Some z] then [x] + is associated to [z] in the resulting map. If [x] was already + bound in [m] to a value that is physically equal to [z], [m] + is returned unchanged (the result of the function is then + physically equal to [m]). + *) + + module Smart : + sig + val map : ('a -> 'a) -> 'a t -> 'a t + (** As [map] but tries to preserve sharing. *) + + val mapi : (key -> 'a -> 'a) -> 'a t -> 'a t + (** As [mapi] but tries to preserve sharing. *) + end + + module Unsafe : + sig + val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t + (** As the usual [map], but also allows modifying the key of a binding. + It is required that the mapping function [f] preserves key equality, + i.e.: for all (k : key) (x : 'a), compare (fst (f k x)) k = 0. *) + end + + module Monad(M : MonadS) : + sig + val fold : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t + val fold_left : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t + val fold_right : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t + end + (** Fold operators parameterized by any monad. *) + +end + +module Make(M : Map.OrderedType) : ExtS with + type key = M.t + and type 'a t = 'a Map.Make(M).t + and module Set := Set.Make(M) diff -Nru coq-doc-8.6/clib/cObj.ml coq-doc-8.15.0/clib/cObj.ml --- coq-doc-8.6/clib/cObj.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cObj.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,205 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* = Obj.no_scan_tag then + if Obj.tag t = Obj.string_tag then + (c := !c + Obj.size t; b := !b + 1; m := max d !m) + else if Obj.tag t = Obj.double_tag then + (s := !s + 2; b := !b + 1; m := max d !m) + else if Obj.tag t = Obj.double_array_tag then + (s := !s + 2 * Obj.size t; b := !b + 1; m := max d !m) + else (b := !b + 1; m := max d !m) + else + let n = Obj.size t in + s := !s + n; b := !b + 1; + block_stats (d + 1) (n - 1) t + +and block_stats d i t = + if i >= 0 then (obj_stats d (Obj.field t i); block_stats d (i-1) t) + +let obj_stats a = + c := 0; s:= 0; b:= 0; m:= 0; + obj_stats 0 (Obj.repr a); + (!c, !s + !b, !m) + +(** {6 Physical sizes} *) + +(*s Pointers already visited are stored in a hash-table, where + comparisons are done using physical equality. *) + +module H = Hashtbl.Make( + struct + type t = Obj.t + let equal = (==) + let hash = Hashtbl.hash + end) + +let node_table = (H.create 257 : unit H.t) + +let in_table o = try H.find node_table o; true with Not_found -> false + +let add_in_table o = H.add node_table o () + +let reset_table () = H.clear node_table + +(*s Objects are traversed recursively, as soon as their tags are less than + [no_scan_tag]. [count] records the numbers of words already visited. *) + +let size_of_double = Obj.size (Obj.repr 1.0) + +let count = ref 0 + +let rec traverse t = + if not (in_table t) && Obj.is_block t then begin + add_in_table t; + let n = Obj.size t in + let tag = Obj.tag t in + if tag < Obj.no_scan_tag then + begin + count := !count + 1 + n; + for i = 0 to n - 1 do traverse (Obj.field t i) done + end + else if tag = Obj.string_tag then + count := !count + 1 + n + else if tag = Obj.double_tag then + count := !count + size_of_double + else if tag = Obj.double_array_tag then + count := !count + 1 + size_of_double * n + else + incr count + end + +(*s Sizes of objects in words and in bytes. The size in bytes is computed + system-independently according to [Sys.word_size]. *) + +let size o = + reset_table (); + count := 0; + traverse (Obj.repr o); + !count + +let size_b o = (size o) * (Sys.word_size / 8) + +let size_kb o = (size o) / (8192 / Sys.word_size) + +(** {6 Physical sizes with sharing} *) + +(** This time, all the size of objects are computed with respect + to a larger object containing them all, and we only count + the new blocks not already seen earlier in the left-to-right + visit of the englobing object. + + The very same object could have a zero size or not, depending + of the occurrence we're considering in the englobing object. + For speaking of occurrences, we use an [int list] for a path + of field indexes from the outmost block to the one we're looking. + In the list, the leftmost integer is the field index in the deepest + block. +*) + +(** We now store in the hashtable the size (with sharing), and + also the position of the first occurrence of the object *) + +let node_sizes = (H.create 257 : (int*int list) H.t) +let get_size o = H.find node_sizes o +let add_size o n pos = H.replace node_sizes o (n,pos) +let reset_sizes () = H.clear node_sizes +let global_object = ref (Obj.repr 0) + +(** [sum n f] is [f 0 + f 1 + ... + f (n-1)], evaluated from left to right *) + +let sum n f = + let rec loop k acc = if k >= n then acc else loop (k+1) (acc + f k) + in loop 0 0 + +(** Recursive visit of the main object, filling the hashtable *) + +let rec compute_size o pos = + if not (Obj.is_block o) then 0 + else + try + let _ = get_size o in 0 (* already seen *) + with Not_found -> + let n = Obj.size o in + add_size o (-1) pos (* temp size, for cyclic values *); + let tag = Obj.tag o in + let size = + if tag < Obj.no_scan_tag then + 1 + n + sum n (fun i -> compute_size (Obj.field o i) (i::pos)) + else if tag = Obj.string_tag then + 1 + n + else if tag = Obj.double_tag then + size_of_double + else if tag = Obj.double_array_tag then + size_of_double * n + else + 1 + in + add_size o size pos; + size + +(** Provides the global object in which we'll search shared sizes *) + +let register_shared_size t = + let o = Obj.repr t in + reset_sizes (); + global_object := o; + ignore (compute_size o []) + +(** Shared size of an object with respect to the global object given + by the last [register_shared_size] *) + +let shared_size pos o = + if not (Obj.is_block o) then 0 + else + let size,pos' = + try get_size o + with Not_found -> failwith "shared_size: unregistered structure ?" + in + match pos with + | Some p when p <> pos' -> 0 + | _ -> size + +let shared_size_of_obj t = shared_size None (Obj.repr t) + +(** Shared size of the object at some positiion in the global object given + by the last [register_shared_size] *) + +let shared_size_of_pos pos = + let rec obj_of_pos o = function + | [] -> o + | n::pos' -> + let o' = obj_of_pos o pos' in + assert (Obj.is_block o' && n < Obj.size o'); + Obj.field o' n + in + shared_size (Some pos) (obj_of_pos !global_object pos) + + +(*s Total size of the allocated ocaml heap. *) + +let heap_size () = + let stat = Gc.stat () + and control = Gc.get () in + let max_words_total = stat.Gc.heap_words + control.Gc.minor_heap_size in + (max_words_total * (Sys.word_size / 8)) + +let heap_size_kb () = (heap_size () + 1023) / 1024 diff -Nru coq-doc-8.6/clib/cObj.mli coq-doc-8.15.0/clib/cObj.mli --- coq-doc-8.6/clib/cObj.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cObj.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,61 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* int +(** Physical size of an object in words. *) + +val size_b : 'a -> int +(** Same as [size] in bytes. *) + +val size_kb : 'a -> int +(** Same as [size] in kilobytes. *) + +(** {6 Physical size of an ocaml value with sharing.} *) + +(** This time, all the size of objects are computed with respect + to a larger object containing them all, and we only count + the new blocks not already seen earlier in the left-to-right + visit of the englobing object. *) + +(** Provides the global object in which we'll search shared sizes *) + +val register_shared_size : 'a -> unit + +(** Shared size (in word) of an object with respect to the global object + given by the last [register_shared_size]. *) + +val shared_size_of_obj : 'a -> int + +(** Same, with an object indicated by its occurrence in the global + object. The very same object could have a zero size or not, depending + of the occurrence we're considering in the englobing object. + For speaking of occurrences, we use an [int list] for a path + of field indexes (leftmost = deepest block, rightmost = top block of the + global object). *) + +val shared_size_of_pos : int list -> int + +(** {6 Logical size of an OCaml value.} *) + +val obj_stats : 'a -> int * int * int +(** Return the (logical) value size, the string size, and the maximum depth of + the object. This loops on cyclic structures. *) + +(** {6 Total size of the allocated ocaml heap. } *) + +val heap_size : unit -> int +(** Heap size, in words. *) + +val heap_size_kb : unit -> int +(** Heap size, in kilobytes. *) diff -Nru coq-doc-8.6/clib/cSet.ml coq-doc-8.15.0/clib/cSet.ml --- coq-doc-8.6/clib/cSet.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cSet.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,69 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module type S = Set.S + +module Make(M : OrderedType)= Set.Make(M) + +module type HashedType = +sig + type t + val hash : t -> int +end + +module Hashcons(M : OrderedType)(H : HashedType with type t = M.t) = +struct + module Set = Make(M) + + type set = Set.t + type _set = + | SEmpty + | SNode of set * M.t * set * int + + let set_prj : set -> _set = Obj.magic + let set_inj : _set -> set = Obj.magic + + let rec spine s accu = match set_prj s with + | SEmpty -> accu + | SNode (l, v, r, _) -> spine l ((v, r) :: accu) + + let rec umap f s = match set_prj s with + | SEmpty -> set_inj SEmpty + | SNode (l, v, r, h) -> + let l' = umap f l in + let r' = umap f r in + let v' = f v in + set_inj (SNode (l', v', r', h)) + + let rec eqeq s1 s2 = match s1, s2 with + | [], [] -> true + | (v1, r1) :: s1, (v2, r2) :: s2 -> + v1 == v2 && eqeq (spine r1 s1) (spine r2 s2) + | _ -> false + + module Hashed = + struct + open Hashset.Combine + type t = set + type u = M.t -> M.t + let eq s1 s2 = s1 == s2 || eqeq (spine s1 []) (spine s2 []) + let hash s = Set.fold (fun v accu -> combine (H.hash v) accu) s 0 + let hashcons = umap + end + + include Hashcons.Make(Hashed) + +end diff -Nru coq-doc-8.6/clib/cSet.mli coq-doc-8.15.0/clib/cSet.mli --- coq-doc-8.6/clib/cSet.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cSet.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,33 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module type S = Set.S + +module Make(M : OrderedType) : S + with type elt = M.t + and type t = Set.Make(M).t + +module type HashedType = +sig + type t + val hash : t -> int +end + +module Hashcons (M : OrderedType) (H : HashedType with type t = M.t) : Hashcons.S with + type t = Set.Make(M).t + and type u = M.t -> M.t +(** Create hash-consing for sets. The hashing function provided must be + compatible with the comparison function. *) diff -Nru coq-doc-8.6/clib/cSig.mli coq-doc-8.15.0/clib/cSig.mli --- coq-doc-8.6/clib/cSig.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cSig.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,92 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* bool + val mem: elt -> t -> bool + val add: elt -> t -> t + val singleton: elt -> t + val remove: elt -> t -> t + val union: t -> t -> t + val inter: t -> t -> t + val diff: t -> t -> t + val compare: t -> t -> int + val equal: t -> t -> bool + val subset: t -> t -> bool + val iter: (elt -> unit) -> t -> unit + val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a + val for_all: (elt -> bool) -> t -> bool + val exists: (elt -> bool) -> t -> bool + val filter: (elt -> bool) -> t -> t + val partition: (elt -> bool) -> t -> t * t + val cardinal: t -> int + val elements: t -> elt list + val min_elt: t -> elt + val max_elt: t -> elt + val choose: t -> elt + val split: elt -> t -> t * bool * t +end +(** Redeclaration of OCaml set signature, to preserve compatibility. See OCaml + documentation for more information. *) + +module type MapS = +sig + type key + type (+'a) t + val empty: 'a t + val is_empty: 'a t -> bool + val mem: key -> 'a t -> bool + val add: key -> 'a -> 'a t -> 'a t + (* when Coq requires OCaml 4.06 or later, can add: + + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t + + allowing Coq to use OCaml's "update" + *) + val singleton: key -> 'a -> 'a t + val remove: key -> 'a t -> 'a t + val merge: + (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + val union: + (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val iter: (key -> 'a -> unit) -> 'a t -> unit + val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val for_all: (key -> 'a -> bool) -> 'a t -> bool + val exists: (key -> 'a -> bool) -> 'a t -> bool + val filter: (key -> 'a -> bool) -> 'a t -> 'a t + val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + val cardinal: 'a t -> int + val bindings: 'a t -> (key * 'a) list + val min_binding: 'a t -> (key * 'a) + val max_binding: 'a t -> (key * 'a) + val choose: 'a t -> (key * 'a) + val choose_opt: 'a t -> (key * 'a) option + val split: key -> 'a t -> 'a t * 'a option * 'a t + val find: key -> 'a t -> 'a + val find_opt : key -> 'a t -> 'a option + val map: ('a -> 'b) -> 'a t -> 'b t + val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t +end diff -Nru coq-doc-8.6/clib/cString.ml coq-doc-8.15.0/clib/cString.ml --- coq-doc-8.6/clib/cString.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cString.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,150 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* int + val is_empty : string -> bool + val explode : string -> string list + val implode : string list -> string + val drop_simple_quotes : string -> string + val string_index_from : string -> int -> string -> int + val string_contains : where:string -> what:string -> bool + val plural : int -> string -> string + val conjugate_verb_to_be : int -> string + val ordinal : int -> string + val is_sub : string -> string -> int -> bool + val is_prefix : string -> string -> bool + val is_suffix : string -> string -> bool + module Set : Set.S with type elt = t + module Map : CMap.ExtS with type key = t and module Set := Set + module Pred : Predicate.S with type elt = t + module List : CList.MonoS with type elt = t + val hcons : string -> string +end + +include String + +let rec hash len s i accu = + if i = len then accu + else + let c = Char.code (String.unsafe_get s i) in + hash len s (succ i) (accu * 19 + c) + +let hash s = + let len = String.length s in + hash len s 0 0 + +let explode s = + let rec explode_rec n = + if n >= String.length s then + [] + else + String.make 1 (String.get s n) :: explode_rec (succ n) + in + explode_rec 0 + +let implode sl = String.concat "" sl + +let is_empty s = String.length s = 0 + +let drop_simple_quotes s = + let n = String.length s in + if n > 2 && s.[0] = '\'' && s.[n-1] = '\'' then String.sub s 1 (n-2) else s + +(* substring searching... *) + +(* gdzie = where, co = what *) +(* gdzie=gdzie(string) gl=gdzie(length) gi=gdzie(index) *) +let rec raw_is_sub gdzie gl gi co cl ci = + (ci>=cl) || + ((String.unsafe_get gdzie gi = String.unsafe_get co ci) && + (raw_is_sub gdzie gl (gi+1) co cl (ci+1))) + +let rec raw_str_index i gdzie l c co cl = + (* First adapt to ocaml 3.11 new semantics of index_from *) + if (i+cl > l) then raise Not_found; + (* Then proceed as in ocaml < 3.11 *) + let i' = String.index_from gdzie i c in + if (i'+cl <= l) && (raw_is_sub gdzie l i' co cl 0) then i' else + raw_str_index (i'+1) gdzie l c co cl + +let string_index_from gdzie i co = + if co="" then i else + raw_str_index i gdzie (String.length gdzie) + (String.unsafe_get co 0) co (String.length co) + +let string_contains ~where ~what = + try + let _ = string_index_from where 0 what in true + with + Not_found -> false + +let is_sub p s off = + let lp = String.length p in + let ls = String.length s in + if ls < off + lp then false + else + let rec aux i = + if lp <= i then true + else + let cp = String.unsafe_get p i in + let cs = String.unsafe_get s (off + i) in + if cp = cs then aux (succ i) else false + in + aux 0 + +let is_prefix p s = + is_sub p s 0 + +let is_suffix p s = + is_sub p s (String.length s - String.length p) + +let plural n s = if n<>1 then s^"s" else s + +let conjugate_verb_to_be n = if n<>1 then "are" else "is" + +let ordinal n = + let s = + if (n / 10) mod 10 = 1 then "th" + else match n mod 10 with + | 1 -> "st" + | 2 -> "nd" + | 3 -> "rd" + | _ -> "th" + in + string_of_int n ^ s + +(* string parsing *) + +module Self = +struct + type t = string + let compare = compare +end + +module Set = Set.Make(Self) +module Map = CMap.Make(Self) +module Pred = Predicate.Make(Self) + +module List = struct + type elt = string + let mem id l = List.exists (fun s -> equal id s) l + let assoc id l = CList.assoc_f equal id l + let remove_assoc id l = CList.remove_assoc_f equal id l + let mem_assoc id l = List.exists (fun (a,_) -> equal id a) l + let mem_assoc_sym id l = List.exists (fun (_,b) -> equal id b) l + let equal l l' = CList.equal equal l l' +end + +let hcons = Hashcons.simple_hcons Hashcons.Hstring.generate Hashcons.Hstring.hcons () diff -Nru coq-doc-8.6/clib/cString.mli coq-doc-8.15.0/clib/cString.mli --- coq-doc-8.6/clib/cString.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cString.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,78 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* int + (** Hashing on strings. Should be compatible with generic one. *) + + val is_empty : string -> bool + (** Test whether a string is empty. *) + + val explode : string -> string list + (** [explode "x1...xn"] returns [["x1"; ...; "xn"]] *) + + val implode : string list -> string + (** [implode [s1; ...; sn]] returns [s1 ^ ... ^ sn] *) + + val drop_simple_quotes : string -> string + (** Remove the eventual first surrounding simple quotes of a string. *) + + val string_index_from : string -> int -> string -> int + (** As [index_from], but takes a string instead of a char as pattern argument *) + + val string_contains : where:string -> what:string -> bool + (** As [contains], but takes a string instead of a char as pattern argument *) + + val plural : int -> string -> string + (** [plural n s] adds a optional 's' to the [s] when [2 <= n]. *) + + val conjugate_verb_to_be : int -> string + (** [conjugate_verb_to_be] returns "is" when [n=1] and "are" otherwise *) + + val ordinal : int -> string + (** Generate the ordinal number in English. *) + + val is_sub : string -> string -> int -> bool + (** [is_sub p s off] tests whether [s] contains [p] at offset [off]. *) + + val is_prefix : string -> string -> bool + (** [is_prefix p s] tests whether [p] is a prefix of [s]. *) + + val is_suffix : string -> string -> bool + (** [is_suffix suf s] tests whether [suf] is a suffix of [s]. *) + + (** {6 Generic operations} **) + + module Set : Set.S with type elt = t + (** Finite sets on [string] *) + + module Map : CMap.ExtS with type key = t and module Set := Set + (** Finite maps on [string] *) + + module Pred : Predicate.S with type elt = t + + module List : CList.MonoS with type elt = t + (** Association lists with [string] as keys *) + + val hcons : string -> string + (** Hashconsing on [string] *) + +end + +include ExtS diff -Nru coq-doc-8.6/clib/cThread.ml coq-doc-8.15.0/clib/cThread.ml --- coq-doc-8.6/clib/cThread.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cThread.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,128 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* loop () + in + loop () + +let thread_friendly_read ic s ~off ~len = + try + let fd = Unix.descr_of_in_channel ic in + thread_friendly_read_fd fd s ~off ~len + with Unix.Unix_error _ -> 0 + +let really_read_fd fd s off len = + let i = ref 0 in + while !i < len do + let off = off + !i in + let len = len - !i in + let r = thread_friendly_read_fd fd s ~off ~len in + if r = 0 then raise End_of_file; + i := !i + r + done + +let really_read_fd_2_oc fd oc len = + let i = ref 0 in + let size = 4096 in + let s = Bytes.create size in + while !i < len do + let len = len - !i in + let r = thread_friendly_read_fd fd s ~off:0 ~len:(min len size) in + if r = 0 then raise End_of_file; + i := !i + r; + output oc s 0 r; + done + +let thread_friendly_really_read ic s ~off ~len = + try + let fd = Unix.descr_of_in_channel ic in + really_read_fd fd s off len + with Unix.Unix_error _ -> raise End_of_file + +let thread_friendly_really_read_line ic = + try + let fd = Unix.descr_of_in_channel ic in + let b = Buffer.create 1024 in + let s = Bytes.make 1 '\000' in + let endl = Bytes.of_string "\n" in + (* Bytes.equal is in 4.03.0 *) + while Bytes.compare s endl <> 0 do + let n = thread_friendly_read_fd fd s ~off:0 ~len:1 in + if n = 0 then raise End_of_file; + if Bytes.compare s endl <> 0 then Buffer.add_bytes b s; + done; + Buffer.contents b + with Unix.Unix_error _ -> raise End_of_file + +let thread_friendly_input_value ic = + try + let fd = Unix.descr_of_in_channel ic in + let header = Bytes.create Marshal.header_size in + really_read_fd fd header 0 Marshal.header_size; + let body_size = Marshal.data_size header 0 in + let desired_size = body_size + Marshal.header_size in + if desired_size <= Sys.max_string_length then begin + let msg = Bytes.create desired_size in + Bytes.blit header 0 msg 0 Marshal.header_size; + really_read_fd fd msg Marshal.header_size body_size; + Marshal.from_bytes msg 0 + end else begin + (* Workaround for 32 bit systems and data > 16M *) + let name, oc = + Filename.open_temp_file ~mode:[Open_binary] "coq" "marshal" in + try + output oc header 0 Marshal.header_size; + really_read_fd_2_oc fd oc body_size; + close_out oc; + let ic = open_in_bin name in + let data = Marshal.from_channel ic in + close_in ic; + Sys.remove name; + data + with e -> Sys.remove name; raise e + end + with Unix.Unix_error _ | Sys_error _ -> raise End_of_file + +(* On the ocaml runtime used in some opam-for-windows version the + * [Thread.sigmask] API raises Invalid_argument "not implemented", + * hence we protect the call and turn the exception into a no-op *) +let mask_sigalrm f x = + begin try ignore(Thread.sigmask Unix.SIG_BLOCK [Sys.sigalrm]) + with Invalid_argument _ -> () end; + f x + +let create f x = + Thread.create (mask_sigalrm f) x + +(* + Atomic mutex lock taken from https://gitlab.com/gadmm/memprof-limits/-/blob/master/src/thread_map.ml#L23-34 + Critical sections : + - Mutex.lock does not poll on leaving the blocking section + since 4.12. + - Never inline, to avoid theoretically-possible reorderings with + flambda. + (workaround to the lack of masking) +*) + +(* We inline the call to Mutex.unlock to avoid polling in bytecode mode *) +external unlock: Mutex.t -> unit = "caml_mutex_unlock" + +let[@inline never] with_lock m ~scope = + let () = Mutex.lock m (* BEGIN ATOMIC *) in + match (* END ATOMIC *) scope () with + | (* BEGIN ATOMIC *) x -> unlock m ; (* END ATOMIC *) x + | (* BEGIN ATOMIC *) exception e -> unlock m ; (* END ATOMIC *) raise e diff -Nru coq-doc-8.6/clib/cThread.mli coq-doc-8.15.0/clib/cThread.mli --- coq-doc-8.6/clib/cThread.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cThread.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,36 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* thread_ic + +val thread_friendly_input_value : thread_ic -> 'a +val thread_friendly_read : + thread_ic -> Bytes.t -> off:int -> len:int -> int +val thread_friendly_really_read : + thread_ic -> Bytes.t -> off:int -> len:int -> unit +val thread_friendly_really_read_line : thread_ic -> string + +(* Wrapper around Thread.create that blocks signals such as Sys.sigalrm (used + * for Timeout *) +val create : ('a -> 'b) -> 'a -> Thread.t + +(* + Atomic mutex lock taken from https://gitlab.com/gadmm/memprof-limits/-/blob/master/src/thread_map.ml#L23-34 +*) +val with_lock : Mutex.t -> scope:(unit -> 'a) -> 'a diff -Nru coq-doc-8.6/clib/cUnix.ml coq-doc-8.15.0/clib/cUnix.ml --- coq-doc-8.6/clib/cUnix.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cUnix.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,159 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* + (* We give up to find a canonical name and just simplify it... *) + current ^ dirsep ^ strip_path p + +let make_suffix name suffix = + if Filename.check_suffix name suffix then name else (name ^ suffix) + +let correct_path f dir = + if Filename.is_relative f then Filename.concat dir f else f + +let file_readable_p name = + try Unix.access name [Unix.R_OK];true + with Unix.Unix_error (_, _, _) -> false + +(* As for [Unix.close_process], a [Unix.waipid] that ignores all [EINTR] *) + +let rec waitpid_non_intr pid = + try snd (Unix.waitpid [] pid) + with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_non_intr pid + +(** [run_command com] launches command [com] (via /bin/sh), + and returns the contents of stdout and stderr. If given, [~hook] + is called on each elements read on stdout or stderr. *) + +let run_command ?(hook=(fun _ ->())) c = + let result = Buffer.create 127 in + let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in + let buff = Bytes.make 127 ' ' in + let buffe = Bytes.make 127 ' ' in + let n = ref 0 in + let ne = ref 0 in + while n:= input cin buff 0 127 ; ne := input cerr buffe 0 127 ; + !n+ !ne <> 0 + do + let r = Bytes.sub buff 0 !n in (hook r; Buffer.add_bytes result r); + let r = Bytes.sub buffe 0 !ne in (hook r; Buffer.add_bytes result r); + done; + (Unix.close_process_full (cin,cout,cerr), Buffer.contents result) + +(** [sys_command] launches program [prog] with arguments [args]. + It behaves like [Sys.command], except that we rely on + [Unix.create_process], it's hardly more complex and avoids dealing + with shells. In particular, no need to quote arguments + (against whitespace or other funny chars in paths), hence no need + to care about the different quoting conventions of /bin/sh and cmd.exe. *) + +let sys_command prog args = + let argv = Array.of_list (prog::args) in + let pid = Unix.create_process prog argv Unix.stdin Unix.stdout Unix.stderr in + waitpid_non_intr pid + +(* + checks if two file names refer to the same (existing) file by + comparing their device and inode. + It seems that under Windows, inode is always 0, so we cannot + accurately check if + +*) +(* Optimised for partial application (in case many candidates must be + compared to f1). *) +let same_file f1 = + try + let s1 = Unix.stat f1 in + (fun f2 -> + try + let s2 = Unix.stat f2 in + s1.Unix.st_dev = s2.Unix.st_dev && + if Sys.os_type = "Win32" then f1 = f2 + else s1.Unix.st_ino = s2.Unix.st_ino + with + Unix.Unix_error _ -> false) + with + Unix.Unix_error _ -> (fun _ -> false) + +(* Copied from ocaml filename.ml *) +let prng = lazy(Random.State.make_self_init ()) + +let temp_file_name temp_dir prefix suffix = + let rnd = (Random.State.bits (Lazy.force prng)) land 0xFFFFFF in + Filename.concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix) + +let mktemp_dir ?(temp_dir=Filename.get_temp_dir_name()) prefix suffix = + let rec try_name counter = + let name = temp_file_name temp_dir prefix suffix in + match Unix.mkdir name 0o700 with + | () -> name + | exception (Sys_error _ as e) -> + if counter >= 1000 then raise e else try_name (counter + 1) + in + try_name 0 diff -Nru coq-doc-8.6/clib/cUnix.mli coq-doc-8.15.0/clib/cUnix.mli --- coq-doc-8.6/clib/cUnix.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/cUnix.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,69 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* physical_path +val string_of_physical_path : physical_path -> string + +(** Escape what has to be escaped (e.g. surround with quotes if with spaces) *) +val escaped_string_of_physical_path : physical_path -> string + +val canonical_path_name : string -> string + +(** Remove all initial "./" in a path *) +val remove_path_dot : string -> string + +(** If a path [p] starts with the current directory $PWD then + [strip_path p] returns the sub-path relative to $PWD. + Any leading "./" are also removed from the result. *) +val strip_path : string -> string + +(** correct_path f dir = dir/f if f is relative *) +val correct_path : string -> string -> string + +val path_to_list : string -> string list + +(** [make_suffix file suf] catenate [file] with [suf] when + [file] does not already end with [suf]. *) +val make_suffix : string -> string -> string + +val file_readable_p : string -> bool + +(** {6 Executing commands } *) + +(** [run_command com] launches command [com], and returns + the contents of stdout and stderr. If given, [~hook] + is called on each elements read on stdout or stderr. *) + +val run_command : + ?hook:(bytes->unit) -> string -> Unix.process_status * string + +(** [sys_command] launches program [prog] with arguments [args]. + It behaves like [Sys.command], except that we rely on + [Unix.create_process], it's hardly more complex and avoids dealing + with shells. In particular, no need to quote arguments + (against whitespace or other funny chars in paths), hence no need + to care about the different quoting conventions of /bin/sh and cmd.exe. *) + +val sys_command : string -> string list -> Unix.process_status + +(** A version of [Unix.waitpid] immune to EINTR exceptions *) + +val waitpid_non_intr : int -> Unix.process_status + +(** Check if two file names refer to the same (existing) file *) +val same_file : string -> string -> bool + +(** Like [Stdlib.Filename.temp_file] but producing a directory. *) +val mktemp_dir : ?temp_dir:string -> string -> string -> string diff -Nru coq-doc-8.6/clib/diff2.ml coq-doc-8.15.0/clib/diff2.ml --- coq-doc-8.6/clib/diff2.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/diff2.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,158 @@ +(* copied from https://github.com/leque/ocaml-diff.git and renamed from "diff.ml" *) + +(* + * Copyright (C) 2016 OOHASHI Daichi + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * in the Software without restriction, including without limitation the rights + * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + * copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + * THE SOFTWARE. + *) + +type 'a common = + [ `Common of int * int * 'a ] + +type 'a edit = + [ `Added of int * 'a + | `Removed of int * 'a + | 'a common + ] + +module type SeqType = sig + type t + type elem + val get : t -> int -> elem + val length : t -> int +end + +module type S = sig + type t + type elem + + val lcs : + ?equal:(elem -> elem -> bool) -> + t -> t -> elem common list + + val diff : + ?equal:(elem -> elem -> bool) -> + t -> t -> elem edit list + + val fold_left : + ?equal:(elem -> elem -> bool) -> + f:('a -> elem edit -> 'a) -> + init:'a -> + t -> t -> 'a + + val iter : + ?equal:(elem -> elem -> bool) -> + f:(elem edit -> unit) -> + t -> t -> unit +end + +module Make(M : SeqType) : (S with type t = M.t and type elem = M.elem) = struct + type t = M.t + type elem = M.elem + + let lcs ?(equal = (=)) a b = + let n = M.length a in + let m = M.length b in + let mn = m + n in + let sz = 2 * mn + 1 in + let vd = Array.make sz 0 in + let vl = Array.make sz 0 in + let vr = Array.make sz [] in + let get v i = Array.get v (i + mn) in + let set v i x = Array.set v (i + mn) x in + let finish () = + let rec loop i maxl r = + if i > mn then + List.rev r + else if get vl i > maxl then + loop (i + 1) (get vl i) (get vr i) + else + loop (i + 1) maxl r + in loop (- mn) 0 [] + in + if mn = 0 then + [] + else + (* For d <- 0 to mn Do *) + let rec dloop d = + assert (d <= mn); + (* For k <- -d to d in steps of 2 Do *) + let rec kloop k = + if k > d then + dloop @@ d + 1 + else + let x, l, r = + if k = -d || (k <> d && get vd (k - 1) < get vd (k + 1)) then + get vd (k + 1), get vl (k + 1), get vr (k + 1) + else + get vd (k - 1) + 1, get vl (k - 1), get vr (k - 1) + in + let x, y, l, r = + let rec xyloop x y l r = + if x < n && y < m && equal (M.get a x) (M.get b y) then + xyloop (x + 1) (y + 1) (l + 1) (`Common(x, y, M.get a x) :: r) + else + x, y, l, r + in xyloop x (x - k) l r + in + set vd k x; + set vl k l; + set vr k r; + if x >= n && y >= m then + (* Stop *) + finish () + else + kloop @@ k + 2 + in kloop @@ -d + in dloop 0 + + let fold_left ?(equal = (=)) ~f ~init a b = + let ff x y = f y x in + let fold_map f g x from to_ init = + let rec loop i init = + if i >= to_ then + init + else + loop (i + 1) (f (g i @@ M.get x i) init) + in loop from init + in + let added i x = `Added (i, x) in + let removed i x = `Removed (i, x) in + let rec loop cs apos bpos init = + match cs with + | [] -> + init + |> fold_map ff removed a apos (M.length a) + |> fold_map ff added b bpos (M.length b) + | `Common (aoff, boff, _) as e :: rest -> + init + |> fold_map ff removed a apos aoff + |> fold_map ff added b bpos boff + |> ff e + |> loop rest (aoff + 1) (boff + 1) + in loop (lcs ~equal a b) 0 0 init + + let diff ?(equal = (=)) a b = + fold_left ~equal ~f:(fun xs x -> x::xs) ~init:[] a b + + let iter ?(equal = (=)) ~f a b = + fold_left a b + ~equal + ~f:(fun () x -> f x) + ~init:() +end diff -Nru coq-doc-8.6/clib/diff2.mli coq-doc-8.15.0/clib/diff2.mli --- coq-doc-8.6/clib/diff2.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/diff2.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,101 @@ +(* copied from https://github.com/leque/ocaml-diff.git and renamed from "diff.mli" *) +(** + An implementation of Eugene Myers' O(ND) Difference Algorithm\[1\]. + This implementation is a port of util.lcs module of + {{:http://practical-scheme.net/gauche} Gauche Scheme interpreter}. + + - \[1\] Eugene Myers, An O(ND) Difference Algorithm and Its Variations, Algorithmica Vol. 1 No. 2, pp. 251-266, 1986. + *) + +type 'a common = [ + `Common of int * int * 'a + ] +(** an element of lcs of seq1 and seq2 *) + +type 'a edit = + [ `Removed of int * 'a + | `Added of int * 'a + | 'a common + ] +(** an element of diff of seq1 and seq2. *) + +module type SeqType = sig + type t + (** The type of the sequence. *) + + type elem + (** The type of the elements of the sequence. *) + + val get : t -> int -> elem + (** [get t n] returns [n]-th element of the sequence [t]. *) + + val length : t -> int + (** [length t] returns the length of the sequence [t]. *) +end +(** Input signature of {!Diff.Make}. *) + +module type S = sig + type t + (** The type of input sequence. *) + + type elem + (** The type of the elements of result / input sequence. *) + + val lcs : + ?equal:(elem -> elem -> bool) -> + t -> t -> elem common list + (** + [lcs ~equal seq1 seq2] computes the LCS (longest common sequence) of + [seq1] and [seq2]. + Elements of [seq1] and [seq2] are compared with [equal]. + [equal] defaults to [Pervasives.(=)]. + + Elements of lcs are [`Common (pos1, pos2, e)] + where [e] is an element, [pos1] is a position in [seq1], + and [pos2] is a position in [seq2]. + *) + + val diff : + ?equal:(elem -> elem -> bool) -> + t -> t -> elem edit list + (** + [diff ~equal seq1 seq2] computes the diff of [seq1] and [seq2]. + Elements of [seq1] and [seq2] are compared with [equal]. + + Elements only in [seq1] are represented as [`Removed (pos, e)] + where [e] is an element, and [pos] is a position in [seq1]; + those only in [seq2] are represented as [`Added (pos, e)] + where [e] is an element, and [pos] is a position in [seq2]; + those common in [seq1] and [seq2] are represented as + [`Common (pos1, pos2, e)] + where [e] is an element, [pos1] is a position in [seq1], + and [pos2] is a position in [seq2]. + *) + + val fold_left : + ?equal:(elem -> elem -> bool) -> + f:('a -> elem edit -> 'a) -> + init:'a -> + t -> t -> 'a + (** + [fold_left ~equal ~f ~init seq1 seq2] is same as + [diff ~equal seq1 seq2 |> ListLabels.fold_left ~f ~init], + but does not create an intermediate list. + *) + + val iter : + ?equal:(elem -> elem -> bool) -> + f:(elem edit -> unit) -> + t -> t -> unit + (** + [iter ~equal ~f seq1 seq2] is same as + [diff ~equal seq1 seq2 |> ListLabels.iter ~f], + but does not create an intermediate list. + *) +end +(** Output signature of {!Diff.Make}. *) + +module Make : + functor (M : SeqType) -> (S with type t = M.t and type elem = M.elem) +(** Functor building an implementation of the diff structure + given a sequence type. *) diff -Nru coq-doc-8.6/clib/dune coq-doc-8.15.0/clib/dune --- coq-doc-8.6/clib/dune 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/dune 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,7 @@ +(library + (name clib) + (synopsis "Coq's Utility Library [general purpose]") + (public_name coq-core.clib) + (wrapped false) + (modules_without_implementation cSig) + (libraries str unix threads)) diff -Nru coq-doc-8.6/clib/dyn.ml coq-doc-8.15.0/clib/dyn.ml --- coq-doc-8.6/clib/dyn.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/dyn.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,180 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a value -> t -> t + val remove : 'a key -> t -> t + val find : 'a key -> t -> 'a value + val mem : 'a key -> t -> bool + + type map = { map : 'a. 'a key -> 'a value -> 'a value } + val map : map -> t -> t + + type any = Any : 'a key * 'a value -> any + val iter : (any -> unit) -> t -> unit + val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r +end + +module type PreS = +sig + type 'a tag + type t = Dyn : 'a tag * 'a -> t + + val create : string -> 'a tag + val anonymous : int -> 'a tag + val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option + val repr : 'a tag -> string + + val dump : unit -> (int * string) list + + type any = Any : 'a tag -> any + val name : string -> any option + + module Map(Value : ValueS) : + MapS with type 'a key = 'a tag and type 'a value = 'a Value.t + + module HMap (V1 : ValueS)(V2 : ValueS) : + sig + type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t } + val map : map -> Map(V1).t -> Map(V2).t + end + +end + +module type S = +sig + include PreS + + module Easy : sig + val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag + val make_dyn : string -> ('a -> t) * (t -> 'a) + val inj : 'a -> 'a tag -> t + val prj : t -> 'a tag -> 'a option + end +end + +module Make () = struct + +module Self : PreS = struct + (* Dynamics, programmed with DANGER !!! *) + + type 'a tag = int + + type t = Dyn : 'a tag * 'a -> t + + type any = Any : 'a tag -> any + + let dyntab = ref (Int.Map.empty : string Int.Map.t) + (** Instead of working with tags as strings, which are costly, we use their + hash. We ensure unicity of the hash in the [create] function. If ever a + collision occurs, which is unlikely, it is sufficient to tweak the offending + dynamic tag. *) + + let create (s : string) = + let hash = Hashtbl.hash s in + if Int.Map.mem hash !dyntab then begin + let old = Int.Map.find hash !dyntab in + Printf.eprintf "Dynamic tag collision: %s vs. %s\n%!" s old; + assert false + end; + dyntab := Int.Map.add hash s !dyntab; + hash + + let anonymous n = + if Int.Map.mem n !dyntab then begin + Printf.eprintf "Dynamic tag collision: %d\n%!" n; + assert false + end; + dyntab := Int.Map.add n "" !dyntab; + n + + let eq : 'a 'b. 'a tag -> 'b tag -> ('a, 'b) CSig.eq option = + fun h1 h2 -> if Int.equal h1 h2 then Some (Obj.magic CSig.Refl) else None + + let repr s = + try Int.Map.find s !dyntab + with Not_found -> + let () = Printf.eprintf "Unknown dynamic tag %i\n%!" s in + assert false + + let name s = + let hash = Hashtbl.hash s in + if Int.Map.mem hash !dyntab then Some (Any hash) else None + + let dump () = Int.Map.bindings !dyntab + + module Map(Value: ValueS) = + struct + type t = Obj.t Value.t Int.Map.t + type 'a key = 'a tag + type 'a value = 'a Value.t + let cast : 'a value -> 'b value = Obj.magic + let empty = Int.Map.empty + let add tag v m = Int.Map.add tag (cast v) m + let remove tag m = Int.Map.remove tag m + let find tag m = cast (Int.Map.find tag m) + let mem = Int.Map.mem + + type map = { map : 'a. 'a tag -> 'a value -> 'a value } + let map f m = Int.Map.mapi f.map m + + type any = Any : 'a tag * 'a value -> any + let iter f m = Int.Map.iter (fun k v -> f (Any (k, v))) m + let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu + end + + module HMap (V1 : ValueS) (V2 : ValueS) = + struct + type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t } + + let map (f : map) (m : Map(V1).t) : Map(V2).t = + Int.Map.mapi f.map m + + end + +end +include Self + +module Easy = struct + (* now tags are opaque, we can do the trick *) + let make_dyn_tag (s : string) = + (fun (type a) (tag : a tag) -> + let infun : (a -> t) = fun x -> Dyn (tag, x) in + let outfun : (t -> a) = fun (Dyn (t, x)) -> + match eq tag t with + | None -> assert false + | Some CSig.Refl -> x + in + infun, outfun, tag) + (create s) + + let make_dyn (s : string) = + let inf, outf, _ = make_dyn_tag s in inf, outf + + let inj x tag = Dyn(tag,x) + let prj : type a. t -> a tag -> a option = + fun (Dyn(tag',x)) tag -> + match eq tag tag' with + | None -> None + | Some CSig.Refl -> Some x +end + +end + diff -Nru coq-doc-8.6/clib/dyn.mli coq-doc-8.15.0/clib/dyn.mli --- coq-doc-8.6/clib/dyn.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/dyn.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,95 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a value -> t -> t + val remove : 'a key -> t -> t + val find : 'a key -> t -> 'a value + val mem : 'a key -> t -> bool + + type map = { map : 'a. 'a key -> 'a value -> 'a value } + val map : map -> t -> t + + type any = Any : 'a key * 'a value -> any + val iter : (any -> unit) -> t -> unit + val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r +end + +module type S = +sig + type 'a tag + (** Type of dynamic tags *) + + type t = Dyn : 'a tag * 'a -> t + (** Type of dynamic values *) + + val create : string -> 'a tag + (** [create n] returns a tag describing a type called [n]. + [create] raises an exception if [n] is already registered. + Type names are hashed, so [create] may raise even if no type with + the exact same name was registered due to a collision. *) + + val anonymous : int -> 'a tag + (** [anonymous i] returns a tag describing an [i]-th anonymous type. + If [anonymous] is not used together with [create], [max_int] anonymous types + are available. + [anonymous] raises an exception if [i] is already registered. *) + + val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option + (** [eq t1 t2] returns [Some witness] if [t1] is the same as [t2], [None] otherwise. *) + + val repr : 'a tag -> string + (** [repr tag] returns the name of the type represented by [tag]. *) + + val dump : unit -> (int * string) list + (** [dump ()] returns a list of (tag, name) pairs for every type tag registered + in this [Dyn.Make] instance. *) + + type any = Any : 'a tag -> any + (** Type of boxed dynamic tags *) + + val name : string -> any option + (** [name n] returns [Some t] where t is a boxed tag previously registered + with [create n], or [None] if there is no such tag. *) + + module Map(Value : ValueS) : + MapS with type 'a key = 'a tag and type 'a value = 'a Value.t + (** Map from type tags to values parameterized by the tag type *) + + module HMap (V1 : ValueS)(V2 : ValueS) : + sig + type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t } + val map : map -> Map(V1).t -> Map(V2).t + end + + module Easy : sig + (* To create a dynamic type on the fly *) + val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag + val make_dyn : string -> ('a -> t) * (t -> 'a) + + (* For types declared with the [create] function above *) + val inj : 'a -> 'a tag -> t + val prj : t -> 'a tag -> 'a option + end +end + +module Make () : S diff -Nru coq-doc-8.6/clib/exninfo.ml coq-doc-8.15.0/clib/exninfo.ml --- coq-doc-8.6/clib/exninfo.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/exninfo.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,124 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a t +(** Create a new piece of information. *) + +val null : info +(** No information *) + +val add : info -> 'a t -> 'a -> info +(** Add information to an exception. *) + +val get : info -> 'a t -> 'a option +(** Get information worn by an exception. Returns [None] if undefined. *) + +val info : exn -> info +(** Retrieve the information of the last exception raised. *) + +type backtrace + +val get_backtrace : info -> backtrace option +(** [get_backtrace info] does get the backtrace associated to info *) + +val backtrace_to_string : backtrace -> string +(** [backtrace_to_string info] does get the backtrace associated to info *) + +val record_backtrace : bool -> unit + +val capture : exn -> iexn +(** Add the current backtrace information to the given exception. + + The intended use case is of the form: {[ + + try foo + with + | Bar -> bar + | exn -> + let exn = Exninfo.capture err in + baz + + ]} + + where [baz] should re-raise using [iraise] below. + + WARNING: any intermediate code between the [with] and the handler may + modify the backtrace. Yes, that includes [when] clauses. Ideally, what you + should do is something like: {[ + + try foo + with exn -> + let exn = Exninfo.capture exn in + match err with + | Bar -> bar + | err -> baz + + ]} + + I admit that's a bit heavy, but there is not much to do... + +*) + +val iraise : iexn -> 'a +(** Raise the given enriched exception. *) + +val reify : unit -> info diff -Nru coq-doc-8.6/clib/hashcons.ml coq-doc-8.15.0/clib/hashcons.ml --- coq-doc-8.6/clib/hashcons.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/hashcons.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,146 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t1)*(t2->t2)*...). + * [hashcons u x] is a function that hash-cons the sub-structures of x using + * the hash-consing functions u provides. + * [eq] is a comparison function. It is allowed to use physical equality + * on the sub-terms hash-consed by the hashcons function. + * [hash] is the hash function given to the Hashtbl.Make function + * + * Note that this module type coerces to the argument of Hashtbl.Make. + *) + +module type HashconsedType = + sig + type t + type u + val hashcons : u -> t -> t + val eq : t -> t -> bool + val hash : t -> int + end + +(** The output is a function [generate] such that [generate args] creates a + hash-table of the hash-consed objects, together with [hcons], a function + taking a table and an object, and hashcons it. For simplicity of use, we use + the wrapper functions defined below. *) + +module type S = + sig + type t + type u + type table + val generate : u -> table + val hcons : table -> t -> t + val stats : table -> Hashset.statistics + end + +module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u) = + struct + type t = X.t + type u = X.u + + (* We create the type of hashtables for t, with our comparison fun. + * An invariant is that the table never contains two entries equals + * w.r.t (=), although the equality on keys is X.eq. This is + * granted since we hcons the subterms before looking up in the table. + *) + module Htbl = Hashset.Make(X) + + type table = (Htbl.t * u) + + let generate u = + let tab = Htbl.create 97 in + (tab, u) + + let hcons (tab, u) x = + let y = X.hashcons u x in + Htbl.repr (X.hash y) y tab + + let stats (tab, _) = Htbl.stats tab + + end + +(* A few useful wrappers: + * takes as argument the function [generate] above and build a function of type + * u -> t -> t that creates a fresh table each time it is applied to the + * sub-hcons functions. *) + +(* For non-recursive types it is quite easy. *) +let simple_hcons h f u = + let table = h u in + fun x -> f table x + +(* For a recursive type T, we write the module of sig Comp with u equals + * to (T -> T) * u0 + * The first component will be used to hash-cons the recursive subterms + * The second one to hashcons the other sub-structures. + * We just have to take the fixpoint of h + *) +let recursive_hcons h f u = + let loop = ref (fun _ -> assert false) in + let self x = !loop x in + let table = h (self, u) in + let hrec x = f table x in + let () = loop := hrec in + hrec + +(* Basic hashcons modules for string and obj. Integers do not need be + hashconsed. *) + +module type HashedType = sig type t val hash : t -> int end + +(* list *) +module Hlist (D:HashedType) = + Make( + struct + type t = D.t list + type u = (t -> t) * (D.t -> D.t) + let hashcons (hrec,hdata) = function + | x :: l -> hdata x :: hrec l + | l -> l + let eq l1 l2 = + l1 == l2 || + match l1, l2 with + | [], [] -> true + | x1::l1, x2::l2 -> x1==x2 && l1==l2 + | _ -> false + let rec hash accu = function + | [] -> accu + | x :: l -> + let accu = Hashset.Combine.combine (D.hash x) accu in + hash accu l + let hash l = hash 0 l + end) + +(* string *) +module Hstring = Make( + struct + type t = string + type u = unit + let hashcons () s =(* incr accesstr;*) s + + let eq = String.equal + + (** Copy from CString *) + let rec hash len s i accu = + if i = len then accu + else + let c = Char.code (String.unsafe_get s i) in + hash len s (succ i) (accu * 19 + c) + + let hash s = + let len = String.length s in + hash len s 0 0 + end) diff -Nru coq-doc-8.6/clib/hashcons.mli coq-doc-8.15.0/clib/hashcons.mli --- coq-doc-8.6/clib/hashcons.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/hashcons.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,98 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> t + (** The actual hashconsing function, using its fist argument to recursively + hashcons substructures. It should be compatible with [eq], that is + [eq x (hashcons f x) = true]. *) + + val eq : t -> t -> bool + (** A comparison function. It is allowed to use physical equality + on the sub-terms hashconsed by the [hashcons] function, but it should be + insensible to shallow copy of the compared object. *) + + val hash : t -> int + (** A hash function passed to the underlying hashtable structure. [hash] + should be compatible with [eq], i.e. if [eq x y = true] then + [hash x = hash y]. *) + end + +module type S = + sig + type t + (** Type of objects to hashcons. *) + + type u + (** Type of hashcons functions for the sub-structures contained in [t]. *) + + type table + (** Type of hashconsing tables *) + + val generate : u -> table + (** This create a hashtable of the hashconsed objects. *) + + val hcons : table -> t -> t + (** Perform the hashconsing of the given object within the table. *) + + val stats : table -> Hashset.statistics + (** Recover statistics of the hashconsing table. *) + end + +module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u) +(** Create a new hashconsing, given canonicalization functions. *) + +(** {6 Wrappers} *) + +(** These are intended to be used together with instances of the [Make] + functor. *) + +val simple_hcons : ('u -> 'tab) -> ('tab -> 't -> 't) -> 'u -> 't -> 't +(** [simple_hcons f sub obj] creates a new table each time it is applied to any + sub-hash function [sub]. *) + +val recursive_hcons : (('t -> 't) * 'u -> 'tab) -> ('tab -> 't -> 't) -> ('u -> 't -> 't) +(** As [simple_hcons] but intended to be used with well-founded data structures. *) + +(** {6 Hashconsing of usual structures} *) + +module type HashedType = sig type t val hash : t -> int end + +module Hstring : (S with type t = string and type u = unit) +(** Hashconsing of strings. *) + +module Hlist (D:HashedType) : + (S with type t = D.t list and type u = (D.t list -> D.t list)*(D.t->D.t)) +(** Hashconsing of lists. *) diff -Nru coq-doc-8.6/clib/hashset.ml coq-doc-8.15.0/clib/hashset.ml --- coq-doc-8.6/clib/hashset.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/hashset.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,237 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> bool +end + +type statistics = { + num_bindings: int; + num_buckets: int; + max_bucket_length: int; + bucket_histogram: int array +} + +module type S = sig + type elt + type t + val create : int -> t + val clear : t -> unit + val repr : int -> elt -> t -> elt + val stats : t -> statistics +end + +module Make (E : EqType) = + struct + + type elt = E.t + + let emptybucket = Weak.create 0 + + type t = { + mutable table : elt Weak.t array; + mutable hashes : int array array; + mutable limit : int; (* bucket size limit *) + mutable oversize : int; (* number of oversize buckets *) + mutable rover : int; (* for internal bookkeeping *) + } + + let get_index t h = (h land max_int) mod (Array.length t) + + let limit = 7 + let over_limit = 2 + + let create sz = + let sz = if sz < 7 then 7 else sz in + let sz = if sz > Sys.max_array_length then Sys.max_array_length else sz in + { + table = Array.make sz emptybucket; + hashes = Array.make sz [| |]; + limit = limit; + oversize = 0; + rover = 0; + } + + let clear t = + for i = 0 to Array.length t.table - 1 do + t.table.(i) <- emptybucket; + t.hashes.(i) <- [| |]; + done; + t.limit <- limit; + t.oversize <- 0 + + let iter_weak f t = + let rec iter_bucket i j b = + if i >= Weak.length b then () else + match Weak.check b i with + | true -> f b t.hashes.(j) i; iter_bucket (i+1) j b + | false -> iter_bucket (i+1) j b + in + for i = 0 to pred (Array.length t.table) do + iter_bucket 0 i (Array.unsafe_get t.table i) + done + + let rec count_bucket i b accu = + if i >= Weak.length b then accu else + count_bucket (i+1) b (accu + (if Weak.check b i then 1 else 0)) + + let min x y = if x - y < 0 then x else y + + let next_sz n = min (3 * n / 2 + 3) Sys.max_array_length + let prev_sz n = ((n - 3) * 2 + 2) / 3 + + let test_shrink_bucket t = + let bucket = t.table.(t.rover) in + let hbucket = t.hashes.(t.rover) in + let len = Weak.length bucket in + let prev_len = prev_sz len in + let live = count_bucket 0 bucket 0 in + if live <= prev_len then begin + let rec loop i j = + if j >= prev_len then begin + if Weak.check bucket i then loop (i + 1) j + else if Weak.check bucket j then begin + Weak.blit bucket j bucket i 1; + hbucket.(i) <- hbucket.(j); + loop (i + 1) (j - 1); + end else loop i (j - 1); + end; + in + loop 0 (Weak.length bucket - 1); + if prev_len = 0 then begin + t.table.(t.rover) <- emptybucket; + t.hashes.(t.rover) <- [| |]; + end else begin + let newbucket = Weak.create prev_len in + Weak.blit bucket 0 newbucket 0 prev_len; + t.table.(t.rover) <- newbucket; + t.hashes.(t.rover) <- Array.sub hbucket 0 prev_len + end; + if len > t.limit && prev_len <= t.limit then t.oversize <- t.oversize - 1; + end; + t.rover <- (t.rover + 1) mod (Array.length t.table) + + let rec resize t = + let oldlen = Array.length t.table in + let newlen = next_sz oldlen in + if newlen > oldlen then begin + let newt = create newlen in + let add_weak ob oh oi = + let setter nb ni _ = Weak.blit ob oi nb ni 1 in + let h = oh.(oi) in + add_aux newt setter None h (get_index newt.table h); + in + iter_weak add_weak t; + t.table <- newt.table; + t.hashes <- newt.hashes; + t.limit <- newt.limit; + t.oversize <- newt.oversize; + t.rover <- t.rover mod Array.length newt.table; + end else begin + t.limit <- max_int; (* maximum size already reached *) + t.oversize <- 0; + end + + and add_aux t setter d h index = + let bucket = t.table.(index) in + let hashes = t.hashes.(index) in + let sz = Weak.length bucket in + let rec loop i = + if i >= sz then begin + let newsz = min (3 * sz / 2 + 3) (Sys.max_array_length - 1) in + if newsz <= sz then failwith "Weak.Make: hash bucket cannot grow more"; + let newbucket = Weak.create newsz in + let newhashes = Array.make newsz 0 in + Weak.blit bucket 0 newbucket 0 sz; + Array.blit hashes 0 newhashes 0 sz; + setter newbucket sz d; + newhashes.(sz) <- h; + t.table.(index) <- newbucket; + t.hashes.(index) <- newhashes; + if sz <= t.limit && newsz > t.limit then begin + t.oversize <- t.oversize + 1; + for _i = 0 to over_limit do test_shrink_bucket t done; + end; + if t.oversize > Array.length t.table / over_limit then resize t + end else if Weak.check bucket i then begin + loop (i + 1) + end else begin + setter bucket i d; + hashes.(i) <- h + end + in + loop 0 + + let repr h d t = + let table = t.table in + let index = get_index table h in + let bucket = table.(index) in + let hashes = t.hashes.(index) in + let sz = Weak.length bucket in + let pos = ref 0 in + let ans = ref None in + while !pos < sz && !ans == None do + let i = !pos in + if Int.equal h hashes.(i) then begin + match Weak.get bucket i with + | Some v as res when E.eq v d -> ans := res + | _ -> incr pos + end else incr pos + done; + if !pos >= sz then + let () = add_aux t Weak.set (Some d) h index in + d + else match !ans with + | None -> assert false + | Some v -> v + + let stats t = + let fold accu bucket = max (count_bucket 0 bucket 0) accu in + let max_length = Array.fold_left fold 0 t.table in + let histogram = Array.make (max_length + 1) 0 in + let iter bucket = + let len = count_bucket 0 bucket 0 in + histogram.(len) <- succ histogram.(len) + in + let () = Array.iter iter t.table in + let fold (num, len, i) k = (num + k * i, len + k, succ i) in + let (num, len, _) = Array.fold_left fold (0, 0, 0) histogram in + { + num_bindings = num; + num_buckets = len; + max_bucket_length = Array.length histogram; + bucket_histogram = histogram; + } + +end + +module Combine = struct + (* These are helper functions to combine the hash keys in a similar + way as [Hashtbl.hash] does. The constants [alpha] and [beta] must + be prime numbers. There were chosen empirically. Notice that the + problem of hashing trees is hard and there are plenty of study on + this topic. Therefore, there must be room for improvement here. *) + let alpha = 65599 + let beta = 7 + let combine x y = x * alpha + y + let combine3 x y z = combine x (combine y z) + let combine4 x y z t = combine x (combine3 y z t) + let combine5 x y z t u = combine x (combine4 y z t u) + let combinesmall x y = beta * x + y +end diff -Nru coq-doc-8.6/clib/hashset.mli coq-doc-8.15.0/clib/hashset.mli --- coq-doc-8.6/clib/hashset.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/hashset.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,63 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> bool +end + +type statistics = { + num_bindings: int; + num_buckets: int; + max_bucket_length: int; + bucket_histogram: int array +} + +module type S = sig + type elt + (** Type of hashsets elements. *) + + type t + (** Type of hashsets. *) + + val create : int -> t + (** [create n] creates a fresh hashset with initial size [n]. *) + + val clear : t -> unit + (** Clear the contents of a hashset. *) + + val repr : int -> elt -> t -> elt + (** [repr key constr set] uses [key] to look for [constr] + in the hashet [set]. If [constr] is in [set], returns the + specific representation that is stored in [set]. Otherwise, + [constr] is stored in [set] and will be used as the canonical + representation of this value in the future. *) + + val stats : t -> statistics + (** Recover statistics on the table. *) +end + +module Make (E : EqType) : S with type elt = E.t + +module Combine : sig + val combine : int -> int -> int + val combinesmall : int -> int -> int + val combine3 : int -> int -> int -> int + val combine4 : int -> int -> int -> int -> int + val combine5 : int -> int -> int -> int -> int -> int +end diff -Nru coq-doc-8.6/clib/heap.ml coq-doc-8.15.0/clib/heap.ml --- coq-doc-8.6/clib/heap.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/heap.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,136 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module type S =sig + + (* Type of functional heaps *) + type t + + (* Type of elements *) + type elt + + (* The empty heap *) + val empty : t + + (* [add x h] returns a new heap containing the elements of [h], plus [x]; + complexity $O(log(n))$ *) + val add : elt -> t -> t + + (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap] + when [h] is empty; complexity $O(1)$ *) + val maximum : t -> elt + + (* [remove h] returns a new heap containing the elements of [h], except + the maximum of [h]; raises [EmptyHeap] when [h] is empty; + complexity $O(log(n))$ *) + val remove : t -> t + + (* usual iterators and combinators; elements are presented in + arbitrary order *) + val iter : (elt -> unit) -> t -> unit + + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + +end + +exception EmptyHeap + +(*s Functional implementation *) + +module Functional(X : Ordered) = struct + + (* Heaps are encoded as Braun trees, that are binary trees + where size r <= size l <= size r + 1 for each node Node (l, x, r) *) + + type t = + | Leaf + | Node of t * X.t * t + + type elt = X.t + + let empty = Leaf + + let rec add x = function + | Leaf -> + Node (Leaf, x, Leaf) + | Node (l, y, r) -> + if X.compare x y >= 0 then + Node (add y r, x, l) + else + Node (add x r, y, l) + + let rec extract = function + | Leaf -> + assert false + | Node (Leaf, y, r) -> + assert (r = Leaf); + y, Leaf + | Node (l, y, r) -> + let x, l = extract l in + x, Node (r, y, l) + + let is_above x = function + | Leaf -> true + | Node (_, y, _) -> X.compare x y >= 0 + + let rec replace_min x = function + | Node (l, _, r) when is_above x l && is_above x r -> + Node (l, x, r) + | Node ((Node (_, lx, _) as l), _, r) when is_above lx r -> + (* lx <= x, rx necessarily *) + Node (replace_min x l, lx, r) + | Node (l, _, (Node (_, rx, _) as r)) -> + (* rx <= x, lx necessarily *) + Node (l, rx, replace_min x r) + | Leaf | Node (Leaf, _, _) | Node (_, _, Leaf) -> + assert false + + (* merges two Braun trees [l] and [r], + with the assumption that [size r <= size l <= size r + 1] *) + let rec merge l r = match l, r with + | _, Leaf -> + l + | Node (ll, lx, lr), Node (_, ly, _) -> + if X.compare lx ly >= 0 then + Node (r, lx, merge ll lr) + else + let x, l = extract l in + Node (replace_min x r, ly, l) + | Leaf, _ -> + assert false (* contradicts the assumption *) + + let maximum = function + | Leaf -> raise EmptyHeap + | Node (_, x, _) -> x + + let remove = function + | Leaf -> + raise EmptyHeap + | Node (l, _, r) -> + merge l r + + let rec iter f = function + | Leaf -> () + | Node (l, x, r) -> iter f l; f x; iter f r + + let rec fold f h x0 = match h with + | Leaf -> + x0 + | Node (l, x, r) -> + fold f l (fold f r (f x x0)) + +end diff -Nru coq-doc-8.6/clib/heap.mli coq-doc-8.15.0/clib/heap.mli --- coq-doc-8.6/clib/heap.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/heap.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,54 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module type S =sig + + (** Type of functional heaps *) + type t + + (** Type of elements *) + type elt + + (** The empty heap *) + val empty : t + + (** [add x h] returns a new heap containing the elements of [h], plus [x]; + complexity {% $ %}O(log(n)){% $ %} *) + val add : elt -> t -> t + + (** [maximum h] returns the maximum element of [h]; raises [EmptyHeap] + when [h] is empty; complexity {% $ %}O(1){% $ %} *) + val maximum : t -> elt + + (** [remove h] returns a new heap containing the elements of [h], except + the maximum of [h]; raises [EmptyHeap] when [h] is empty; + complexity {% $ %}O(log(n)){% $ %} *) + val remove : t -> t + + (** usual iterators and combinators; elements are presented in + arbitrary order *) + val iter : (elt -> unit) -> t -> unit + + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + +end + +exception EmptyHeap + +(** {6 Functional implementation. } *) + +module Functional(X: Ordered) : S with type elt=X.t diff -Nru coq-doc-8.6/clib/hMap.ml coq-doc-8.15.0/clib/hMap.ml --- coq-doc-8.6/clib/hMap.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/hMap.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,458 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int + val hash : t -> int +end + +module SetMake(M : HashedType) = +struct + (** Hash Sets use hashes to prevent doing too many comparison tests. They + associate to each hash the set of keys having that hash. + + Invariants: + + 1. There is no empty set in the intmap. + 2. All values in the same set have the same hash, which is the int to + which it is associated in the intmap. + *) + + module Set = Set.Make(M) + + type elt = M.t + + type t = Set.t Int.Map.t + + let empty = Int.Map.empty + + let is_empty = Int.Map.is_empty + + let mem x s = + let h = M.hash x in + try + let m = Int.Map.find h s in + Set.mem x m + with Not_found -> false + + let add x s = + let h = M.hash x in + try + let m = Int.Map.find h s in + let m = Set.add x m in + Int.Map.set h m s + with Not_found -> + let m = Set.singleton x in + Int.Map.add h m s + + let singleton x = + let h = M.hash x in + let m = Set.singleton x in + Int.Map.singleton h m + + let remove x s = + let h = M.hash x in + try + let m = Int.Map.find h s in + let m = Set.remove x m in + if Set.is_empty m then + Int.Map.remove h s + else + Int.Map.set h m s + with Not_found -> s + + let height s = Int.Map.height s + + let is_smaller s1 s2 = height s1 <= height s2 + 3 + + (** Assumes s1 << s2 *) + let fast_union s1 s2 = + let fold h s accu = + try Int.Map.modify h (fun _ s' -> Set.fold Set.add s s') accu + with Not_found -> Int.Map.add h s accu + in + Int.Map.fold fold s1 s2 + + let union s1 s2 = + if is_smaller s1 s2 then fast_union s1 s2 + else if is_smaller s2 s1 then fast_union s2 s1 + else + let fu _ m1 m2 = match m1, m2 with + | None, None -> None + | (Some _ as m), None | None, (Some _ as m) -> m + | Some m1, Some m2 -> Some (Set.union m1 m2) + in + Int.Map.merge fu s1 s2 + + (** Assumes s1 << s2 *) + let fast_inter s1 s2 = + let fold h s accu = + try + let s' = Int.Map.find h s2 in + let si = Set.filter (fun e -> Set.mem e s') s in + if Set.is_empty si then accu + else Int.Map.add h si accu + with Not_found -> accu + in + Int.Map.fold fold s1 Int.Map.empty + + let inter s1 s2 = + if is_smaller s1 s2 then fast_inter s1 s2 + else if is_smaller s2 s1 then fast_inter s2 s1 + else + let fu _ m1 m2 = match m1, m2 with + | None, None -> None + | Some _, None | None, Some _ -> None + | Some m1, Some m2 -> + let m = Set.inter m1 m2 in + if Set.is_empty m then None else Some m + in + Int.Map.merge fu s1 s2 + + (** Assumes s1 << s2 *) + let fast_diff_l s1 s2 = + let fold h s accu = + try + let s' = Int.Map.find h s2 in + let si = Set.filter (fun e -> not (Set.mem e s')) s in + if Set.is_empty si then accu + else Int.Map.add h si accu + with Not_found -> Int.Map.add h s accu + in + Int.Map.fold fold s1 Int.Map.empty + + (** Assumes s2 << s1 *) + let fast_diff_r s1 s2 = + let fold h s accu = + try + let s' = Int.Map.find h accu in + let si = Set.filter (fun e -> not (Set.mem e s)) s' in + if Set.is_empty si then Int.Map.remove h accu + else Int.Map.set h si accu + with Not_found -> accu + in + Int.Map.fold fold s2 s1 + + let diff s1 s2 = + if is_smaller s1 s2 then fast_diff_l s1 s2 + else if is_smaller s2 s2 then fast_diff_r s1 s2 + else + let fu _ m1 m2 = match m1, m2 with + | None, None -> None + | (Some _ as m), None -> m + | None, Some _ -> None + | Some m1, Some m2 -> + let m = Set.diff m1 m2 in + if Set.is_empty m then None else Some m + in + Int.Map.merge fu s1 s2 + + let compare s1 s2 = Int.Map.compare Set.compare s1 s2 + + let equal s1 s2 = Int.Map.equal Set.equal s1 s2 + + let subset s1 s2 = + let check h m1 = + let m2 = try Int.Map.find h s2 with Not_found -> Set.empty in + Set.subset m1 m2 + in + Int.Map.for_all check s1 + + let iter f s = + let fi _ m = Set.iter f m in + Int.Map.iter fi s + + let fold f s accu = + let ff _ m accu = Set.fold f m accu in + Int.Map.fold ff s accu + + let for_all f s = + let ff _ m = Set.for_all f m in + Int.Map.for_all ff s + + let exists f s = + let fe _ m = Set.exists f m in + Int.Map.exists fe s + + let filter f s = + let ff m = Set.filter f m in + let s = Int.Map.map ff s in + Int.Map.filter (fun _ m -> not (Set.is_empty m)) s + + let partition f s = + let fold h m (sl, sr) = + let (ml, mr) = Set.partition f m in + let sl = if Set.is_empty ml then sl else Int.Map.add h ml sl in + let sr = if Set.is_empty mr then sr else Int.Map.add h mr sr in + (sl, sr) + in + Int.Map.fold fold s (Int.Map.empty, Int.Map.empty) + + let cardinal s = + let fold _ m accu = accu + Set.cardinal m in + Int.Map.fold fold s 0 + + let elements s = + let fold _ m accu = Set.fold (fun x accu -> x :: accu) m accu in + Int.Map.fold fold s [] + + let min_elt _ = assert false (** Cannot be implemented efficiently *) + + let max_elt _ = assert false (** Cannot be implemented efficiently *) + + let choose s = + let (_, m) = Int.Map.choose s in + Set.choose m + + let split s x = assert false (** Cannot be implemented efficiently *) + +end + +module Make(M : HashedType) = +struct + (** This module is essentially the same as SetMake, except that we have maps + instead of sets in the intmap. Invariants are the same. *) + module Set = SetMake(M) + module Map = CMap.Make(M) + + type key = M.t + + type 'a t = 'a Map.t Int.Map.t + + let empty = Int.Map.empty + + let is_empty = Int.Map.is_empty + + let mem k s = + let h = M.hash k in + try + let m = Int.Map.find h s in + Map.mem k m + with Not_found -> false + + let add k x s = + let h = M.hash k in + try + let m = Int.Map.find h s in + let m = Map.add k x m in + Int.Map.set h m s + with Not_found -> + let m = Map.singleton k x in + Int.Map.add h m s + + (* when Coq requires OCaml 4.06 or later, the module type + CSig.MapS may include the signature of OCaml's "update", + requiring an implementation here, which could be just: + + let update k f s = assert false (* not implemented *) + + *) + + let singleton k x = + let h = M.hash k in + Int.Map.singleton h (Map.singleton k x) + + let remove k s = + let h = M.hash k in + try + let m = Int.Map.find h s in + let m = Map.remove k m in + if Map.is_empty m then + Int.Map.remove h s + else + Int.Map.set h m s + with Not_found -> s + + let merge f s1 s2 = + let fm h m1 m2 = match m1, m2 with + | None, None -> None + | Some m, None -> + let m = Map.merge f m Map.empty in + if Map.is_empty m then None + else Some m + | None, Some m -> + let m = Map.merge f Map.empty m in + if Map.is_empty m then None + else Some m + | Some m1, Some m2 -> + let m = Map.merge f m1 m2 in + if Map.is_empty m then None + else Some m + in + Int.Map.merge fm s1 s2 + + let union f s1 s2 = + let fm h m1 m2 = + let m = Map.union f m1 m2 in + if Map.is_empty m then None + else Some m + in + Int.Map.union fm s1 s2 + + let compare f s1 s2 = + let fc m1 m2 = Map.compare f m1 m2 in + Int.Map.compare fc s1 s2 + + let equal f s1 s2 = + let fe m1 m2 = Map.equal f m1 m2 in + Int.Map.equal fe s1 s2 + + let iter f s = + let fi _ m = Map.iter f m in + Int.Map.iter fi s + + let fold f s accu = + let ff _ m accu = Map.fold f m accu in + Int.Map.fold ff s accu + + let for_all f s = + let ff _ m = Map.for_all f m in + Int.Map.for_all ff s + + let exists f s = + let fe _ m = Map.exists f m in + Int.Map.exists fe s + + let filter f s = + let ff m = Map.filter f m in + let s = Int.Map.map ff s in + Int.Map.filter (fun _ m -> not (Map.is_empty m)) s + + let partition f s = + let fold h m (sl, sr) = + let (ml, mr) = Map.partition f m in + let sl = if Map.is_empty ml then sl else Int.Map.add h ml sl in + let sr = if Map.is_empty mr then sr else Int.Map.add h mr sr in + (sl, sr) + in + Int.Map.fold fold s (Int.Map.empty, Int.Map.empty) + + let cardinal s = + let fold _ m accu = accu + Map.cardinal m in + Int.Map.fold fold s 0 + + let bindings s = + let fold _ m accu = Map.fold (fun k x accu -> (k, x) :: accu) m accu in + Int.Map.fold fold s [] + + let min_binding _ = assert false (** Cannot be implemented efficiently *) + + let max_binding _ = assert false (** Cannot be implemented efficiently *) + + let fold_left _ _ _ = assert false (** Cannot be implemented efficiently *) + + let fold_right _ _ _ = assert false (** Cannot be implemented efficiently *) + + let choose s = + let (_, m) = Int.Map.choose s in + Map.choose m + + let choose_opt s = + try Some (choose s) + with Not_found -> None + + let find k s = + let h = M.hash k in + let m = Int.Map.find h s in + Map.find k m + + let find_opt k s = + let h = M.hash k in + match Int.Map.find_opt h s with + | None -> None + | Some m -> Map.find_opt k m + + let get k s = + let h = M.hash k in + let m = Int.Map.get h s in + Map.get k m + + let split k s = assert false (** Cannot be implemented efficiently *) + + let map f s = + let fs m = Map.map f m in + Int.Map.map fs s + + let mapi f s = + let fs m = Map.mapi f m in + Int.Map.map fs s + + let modify k f s = + let h = M.hash k in + let m = Int.Map.find h s in + let m = Map.modify k f m in + Int.Map.set h m s + + let bind f s = + let fb m = Map.bind f m in + Int.Map.map fb s + + let domain s = Int.Map.map Map.domain s + + let set k x s = + let h = M.hash k in + let m = Int.Map.find h s in + let m = Map.set k x m in + Int.Map.set h m s + + module Smart = + struct + + let map f s = + let fs m = Map.Smart.map f m in + Int.Map.Smart.map fs s + + let mapi f s = + let fs m = Map.Smart.mapi f m in + Int.Map.Smart.map fs s + + end + + let height s = Int.Map.height s + + (* Not as efficient as the original version *) + let filter_range f s = + filter (fun x _ -> f x = 0) s + + let update k f m = + let aux = function + | None -> (match f None with + | None -> None + | Some v -> Some (Map.singleton k v)) + | Some m -> + let m = Map.update k f m in + if Map.is_empty m then None + else Some m + in + Int.Map.update (M.hash k) aux m + + module Unsafe = + struct + let map f s = + let fs m = Map.Unsafe.map f m in + Int.Map.map fs s + end + + module Monad(M : CMap.MonadS) = + struct + module IntM = Int.Map.Monad(M) + module ExtM = Map.Monad(M) + + let fold f s accu = + let ff _ m accu = ExtM.fold f m accu in + IntM.fold ff s accu + + let fold_left _ _ _ = assert false + let fold_right _ _ _ = assert false + end + +end diff -Nru coq-doc-8.6/clib/hMap.mli coq-doc-8.15.0/clib/hMap.mli --- coq-doc-8.6/clib/hMap.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/hMap.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,31 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int + (** Total ordering *) + + val hash : t -> int + (** Hashing function compatible with [compare], i.e. [compare x y = 0] implies + [hash x = hash y]. *) +end + +(** Hash maps are maps that take advantage of having a hash on keys. This is + essentially a hash table, except that it uses purely functional maps instead + of arrays. + + CAVEAT: order-related functions like [fold] or [iter] do not respect the + provided order anymore! It's your duty to do something sensible to prevent + this if you need it. In particular, [min_binding] and [max_binding] are now + made meaningless. +*) +module Make(M : HashedType) : CMap.ExtS with type key = M.t diff -Nru coq-doc-8.6/clib/int.ml coq-doc-8.15.0/clib/int.ml --- coq-doc-8.6/clib/int.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/int.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,253 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* int -> bool = "%eq" + +external compare : int -> int -> int = "caml_int_compare" + +let hash i = i land 0x3FFFFFFF + +module Self = +struct + type t = int + let compare = compare +end + +module Set = Set.Make(Self) +module Map = +struct + include CMap.Make(Self) + + type 'a map = 'a CMap.Make(Self).t + + type 'a _map = + | MEmpty + | MNode of 'a map * int * 'a * 'a map * int + + let map_prj : 'a map -> 'a _map = Obj.magic + + let rec find i s = match map_prj s with + | MEmpty -> raise Not_found + | MNode (l, k, v, r, h) -> + if i < k then find i l + else if i = k then v + else find i r + + let rec get i s = match map_prj s with + | MEmpty -> assert false + | MNode (l, k, v, r, h) -> + if i < k then get i l + else if i = k then v + else get i r + + let rec find_opt i s = match map_prj s with + | MEmpty -> None + | MNode (l, k, v, r, h) -> + if i < k then find_opt i l + else if i = k then Some v + else find_opt i r +end + +module List = struct + let mem = List.memq + let assoc = List.assq + let mem_assoc = List.mem_assq + let remove_assoc = List.remove_assq +end + +let min (i : int) j = if i < j then i else j + +(** Utility function *) +let rec next from upto = + if from < upto then next (2 * from + 1) upto + else from + + +module PArray = +struct + + type 'a t = 'a data ref + and 'a data = + | Root of 'a option array + | DSet of int * 'a option * 'a t + + let empty n = ref (Root (Array.make n None)) + + let rec rerootk t k = match !t with + | Root _ -> k () + | DSet (i, v, t') -> + let next () = match !t' with + | Root a as n -> + let v' = Array.unsafe_get a i in + let () = Array.unsafe_set a i v in + let () = t := n in + let () = t' := DSet (i, v', t) in + k () + | DSet _ -> assert false + in + rerootk t' next + + let reroot t = rerootk t (fun () -> ()) + + let get t i = + let () = assert (0 <= i) in + match !t with + | Root a -> + if Array.length a <= i then None + else Array.unsafe_get a i + | DSet _ -> + let () = reroot t in + match !t with + | Root a -> + if Array.length a <= i then None + else Array.unsafe_get a i + | DSet _ -> assert false + + let set t i v = + let () = assert (0 <= i) in + let () = reroot t in + match !t with + | DSet _ -> assert false + | Root a as n -> + let len = Array.length a in + if i < len then + let old = Array.unsafe_get a i in + if old == v then t + else + let () = Array.unsafe_set a i v in + let res = ref n in + let () = t := DSet (i, old, res) in + res + else match v with + | None -> t (* Nothing to do! *) + | Some _ -> (* we must resize *) + let nlen = next len (succ i) in + let nlen = min nlen Sys.max_array_length in + let () = assert (i < nlen) in + let a' = Array.make nlen None in + let () = Array.blit a 0 a' 0 len in + let () = Array.unsafe_set a' i v in + let res = ref (Root a') in + let () = t := DSet (i, None, res) in + res + +end + +module PMap = +struct + + type key = int + + (** Invariants: + + 1. an empty map is always [Empty]. + 2. the set of the [Map] constructor remembers the present keys. + *) + type 'a t = Empty | Map of Set.t * 'a PArray.t + + let empty = Empty + + let is_empty = function + | Empty -> true + | Map _ -> false + + let singleton k x = + let len = next 19 (k + 1) in + let len = min Sys.max_array_length len in + let v = PArray.empty len in + let v = PArray.set v k (Some x) in + let s = Set.singleton k in + Map (s, v) + + let add k x = function + | Empty -> singleton k x + | Map (s, v) -> + let s = match PArray.get v k with + | None -> Set.add k s + | Some _ -> s + in + let v = PArray.set v k (Some x) in + Map (s, v) + + let remove k = function + | Empty -> Empty + | Map (s, v) -> + let s = Set.remove k s in + if Set.is_empty s then Empty + else + let v = PArray.set v k None in + Map (s, v) + + let mem k = function + | Empty -> false + | Map (_, v) -> + match PArray.get v k with + | None -> false + | Some _ -> true + + let find k = function + | Empty -> raise Not_found + | Map (_, v) -> + match PArray.get v k with + | None -> raise Not_found + | Some x -> x + + let iter f = function + | Empty -> () + | Map (s, v) -> + let iter k = match PArray.get v k with + | None -> () + | Some x -> f k x + in + Set.iter iter s + + let fold f m accu = match m with + | Empty -> accu + | Map (s, v) -> + let fold k accu = match PArray.get v k with + | None -> accu + | Some x -> f k x accu + in + Set.fold fold s accu + + let exists f m = match m with + | Empty -> false + | Map (s, v) -> + let exists k = match PArray.get v k with + | None -> false + | Some x -> f k x + in + Set.exists exists s + + let for_all f m = match m with + | Empty -> true + | Map (s, v) -> + let for_all k = match PArray.get v k with + | None -> true + | Some x -> f k x + in + Set.for_all for_all s + + let cast = function + | Empty -> Map.empty + | Map (s, v) -> + let bind k = match PArray.get v k with + | None -> assert false + | Some x -> x + in + Map.bind bind s + + let domain = function + | Empty -> Set.empty + | Map (s, _) -> s + +end diff -Nru coq-doc-8.6/clib/int.mli coq-doc-8.15.0/clib/int.mli --- coq-doc-8.6/clib/int.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/int.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,84 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> bool = "%eq" + +external compare : t -> t -> int = "caml_int_compare" + +val hash : t -> int + +module Set : Set.S with type elt = t +module Map : CMap.ExtS with type key = t and module Set := Set + +module List : sig + val mem : int -> int list -> bool + val assoc : int -> (int * 'a) list -> 'a + val mem_assoc : int -> (int * 'a) list -> bool + val remove_assoc : int -> (int * 'a) list -> (int * 'a) list +end + +module PArray : +sig + type 'a t + (** Persistent, auto-resizable arrays. The [get] and [set] functions never + fail whenever the index is between [0] and [Sys.max_array_length - 1]. *) + + val empty : int -> 'a t + (** The empty array, with a given starting size. *) + + val get : 'a t -> int -> 'a option + (** Get a value at the given index. Returns [None] if undefined. *) + + val set : 'a t -> int -> 'a option -> 'a t + (** Set/unset a value at the given index. *) +end + +module PMap : +sig + type key = int + type 'a t + val empty : 'a t + val is_empty : 'a t -> bool + val mem : key -> 'a t -> bool + val add : key -> 'a -> 'a t -> 'a t + val singleton : key -> 'a -> 'a t + val remove : key -> 'a t -> 'a t +(* val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t *) +(* val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int *) +(* val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool *) + val iter : (key -> 'a -> unit) -> 'a t -> unit + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val for_all : (key -> 'a -> bool) -> 'a t -> bool + val exists : (key -> 'a -> bool) -> 'a t -> bool +(* val filter : (key -> 'a -> bool) -> 'a t -> 'a t *) +(* val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t *) +(* val cardinal : 'a t -> int *) +(* val bindings : 'a t -> (key * 'a) list *) +(* val min_binding : 'a t -> key * 'a *) +(* val max_binding : 'a t -> key * 'a *) +(* val choose : 'a t -> key * 'a *) +(* val split : key -> 'a t -> 'a t * 'a option * 'a t *) + val find : key -> 'a t -> 'a +(* val map : ('a -> 'b) -> 'a t -> 'b t *) +(* val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t *) + val domain : 'a t -> Set.t + val cast : 'a t -> 'a Map.t +end +(** This is a (partial) implementation of a [Map] interface on integers, except + that it internally uses persistent arrays. This ensures O(1) accesses in + non-backtracking cases. It is thus better suited for zero-starting, + contiguous keys, or otherwise a lot of space will be empty. To keep track of + the present keys, a binary tree is also used, so that adding a key is + still logarithmic. It is therefore essential that most of the operations + are accesses and not add/removes. *) diff -Nru coq-doc-8.6/clib/iStream.ml coq-doc-8.15.0/clib/iStream.ml --- coq-doc-8.6/clib/iStream.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/iStream.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,84 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* Nil +| Cons (x,s) -> app_node (peek (f x)) (concat_map f s) + +and concat_map f l = lazy (concat_map_node f (peek l)) diff -Nru coq-doc-8.6/clib/iStream.mli coq-doc-8.15.0/clib/iStream.mli --- coq-doc-8.6/clib/iStream.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/iStream.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,80 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a t -> 'a t +(** Append an element in front of a stream. *) + +val thunk : (unit -> 'a node) -> 'a t +(** Internalize the laziness of a stream. *) + +(** {6 Destructors} *) + +val is_empty : 'a t -> bool +(** Whethere a stream is empty. *) + +val peek : 'a t -> 'a node +(** Return the head and the tail of a stream, if any. *) + +(** {6 Standard operations} + + All stream-returning functions are lazy. The other ones are eager. *) + +val app : 'a t -> 'a t -> 'a t +(** Append two streams. Not tail-rec. *) + +val map : ('a -> 'b) -> 'a t -> 'b t +(** Mapping of streams. Not tail-rec. *) + +val iter : ('a -> unit) -> 'a t -> unit +(** Iteration over streams. *) + +val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a +(** Fold over streams. *) + +val concat : 'a t t -> 'a t +(** Appends recursively a stream of streams. *) + +val map_filter : ('a -> 'b option) -> 'a t -> 'b t +(** Mixing [map] and [filter]. Not tail-rec. *) + +val concat_map : ('a -> 'b t) -> 'a t -> 'b t +(** [concat_map f l] is the same as [concat (map f l)]. *) + +(** {6 Conversions} *) + +val of_list : 'a list -> 'a t +(** Convert a list into a stream. *) + +val to_list : 'a t -> 'a list +(** Convert a stream into a list. *) + +(** {6 Other}*) + +val force : 'a t -> 'a t +(** Forces the whole stream. *) diff -Nru coq-doc-8.6/clib/minisys.ml coq-doc-8.15.0/clib/minisys.ml --- coq-doc-8.6/clib/minisys.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/minisys.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,80 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* true | _ -> false + +(* Check directory can be opened *) + +let exists_dir dir = + (* See BZ#5391 on windows failing on a trailing (back)slash *) + let rec strip_trailing_slash dir = + let len = String.length dir in + if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\') + then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in + let dir = if Sys.os_type = "Win32" then strip_trailing_slash dir else dir in + try Sys.is_directory dir with Sys_error _ -> false + +let apply_subdir f path name = + (* we avoid all files and subdirs starting by '.' (e.g. .svn) *) + (* as well as skipped files like CVS, ... *) + let base = try Filename.chop_extension name with Invalid_argument _ -> name in + if ok_dirname base then + let path = if path = "." then name else path//name in + match try (Unix.stat path).Unix.st_kind with Unix.Unix_error _ -> Unix.S_BLK with + | Unix.S_DIR when name = base -> f (FileDir (path,name)) + | Unix.S_REG -> f (FileRegular name) + | _ -> () + +let readdir dir = try Sys.readdir dir with any -> [||] + +let process_directory f path = + Array.iter (apply_subdir f path) (readdir path) + +let process_subdirectories f path = + let f = function FileDir (path,base) -> f path base | FileRegular _ -> () in + process_directory f path diff -Nru coq-doc-8.6/clib/monad.ml coq-doc-8.15.0/clib/monad.ml --- coq-doc-8.6/clib/monad.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/monad.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,170 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (>>) : unit t -> 'a t -> 'a t + val map : ('a -> 'b) -> 'a t -> 'b t + + (** The monadic laws must hold: + - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)] + - [return a >>= f] = [f a] + - [x>>=return] = [x] + + As well as the following identities: + - [x >> y] = [x >>= fun () -> y] + - [map f x] = [x >>= fun x' -> f x'] *) + +end + +module type ListS = sig + + type 'a t + + (** [List.map f l] maps [f] on the elements of [l] in left to right + order. *) + val map : ('a -> 'b t) -> 'a list -> 'b list t + + (** [List.map f l] maps [f] on the elements of [l] in right to left + order. *) + val map_right : ('a -> 'b t) -> 'a list -> 'b list t + + (** Like the regular [List.fold_right]. The monadic effects are + threaded right to left. + + Note: many monads behave poorly with right-to-left order. For + instance a failure monad would still have to traverse the + whole list in order to fail and failure needs to be propagated + through the rest of the list in binds which are now + spurious. It is also the worst case for substitution monads + (aka free monads), exposing the quadratic behaviour.*) + val fold_right : ('a -> 'b -> 'b t) -> 'a list -> 'b -> 'b t + + (** Like the regular [List.fold_left]. The monadic effects are + threaded left to right. It is tail-recursive if the [(>>=)] + operator calls its second argument in a tail position. *) + val fold_left : ('a -> 'b -> 'a t) -> 'a -> 'b list -> 'a t + + (** Like the regular [List.iter]. The monadic effects are threaded + left to right. It is tail-recurisve if the [>>] operator calls + its second argument in a tail position. *) + val iter : ('a -> unit t) -> 'a list -> unit t + + (** Like the regular {!CList.map_filter}. The monadic effects are threaded left*) + val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t + + + (** {6 Two-list iterators} *) + + (** [fold_left2 r f s l1 l2] behaves like {!fold_left} but acts + simultaneously on two lists. Runs [r] (presumably an + exception-raising computation) if both lists do not have the + same length. *) + val fold_left2 : 'a t -> + ('a -> 'b -> 'c -> 'a t) -> 'a -> 'b list -> 'c list -> 'a t + +end + +module type S = sig + + include Def + + (** List combinators *) + module List : ListS with type 'a t := 'a t + +end + + +module Make (M:Def) : S with type +'a t = 'a M.t = struct + + include M + + module List = struct + + (* The combinators are loop-unrolled to spare a some monadic binds + (it is a common optimisation to treat the last of a list of + bind specially) and hopefully gain some efficiency using fewer + jump. *) + + let rec map f = function + | [] -> return [] + | [a] -> + M.map (fun a' -> [a']) (f a) + | a::b::l -> + f a >>= fun a' -> + f b >>= fun b' -> + M.map (fun l' -> a'::b'::l') (map f l) + + let rec map_right f = function + | [] -> return [] + | [a] -> + M.map (fun a' -> [a']) (f a) + | a::b::l -> + map_right f l >>= fun l' -> + f b >>= fun b' -> + M.map (fun a' -> a'::b'::l') (f a) + + let rec fold_right f l x = + match l with + | [] -> return x + | [a] -> f a x + | a::b::l -> + fold_right f l x >>= fun acc -> + f b acc >>= fun acc -> + f a acc + + let rec fold_left f x = function + | [] -> return x + | [a] -> f x a + | a::b::l -> + f x a >>= fun x' -> + f x' b >>= fun x'' -> + fold_left f x'' l + + let rec iter f = function + | [] -> return () + | [a] -> f a + | a::b::l -> f a >> f b >> iter f l + + + let rec map_filter f = function + | [] -> return [] + | a::l -> + f a >>= function + | None -> map_filter f l + | Some b -> + map_filter f l >>= fun filtered -> + return (b::filtered) + + let rec fold_left2 r f x l1 l2 = + match l1,l2 with + | [] , [] -> return x + | [a] , [b] -> f x a b + | a1::a2::l1 , b1::b2::l2 -> + f x a1 b1 >>= fun x' -> + f x' a2 b2 >>= fun x'' -> + fold_left2 r f x'' l1 l2 + | _ , _ -> r + + end + +end + + + diff -Nru coq-doc-8.6/clib/monad.mli coq-doc-8.15.0/clib/monad.mli --- coq-doc-8.6/clib/monad.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/monad.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,96 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (>>) : unit t -> 'a t -> 'a t + val map : ('a -> 'b) -> 'a t -> 'b t + +(** The monadic laws must hold: + - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)] + - [return a >>= f] = [f a] + - [x>>=return] = [x] + + As well as the following identities: + - [x >> y] = [x >>= fun () -> y] + - [map f x] = [x >>= fun x' -> f x'] *) + +end + + +(** List combinators *) +module type ListS = sig + + type 'a t + + (** [List.map f l] maps [f] on the elements of [l] in left to right + order. *) + val map : ('a -> 'b t) -> 'a list -> 'b list t + + (** [List.map f l] maps [f] on the elements of [l] in right to left + order. *) + val map_right : ('a -> 'b t) -> 'a list -> 'b list t + + (** Like the regular [List.fold_right]. The monadic effects are + threaded right to left. + + Note: many monads behave poorly with right-to-left order. For + instance a failure monad would still have to traverse the + whole list in order to fail and failure needs to be propagated + through the rest of the list in binds which are now + spurious. It is also the worst case for substitution monads + (aka free monads), exposing the quadratic behaviour.*) + val fold_right : ('a -> 'b -> 'b t) -> 'a list -> 'b -> 'b t + + (** Like the regular [List.fold_left]. The monadic effects are + threaded left to right. It is tail-recursive if the [(>>=)] + operator calls its second argument in a tail position. *) + val fold_left : ('a -> 'b -> 'a t) -> 'a -> 'b list -> 'a t + + (** Like the regular [List.iter]. The monadic effects are threaded + left to right. It is tail-recurisve if the [>>] operator calls + its second argument in a tail position. *) + val iter : ('a -> unit t) -> 'a list -> unit t + + (** Like the regular {!CList.map_filter}. The monadic effects are + threaded left to right. *) + val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t + + + (** {6 Two-list iterators} *) + + (** [fold_left2 r f s l1 l2] behaves like {!fold_left} but acts + simultaneously on two lists. Runs [r] (presumably an + exception-raising computation) if both lists do not have the + same length. *) + val fold_left2 : 'a t -> + ('a -> 'b -> 'c -> 'a t) -> 'a -> 'b list -> 'c list -> 'a t + +end + +module type S = sig + + include Def + + module List : ListS with type 'a t := 'a t + +end + +(** Expands the monadic definition to extra combinators. *) +module Make (M:Def) : S with type +'a t = 'a M.t diff -Nru coq-doc-8.6/clib/neList.ml coq-doc-8.15.0/clib/neList.ml --- coq-doc-8.6/clib/neList.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/neList.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,49 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* None + | y::tl -> Some (y,tl) + +let singleton x = x,[] + +let iter f (x,tl) = + f x; + List.iter f tl + +let map f (x,tl) = + let x = f x in + let tl = List.map f tl in + x, tl + +let map2 f (x,tl) (x',tl') = + let x = f x x' in + let tl = List.map2 f tl tl' in + x, tl + +let map_head f (x,tl) = f x, tl + +let push x = function + | None -> x, [] + | Some (y,tl) -> x, y::tl + +let to_list (x,tl) = x::tl + +let of_list = function + | [] -> invalid_arg "NeList.of_list" + | x::tl -> x,tl + +let repr x = x + +let of_repr x = x diff -Nru coq-doc-8.6/clib/neList.mli coq-doc-8.15.0/clib/neList.mli --- coq-doc-8.6/clib/neList.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/neList.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,37 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a + +val tail : 'a t -> 'a t option + +val singleton : 'a -> 'a t + +val iter : ('a -> unit) -> 'a t -> unit + +val map : ('a -> 'b) -> 'a t -> 'b t + +val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t + +val map_head : ('a -> 'a) -> 'a t -> 'a t + +val push : 'a -> 'a t option -> 'a t + +val to_list : 'a t -> 'a list + +(** May raise Invalid_argument *) +val of_list : 'a list -> 'a t + +val repr : 'a t -> 'a * 'a list + +val of_repr : 'a * 'a list -> 'a t diff -Nru coq-doc-8.6/clib/option.ml coq-doc-8.15.0/clib/option.ml --- coq-doc-8.6/clib/option.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/option.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,218 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* false + | _ -> true + +let is_empty = function + | None -> true + | Some _ -> false + +(** Lifting equality onto option types. *) +let equal f x y = match x, y with + | None, None -> true + | Some x, Some y -> f x y + | _, _ -> false + +let compare f x y = match x, y with + | None, None -> 0 + | Some x, Some y -> f x y + | None, Some _ -> -1 + | Some _, None -> 1 + +let hash f = function + | None -> 0 + | Some x -> f x + +exception IsNone + +(** [get x] returns [y] where [x] is [Some y]. + @raise IsNone if [x] equals [None]. *) +let get = function + | Some y -> y + | _ -> raise IsNone + +(** [make x] returns [Some x]. *) +let make x = Some x + +(** [bind x f] is [f y] if [x] is [Some y] and [None] otherwise *) +let bind x f = match x with Some y -> f y | None -> None + +let filter f x = bind x (fun v -> if f v then x else None) + +(** [init b x] returns [Some x] if [b] is [true] and [None] otherwise. *) +let init b x = + if b then + Some x + else + None + +(** [flatten x] is [Some y] if [x] is [Some (Some y)] and [None] otherwise. *) +let flatten = function + | Some (Some y) -> Some y + | _ -> None + +(** [append x y] is the first element of the concatenation of [x] and + [y] seen as lists. *) +let append o1 o2 = + match o1 with + | Some _ -> o1 + | None -> o2 + + +(** {6 "Iterators"} ***) + +(** [iter f x] executes [f y] if [x] equals [Some y]. It does nothing + otherwise. *) +let iter f = function + | Some y -> f y + | _ -> () + + +exception Heterogeneous + +(** [iter2 f x y] executes [f z w] if [x] equals [Some z] and [y] equals + [Some w]. It does nothing if both [x] and [y] are [None]. And raises + [Heterogeneous] otherwise. *) +let iter2 f x y = + match x,y with + | Some z, Some w -> f z w + | None,None -> () + | _,_ -> raise Heterogeneous + +(** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *) +let map f = function + | Some y -> Some (f y) + | _ -> None + +(** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *) +let fold_left f a = function + | Some y -> f a y + | _ -> a + +(** [fold_left2 f a x y] is [f z w] if [x] is [Some z] and [y] is [Some w]. + It is [a] if both [x] and [y] are [None]. Otherwise it raises + [Heterogeneous]. *) +let fold_left2 f a x y = + match x,y with + | Some x, Some y -> f a x y + | None, None -> a + | _ -> raise Heterogeneous + +(** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *) +let fold_right f x a = + match x with + | Some y -> f y a + | _ -> a + +(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *) +let fold_left_map f a x = + match x with + | Some y -> let a, z = f a y in a, Some z + | _ -> a, None + +let fold_right_map f x a = + match x with + | Some y -> let z, a = f y a in Some z, a + | _ -> None, a + +(** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *) +let cata f a = function + | Some c -> f c + | None -> a + + +(** {6 More Specific operations} ***) + +(** [default a x] is [y] if [x] is [Some y] and [a] otherwise. *) +let default a = function + | Some y -> y + | _ -> a + +(** [lift f x] is the same as [map f x]. *) +let lift = map + +(** [lift_right f a x] is [Some (f a y)] if [x] is [Some y], and + [None] otherwise. *) +let lift_right f a = function + | Some y -> Some (f a y) + | _ -> None + +(** [lift_left f x a] is [Some (f y a)] if [x] is [Some y], and + [None] otherwise. *) +let lift_left f x a = + match x with + | Some y -> Some (f y a) + | _ -> None + +(** [lift2 f x y] is [Some (f z w)] if [x] equals [Some z] and [y] equals + [Some w]. It is [None] otherwise. *) +let lift2 f x y = + match x,y with + | Some z, Some w -> Some (f z w) + | _,_ -> None + + +(** {6 Smart operations} *) + +module Smart = +struct + + (** [Smart.map f x] does the same as [map f x] except that it tries to share + some memory. *) + let map f = function + | Some y as x -> let y' = f y in if y' == y then x else Some y' + | _ -> None + +end + +(** {6 Operations with Lists} *) + +module List = + struct + (** [List.cons x l] equals [y::l] if [x] is [Some y] and [l] otherwise. *) + let cons x l = + match x with + | Some y -> y::l + | _ -> l + + (** [List.flatten l] is the list of all the [y]s such that [l] contains + [Some y] (in the same order). *) + let rec flatten = function + | x::l -> cons x (flatten l) + | [] -> [] + + let rec find f = function + | [] -> None + | h :: t -> match f h with + | None -> find f t + | x -> x + + let map f l = + let rec aux f l = match l with + | [] -> [] + | x :: l -> + match f x with + | None -> raise Exit + | Some y -> y :: aux f l + in + try Some (aux f l) with Exit -> None + +end diff -Nru coq-doc-8.6/clib/option.mli coq-doc-8.15.0/clib/option.mli --- coq-doc-8.6/clib/option.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/option.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,152 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* bool + +(** Negation of [has_some] *) +val is_empty : 'a option -> bool + +(** [equal f x y] lifts the equality predicate [f] to + option types. That is, if both [x] and [y] are [None] then + it returns [true], if they are both [Some _] then + [f] is called. Otherwise it returns [false]. *) +val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool + +(** Same as [equal], but with comparison. *) +val compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int + +(** Lift a hash to option types. *) +val hash : ('a -> int) -> 'a option -> int + +(** [get x] returns [y] where [x] is [Some y]. + @raise IsNone if [x] equals [None]. *) +val get : 'a option -> 'a + +(** [make x] returns [Some x]. *) +val make : 'a -> 'a option + +(** [bind x f] is [f y] if [x] is [Some y] and [None] otherwise *) +val bind : 'a option -> ('a -> 'b option) -> 'b option + +(** [filter f x] is [x] if [x] [Some y] and [f y] is true, [None] otherwise *) +val filter : ('a -> bool) -> 'a option -> 'a option + +(** [init b x] returns [Some x] if [b] is [true] and [None] otherwise. *) +val init : bool -> 'a -> 'a option + +(** [flatten x] is [Some y] if [x] is [Some (Some y)] and [None] otherwise. *) +val flatten : 'a option option -> 'a option + +(** [append x y] is the first element of the concatenation of [x] and + [y] seen as lists. In other words, [append (Some a) y] is [Some + a], [append None (Some b)] is [Some b], and [append None None] is + [None]. *) +val append : 'a option -> 'a option -> 'a option + + +(** {6 "Iterators"} *) + +(** [iter f x] executes [f y] if [x] equals [Some y]. It does nothing + otherwise. *) +val iter : ('a -> unit) -> 'a option -> unit + +exception Heterogeneous + +(** [iter2 f x y] executes [f z w] if [x] equals [Some z] and [y] equals + [Some w]. It does nothing if both [x] and [y] are [None]. + @raise Heterogeneous otherwise. *) +val iter2 : ('a -> 'b -> unit) -> 'a option -> 'b option -> unit + +(** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *) +val map : ('a -> 'b) -> 'a option -> 'b option + +(** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *) +val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a option -> 'b + +(** [fold_left2 f a x y] is [f z w] if [x] is [Some z] and [y] is [Some w]. + It is [a] if both [x] and [y] are [None]. + @raise Heterogeneous otherwise. *) +val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option -> 'c option -> 'a + +(** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *) +val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b + +(** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *) +val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option + +(** Same as [fold_left_map] on the right *) +val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a + +(** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *) +val cata : ('a -> 'b) -> 'b -> 'a option -> 'b + +(** {6 More Specific Operations} *) + +(** [default a x] is [y] if [x] is [Some y] and [a] otherwise. *) +val default : 'a -> 'a option -> 'a + +(** [lift] is the same as {!map}. *) +val lift : ('a -> 'b) -> 'a option -> 'b option + +(** [lift_right f a x] is [Some (f a y)] if [x] is [Some y], and + [None] otherwise. *) +val lift_right : ('a -> 'b -> 'c) -> 'a -> 'b option -> 'c option + +(** [lift_left f x a] is [Some (f y a)] if [x] is [Some y], and + [None] otherwise. *) +val lift_left : ('a -> 'b -> 'c) -> 'a option -> 'b -> 'c option + +(** [lift2 f x y] is [Some (f z w)] if [x] equals [Some z] and [y] equals + [Some w]. It is [None] otherwise. *) +val lift2 : ('a -> 'b -> 'c) -> 'a option -> 'b option -> 'c option + +(** {6 Smart operations} *) + +module Smart : +sig + + (** [Smart.map f x] does the same as [map f x] except that it tries to share + some memory. *) + val map : ('a -> 'a) -> 'a option -> 'a option + +end + +(** {6 Operations with Lists} *) + +module List : sig + (** [List.cons x l] equals [y::l] if [x] is [Some y] and [l] otherwise. *) + val cons : 'a option -> 'a list -> 'a list + + (** [List.flatten l] is the list of all the [y]s such that [l] contains + [Some y] (in the same order). *) + val flatten : 'a option list -> 'a list + + (** [List.find f l] is the first [f a] different from [None], + scrolling through elements [a] of [l] in left-to-right order; + it is [None] if no such element exists. *) + val find : ('a -> 'b option) -> 'a list -> 'b option + + (** [List.map f [a1;...;an]] is the list [Some [b1;...;bn]] if + for all i, there is a [bi] such that [f ai] is [Some bi]; it is + [None] if, for at least one i, [f ai] is [None]. *) + val map : ('a -> 'b option) -> 'a list -> 'b list option + +end diff -Nru coq-doc-8.6/clib/orderedType.ml coq-doc-8.15.0/clib/orderedType.ml --- coq-doc-8.6/clib/orderedType.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/orderedType.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,35 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module Pair (M:S) (N:S) = struct + type t = M.t * N.t + + let compare (a,b) (a',b') = + let i = M.compare a a' in + if Int.equal i 0 then N.compare b b' + else i +end + +module UnorderedPair (M:S) = struct + type t = M.t * M.t + + let reorder (a,b as p) = + if M.compare a b <= 0 then p else (b,a) + + let compare p p' = + let p = reorder p and p' = reorder p' in + let module P = Pair(M)(M) in P.compare p p' +end diff -Nru coq-doc-8.6/clib/orderedType.mli coq-doc-8.15.0/clib/orderedType.mli --- coq-doc-8.6/clib/orderedType.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/orderedType.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,19 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int +end + +module Pair (M:S) (N:S) : S with type t = M.t * N.t + +module UnorderedPair (M:S) : S with type t = M.t * M.t diff -Nru coq-doc-8.6/clib/predicate.ml coq-doc-8.15.0/clib/predicate.ml --- coq-doc-8.6/clib/predicate.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/predicate.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,111 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t -> int + end + +module type S = + sig + type elt + type t + val empty: t + val full: t + val is_empty: t -> bool + val is_full: t -> bool + val mem: elt -> t -> bool + val singleton: elt -> t + val add: elt -> t -> t + val remove: elt -> t -> t + val union: t -> t -> t + val inter: t -> t -> t + val diff: t -> t -> t + val complement: t -> t + val equal: t -> t -> bool + val subset: t -> t -> bool + val elements: t -> bool * elt list + val is_finite : t -> bool + end + +module Make(Ord: OrderedType) = + struct + module EltSet = Set.Make(Ord) + + type elt = Ord.t + + (* (false, s) represents a set which is equal to the set s + (true, s) represents a set which is equal to the complement of set s *) + type t = bool * EltSet.t + + let is_finite (b,_) = not b + + let elements (b,s) = (b, EltSet.elements s) + + let empty = (false,EltSet.empty) + let full = (true,EltSet.empty) + + (* assumes the set is infinite *) + let is_empty (b,s) = not b && EltSet.is_empty s + let is_full (b,s) = b && EltSet.is_empty s + + let mem x (b,s) = + if b then not (EltSet.mem x s) else EltSet.mem x s + + let singleton x = (false,EltSet.singleton x) + + let add x (b,s) = + if b then (b,EltSet.remove x s) + else (b,EltSet.add x s) + + let remove x (b,s) = + if b then (b,EltSet.add x s) + else (b,EltSet.remove x s) + + let complement (b,s) = (not b, s) + + let union s1 s2 = + match (s1,s2) with + ((false,p1),(false,p2)) -> (false,EltSet.union p1 p2) + | ((true,n1),(true,n2)) -> (true,EltSet.inter n1 n2) + | ((false,p1),(true,n2)) -> (true,EltSet.diff n2 p1) + | ((true,n1),(false,p2)) -> (true,EltSet.diff n1 p2) + + let inter s1 s2 = + complement (union (complement s1) (complement s2)) + + let diff s1 s2 = inter s1 (complement s2) + + (* assumes the set is infinite *) + let subset s1 s2 = + match (s1,s2) with + ((false,p1),(false,p2)) -> EltSet.subset p1 p2 + | ((true,n1),(true,n2)) -> EltSet.subset n2 n1 + | ((false,p1),(true,n2)) -> EltSet.is_empty (EltSet.inter p1 n2) + | ((true,_),(false,_)) -> false + + (* assumes the set is infinite *) + let equal (b1,s1) (b2,s2) = + b1=b2 && EltSet.equal s1 s2 + + end diff -Nru coq-doc-8.6/clib/predicate.mli coq-doc-8.15.0/clib/predicate.mli --- coq-doc-8.6/clib/predicate.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/predicate.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,89 @@ +(** Infinite sets over a chosen [OrderedType]. + + All operations over sets are purely applicative (no side-effects). + *) + +(** Input signature of the functor [Make]. *) +module type OrderedType = + sig + type t + (** The type of the elements in the set. + + The chosen [t] {b must be infinite}. *) + + val compare : t -> t -> int + (** A total ordering function over the set elements. + This is a two-argument function [f] such that: + - [f e1 e2] is zero if the elements [e1] and [e2] are equal, + - [f e1 e2] is strictly negative if [e1] is smaller than [e2], + - and [f e1 e2] is strictly positive if [e1] is greater than [e2]. + *) + end + +module type S = + sig + type elt + (** The type of the elements in the set. *) + + type t + (** The type of sets. *) + + val empty: t + (** The empty set. *) + + val full: t + (** The set of all elements (of type [elm]). *) + + val is_empty: t -> bool + (** Test whether a set is empty or not. *) + + val is_full: t -> bool + (** Test whether a set contains the whole type or not. *) + + val mem: elt -> t -> bool + (** [mem x s] tests whether [x] belongs to the set [s]. *) + + val singleton: elt -> t + (** [singleton x] returns the one-element set containing only [x]. *) + + val add: elt -> t -> t + (** [add x s] returns a set containing all elements of [s], + plus [x]. If [x] was already in [s], then [s] is returned unchanged. *) + + val remove: elt -> t -> t + (** [remove x s] returns a set containing all elements of [s], + except [x]. If [x] was not in [s], then [s] is returned unchanged. *) + + val union: t -> t -> t + (** Set union. *) + + val inter: t -> t -> t + (** Set intersection. *) + + val diff: t -> t -> t + (** Set difference. *) + + val complement: t -> t + (** Set complement. *) + + val equal: t -> t -> bool + (** [equal s1 s2] tests whether the sets [s1] and [s2] are + equal, that is, contain equal elements. *) + + val subset: t -> t -> bool + (** [subset s1 s2] tests whether the set [s1] is a subset of + the set [s2]. *) + + val elements: t -> bool * elt list + (** Gives a finite representation of the predicate: if the + boolean is false, then the predicate is given in extension. + if it is true, then the complement is given *) + + val is_finite : t -> bool + (** [true] if the predicate can be given as a finite set (if [elt] + is a finite type, we can have [is_finite x = false] yet [x] is + finite, but we don't know how to list its elements) *) + end + +(** The [Make] functor constructs an implementation for any [OrderedType]. *) +module Make (Ord : OrderedType) : (S with type elt = Ord.t) diff -Nru coq-doc-8.6/clib/range.ml coq-doc-8.15.0/clib/range.ml --- coq-doc-8.6/clib/range.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/range.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,93 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* + if Int.equal h1 h2 then Cons (1 + h1 + h2, Node (x, t1, t2), rem) + else Cons (1, Leaf x, l) +| _ -> Cons (1, Leaf x, l) + +let is_empty = function +| Nil -> true +| _ -> false + +let rec tree_get h t i = match t with +| Leaf x -> + if i = 0 then x else oob () +| Node (x, t1, t2) -> + if i = 0 then x + else + let h = h / 2 in + if i <= h then tree_get h t1 (i - 1) else tree_get h t2 (i - h - 1) + +let rec get l i = match l with +| Nil -> oob () +| Cons (h, t, rem) -> + if i < h then tree_get h t i else get rem (i - h) + +let length l = + let rec length accu = function + | Nil -> accu + | Cons (h, _, l) -> length (h + accu) l + in + length 0 l + +let rec tree_map f = function +| Leaf x -> Leaf (f x) +| Node (x, t1, t2) -> Node (f x, tree_map f t1, tree_map f t2) + +let rec map f = function +| Nil -> Nil +| Cons (h, t, l) -> Cons (h, tree_map f t, map f l) + +let rec tree_fold_left f accu = function +| Leaf x -> f accu x +| Node (x, t1, t2) -> + tree_fold_left f (tree_fold_left f (f accu x) t1) t2 + +let rec fold_left f accu = function +| Nil -> accu +| Cons (_, t, l) -> fold_left f (tree_fold_left f accu t) l + +let rec tree_fold_right f t accu = match t with +| Leaf x -> f x accu +| Node (x, t1, t2) -> + f x (tree_fold_right f t1 (tree_fold_right f t2 accu)) + +let rec fold_right f l accu = match l with +| Nil -> accu +| Cons (_, t, l) -> tree_fold_right f t (fold_right f l accu) + +let hd = function +| Nil -> failwith "hd" +| Cons (_, Leaf x, _) -> x +| Cons (_, Node (x, _, _), _) -> x + +let tl = function +| Nil -> failwith "tl" +| Cons (_, Leaf _, l) -> l +| Cons (h, Node (_, t1, t2), l) -> + let h = h / 2 in + Cons (h, t1, Cons (h, t2, l)) + +let rec skipn n l = + if n = 0 then l + else if is_empty l then failwith "List.skipn" + else skipn (pred n) (tl l) diff -Nru coq-doc-8.6/clib/range.mli coq-doc-8.15.0/clib/range.mli --- coq-doc-8.6/clib/range.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/range.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,39 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a t -> 'a t + +(** {5 List operations} *) + +val is_empty : 'a t -> bool +val length : 'a t -> int +val map : ('a -> 'b) -> 'a t -> 'b t +val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a +val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b +val hd : 'a t -> 'a +val tl : 'a t -> 'a t + +val skipn : int -> 'a t -> 'a t + +(** {5 Indexing operations} *) + +val get : 'a t -> int -> 'a diff -Nru coq-doc-8.6/clib/segmenttree.ml coq-doc-8.15.0/clib/segmenttree.ml --- coq-doc-8.6/clib/segmenttree.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/segmenttree.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,140 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* () + | x :: xs -> f i x; loop (i + 1) xs + in + loop 0 l + +let log2 x = log x /. log 2. + +let log2n x = int_of_float (ceil (log2 (float_of_int x))) + +(** We focus on integers but this module can be generalized. *) +type elt = int + +(** A value of type [domain] is interpreted differently given its position + in the tree. On internal nodes, a domain represents the set of + integers which are _not_ in the set of keys handled by the tree. On + leaves, a domain represents the st of integers which are in the set of + keys. *) +type domain = + | Interval of elt * elt + (** On internal nodes, a domain [Interval (a, b)] represents + the interval [a + 1; b - 1]. On leaves, it represents [a; b]. + We always have [a] <= [b]. *) + | Universe + (** On internal node or root, a domain [Universe] represents all + the integers. When the tree is not a trivial root, + [Universe] has no interpretation on leaves. (The lookup + function should never reach the leaves.) *) + +(** We use an array to store the almost complete tree. This array + contains at least one element. *) +type 'a t = (domain * 'a option) array + +(** The root is the first item of the array. *) + +(** Standard layout for left child. *) +let left_child i = 2 * i + 1 + +(** Standard layout for right child. *) +let right_child i = 2 * i + 2 + +(** Extract the annotation of a node, be it internal or a leaf. *) +let value_of i t = match t.(i) with (_, Some x) -> x | _ -> raise Not_found + +(** Initialize the array to store [n] leaves. *) +let create n init = + Array.make (1 lsl (log2n n + 1) - 1) init + +(** Make a complete interval tree from a list of disjoint segments. + Precondition : the segments must be sorted. *) +let make segments = + let nsegments = List.length segments in + let tree = create nsegments (Universe, None) in + let leaves_offset = (1 lsl (log2n nsegments)) - 1 in + + (* The algorithm proceeds in two steps using an intermediate tree + to store minimum and maximum of each subtree as annotation of + the node. *) + + (* We start from leaves: the last level of the tree is initialized + with the given segments... *) + list_iteri + (fun i ((start, stop), value) -> + let k = leaves_offset + i in + let i = Interval (start, stop) in + tree.(k) <- (i, Some i)) + segments; + (* ... the remaining leaves are initialized with neutral information. *) + for k = leaves_offset + nsegments to Array.length tree -1 do + tree.(k) <- (Universe, Some Universe) + done; + + (* We traverse the tree bottom-up and compute the interval and + annotation associated to each node from the annotations of its + children. *) + for k = leaves_offset - 1 downto 0 do + let node, annotation = + match value_of (left_child k) tree, value_of (right_child k) tree with + | Interval (left_min, left_max), Interval (right_min, right_max) -> + (Interval (left_max, right_min), Interval (left_min, right_max)) + | Interval (min, max), Universe -> + (Interval (max, max), Interval (min, max)) + | Universe, Universe -> Universe, Universe + | Universe, _ -> assert false + in + tree.(k) <- (node, Some annotation) + done; + + (* Finally, annotation are replaced with the image related to each leaf. *) + let final_tree = + Array.mapi (fun i (segment, value) -> (segment, None)) tree + in + list_iteri + (fun i ((start, stop), value) -> + final_tree.(leaves_offset + i) + <- (Interval (start, stop), Some value)) + segments; + final_tree + +(** [lookup k t] looks for an image for key [k] in the interval tree [t]. + Raise [Not_found] if it fails. *) +let lookup k t = + let i = ref 0 in + while (snd t.(!i) = None) do + match fst t.(!i) with + | Interval (start, stop) -> + if k <= start then i := left_child !i + else if k >= stop then i:= right_child !i + else raise Not_found + | Universe -> raise Not_found + done; + match fst t.(!i) with + | Interval (start, stop) -> + if k >= start && k <= stop then + match snd t.(!i) with + | Some v -> v + | None -> assert false + else + raise Not_found + | Universe -> assert false + + diff -Nru coq-doc-8.6/clib/segmenttree.mli coq-doc-8.15.0/clib/segmenttree.mli --- coq-doc-8.6/clib/segmenttree.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/segmenttree.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,30 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a t + +(** [lookup k t] looks for an image for key [k] in the interval tree [t]. + Raise [Not_found] if it fails. *) +val lookup : int -> 'a t -> 'a + + diff -Nru coq-doc-8.6/clib/store.ml coq-doc-8.15.0/clib/store.ml --- coq-doc-8.6/clib/store.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/store.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,56 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a field + val empty : t + val set : t -> 'a field -> 'a -> t + val get : t -> 'a field -> 'a option + val remove : t -> 'a field -> t + val merge : t -> t -> t +end + +module Make() : S = +struct + module Dyn = Dyn.Make() + module Map = Dyn.Map(struct type 'a t = 'a end) + + type t = Map.t + type 'a field = 'a Dyn.tag + + let next = ref 0 + let field () = + let f = Dyn.anonymous !next in + incr next; + f + + let empty = + Map.empty + let set s f v = + Map.add f v s + let get s f = + try Some (Map.find f s) + with Not_found -> None + let remove s f = + Map.remove f s + let merge s1 s2 = + Map.fold (fun (Map.Any (f, v)) s -> Map.add f v s) s1 s2 +end diff -Nru coq-doc-8.6/clib/store.mli coq-doc-8.15.0/clib/store.mli --- coq-doc-8.6/clib/store.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/store.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,42 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 'a field + (** Create a new field *) + + val empty : t + (** Empty store *) + + val set : t -> 'a field -> 'a -> t + (** Set a field *) + + val get : t -> 'a field -> 'a option + (** Get the value of a field, if any *) + + val remove : t -> 'a field -> t + (** Unset the value of the field *) + + val merge : t -> t -> t + (** [merge s1 s2] adds all the fields of [s1] into [s2]. *) +end + +module Make() : S +(** Create a new store type. *) diff -Nru coq-doc-8.6/clib/terminal.ml coq-doc-8.15.0/clib/terminal.ml --- coq-doc-8.6/clib/terminal.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/terminal.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,320 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* o2 +| Some _ -> + match o2 with + | None -> o1 + | Some _ -> o2 + +let default = { + fg_color = None; + bg_color = None; + bold = None; + italic = None; + underline = None; + negative = None; + prefix = None; + suffix = None; +} + +let reset = "\027[0m" + +let reset_style = { + fg_color = Some `DEFAULT; + bg_color = Some `DEFAULT; + bold = Some false; + italic = Some false; + underline = Some false; + negative = Some false; + prefix = None; + suffix = None; +} + +let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style ?prefix ?suffix () = + let st = match style with + | None -> default + | Some st -> st + in + { + fg_color = set st.fg_color fg_color; + bg_color = set st.bg_color bg_color; + bold = set st.bold bold; + italic = set st.italic italic; + underline = set st.underline underline; + negative = set st.negative negative; + prefix = set st.prefix prefix; + suffix = set st.suffix suffix; + } + +let merge s1 s2 = + { + fg_color = set s1.fg_color s2.fg_color; + bg_color = set s1.bg_color s2.bg_color; + bold = set s1.bold s2.bold; + italic = set s1.italic s2.italic; + underline = set s1.underline s2.underline; + negative = set s1.negative s2.negative; + prefix = set s1.prefix s2.prefix; + suffix = set s1.suffix s2.suffix; + } + +let diff s1 s2 = + let diff_op o1 o2 reset_val = match o1 with + | None -> o2 + | Some _ -> + match o2 with + | None -> reset_val + | Some _ -> if o1 = o2 then None else o2 in + + { + fg_color = diff_op s1.fg_color s2.fg_color reset_style.fg_color; + bg_color = diff_op s1.bg_color s2.bg_color reset_style.bg_color; + bold = diff_op s1.bold s2.bold reset_style.bold; + italic = diff_op s1.italic s2.italic reset_style.italic; + underline = diff_op s1.underline s2.underline reset_style.underline; + negative = diff_op s1.negative s2.negative reset_style.negative; + prefix = diff_op s1.prefix s2.prefix reset_style.prefix; + suffix = diff_op s1.suffix s2.suffix reset_style.suffix; + } + +let base_color = function +| `DEFAULT -> 9 +| `BLACK -> 0 +| `RED -> 1 +| `GREEN -> 2 +| `YELLOW -> 3 +| `BLUE -> 4 +| `MAGENTA -> 5 +| `CYAN -> 6 +| `WHITE -> 7 +| `LIGHT_BLACK -> 0 +| `LIGHT_RED -> 1 +| `LIGHT_GREEN -> 2 +| `LIGHT_YELLOW -> 3 +| `LIGHT_BLUE -> 4 +| `LIGHT_MAGENTA -> 5 +| `LIGHT_CYAN -> 6 +| `LIGHT_WHITE -> 7 +| _ -> invalid_arg "base_color" + +let extended_color off = function +| `INDEX i -> [off + 8; 5; i] +| `RGB (r, g, b) -> [off + 8; 2; r; g; b] +| _ -> invalid_arg "extended_color" + +let is_light = function +| `LIGHT_BLACK +| `LIGHT_RED +| `LIGHT_GREEN +| `LIGHT_YELLOW +| `LIGHT_BLUE +| `LIGHT_MAGENTA +| `LIGHT_CYAN +| `LIGHT_WHITE -> true +| _ -> false + +let is_extended = function +| `INDEX _ | `RGB _ -> true +| _ -> false + +let repr st = + let fg = match st.fg_color with + | None -> [] + | Some c -> + if is_light c then [90 + base_color c] + else if is_extended c then extended_color 30 c + else [30 + base_color c] + in + let bg = match st.bg_color with + | None -> [] + | Some c -> + if is_light c then [100 + base_color c] + else if is_extended c then extended_color 40 c + else [40 + base_color c] + in + let bold = match st.bold with + | None -> [] + | Some true -> [1] + | Some false -> [22] + in + let italic = match st.italic with + | None -> [] + | Some true -> [3] + | Some false -> [23] + in + let underline = match st.underline with + | None -> [] + | Some true -> [4] + | Some false -> [24] + in + let negative = match st.negative with + | None -> [] + | Some true -> [7] + | Some false -> [27] + in + fg @ bg @ bold @ italic @ underline @ negative + +let eval st = + let tags = repr st in + let tags = List.map string_of_int tags in + if List.length tags = 0 then "" else + Printf.sprintf "\027[%sm" (String.concat ";" tags) + +let has_style t = + Unix.isatty t && Sys.os_type = "Unix" + +let split c s = + let len = String.length s in + let rec split n = + try + let pos = String.index_from s n c in + let dir = String.sub s n (pos-n) in + dir :: split (succ pos) + with + | Not_found -> [String.sub s n (len-n)] + in + if len = 0 then [] else split 0 + +let check_char i = if i < 0 || i > 255 then invalid_arg "check_char" + +let parse_color off rem = match off with +| 0 -> (`BLACK, rem) +| 1 -> (`RED, rem) +| 2 -> (`GREEN, rem) +| 3 -> (`YELLOW, rem) +| 4 -> (`BLUE, rem) +| 5 -> (`MAGENTA, rem) +| 6 -> (`CYAN, rem) +| 7 -> (`WHITE, rem) +| 9 -> (`DEFAULT, rem) +| 8 -> + begin match rem with + | 5 :: i :: rem -> + check_char i; + (`INDEX i, rem) + | 2 :: r :: g :: b :: rem -> + check_char r; + check_char g; + check_char b; + (`RGB (r, g, b), rem) + | _ -> invalid_arg "parse_color" + end +| _ -> invalid_arg "parse_color" + +let set_light = function +| `BLACK -> `LIGHT_BLACK +| `RED -> `LIGHT_RED +| `GREEN -> `LIGHT_GREEN +| `YELLOW -> `LIGHT_YELLOW +| `BLUE -> `LIGHT_BLUE +| `MAGENTA -> `LIGHT_MAGENTA +| `CYAN -> `LIGHT_CYAN +| `WHITE -> `LIGHT_WHITE +| _ -> invalid_arg "parse_color" + +let rec parse_style style = function +| [] -> style +| 0 :: rem -> + let style = merge style reset_style in + parse_style style rem +| 1 :: rem -> + let style = make ~style ~bold:true () in + parse_style style rem +| 3 :: rem -> + let style = make ~style ~italic:true () in + parse_style style rem +| 4 :: rem -> + let style = make ~style ~underline:true () in + parse_style style rem +| 7 :: rem -> + let style = make ~style ~negative:true () in + parse_style style rem +| 22 :: rem -> + let style = make ~style ~bold:false () in + parse_style style rem +| 23 :: rem -> + let style = make ~style ~italic:false () in + parse_style style rem +| 24 :: rem -> + let style = make ~style ~underline:false () in + parse_style style rem +| 27 :: rem -> + let style = make ~style ~negative:false () in + parse_style style rem +| code :: rem when (30 <= code && code < 40) -> + let color, rem = parse_color (code mod 10) rem in + let style = make ~style ~fg_color:color () in + parse_style style rem +| code :: rem when (40 <= code && code < 50) -> + let color, rem = parse_color (code mod 10) rem in + let style = make ~style ~bg_color:color () in + parse_style style rem +| code :: rem when (90 <= code && code < 100) -> + let color, rem = parse_color (code mod 10) rem in + let style = make ~style ~fg_color:(set_light color) () in + parse_style style rem +| code :: rem when (100 <= code && code < 110) -> + let color, rem = parse_color (code mod 10) rem in + let style = make ~style ~bg_color:(set_light color) () in + parse_style style rem +| _ :: rem -> parse_style style rem + +(** Parse LS_COLORS-like strings *) +let parse s = + let defs = split ':' s in + let fold accu s = match split '=' s with + | [name; attrs] -> + let attrs = split ';' attrs in + let accu = + try + let attrs = List.map int_of_string attrs in + let attrs = parse_style (make ()) attrs in + (name, attrs) :: accu + with _ -> accu + in + accu + | _ -> accu + in + List.fold_left fold [] defs diff -Nru coq-doc-8.6/clib/terminal.mli coq-doc-8.15.0/clib/terminal.mli --- coq-doc-8.6/clib/terminal.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/terminal.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,75 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* ?bg_color:color -> + ?bold:bool -> ?italic:bool -> ?underline:bool -> + ?negative:bool -> ?style:style -> + ?prefix:string -> ?suffix:string -> unit -> style +(** Create a style from the given flags. It is derived from the optional + [style] argument if given. *) + +val merge : style -> style -> style +(** [merge s1 s2] returns [s1] with all defined values of [s2] overwritten. *) + +val diff : style -> style -> style +(** [diff s1 s2] returns the differences between [s1] and [s2]. *) + +val repr : style -> int list +(** Generate the ANSI code representing the given style. *) + +val eval : style -> string +(** Generate an escape sequence from a style. *) + +val reset : string +(** This escape sequence resets all attributes. *) + +val reset_style : style +(** The default style *) + +val has_style : Unix.file_descr -> bool +(** Whether an output file descriptor handles styles. Very heuristic, only + checks it is a terminal. *) + +val parse : string -> (string * style) list +(** Parse strings describing terminal styles in the LS_COLORS syntax. For + robustness, ignore meaningless entries and drops undefined styles. *) diff -Nru coq-doc-8.6/clib/trie.ml coq-doc-8.15.0/clib/trie.ml --- coq-doc-8.6/clib/trie.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/trie.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,91 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* data + val next : t -> label -> t + val labels : t -> label list + val add : label list -> data -> t -> t + val remove : label list -> data -> t -> t + val iter : (label list -> data -> unit) -> t -> unit +end + +module type Grp = +sig + type t + val nil : t + val is_nil : t -> bool + val add : t -> t -> t + val sub : t -> t -> t +end + +module Make (Y : Map.OrderedType) (X : Grp) = +struct + +module T_codom = Map.Make(Y) + +type data = X.t +type label = Y.t +type t = Node of X.t * t T_codom.t + +let codom_for_all f m = + let fold key v accu = f v && accu in + T_codom.fold fold m true + +let empty = Node (X.nil, T_codom.empty) + +let next (Node (_,m)) lbl = T_codom.find lbl m + +let get (Node (hereset,_)) = hereset + +let labels (Node (_,m)) = + (* FIXME: this is order-dependent. Try to find a more robust presentation? *) + List.rev (T_codom.fold (fun x _ acc -> x::acc) m []) + +let is_empty_node (Node(a,b)) = (X.is_nil a) && (T_codom.is_empty b) + +let assure_arc m lbl = + if T_codom.mem lbl m then + m + else + T_codom.add lbl (Node (X.nil,T_codom.empty)) m + +let cleanse_arcs (Node (hereset,m)) = + let m = if codom_for_all is_empty_node m then T_codom.empty else m in + Node(hereset, m) + +let rec at_path f (Node (hereset,m)) = function + | [] -> + cleanse_arcs (Node(f hereset,m)) + | h::t -> + let m = assure_arc m h in + cleanse_arcs (Node(hereset, + T_codom.add h (at_path f (T_codom.find h m) t) m)) + +let add path v tm = + at_path (fun hereset -> X.add v hereset) tm path + +let remove path v tm = + at_path (fun hereset -> X.sub hereset v) tm path + +let iter f tlm = + let rec apprec pfx (Node(hereset,m)) = + let path = List.rev pfx in + f path hereset; + T_codom.iter (fun l tm -> apprec (l::pfx) tm) m + in + apprec [] tlm + +end diff -Nru coq-doc-8.6/clib/trie.mli coq-doc-8.15.0/clib/trie.mli --- coq-doc-8.6/clib/trie.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/trie.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,63 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* data + (** Get the data at the current node. *) + + val next : t -> label -> t + (** [next t lbl] returns the subtrie of [t] pointed by [lbl]. + @raise Not_found if there is none. *) + + val labels : t -> label list + (** Get the list of defined labels at the current node. *) + + val add : label list -> data -> t -> t + (** [add t path v] adds [v] at path [path] in [t]. *) + + val remove : label list -> data -> t -> t + (** [remove t path v] removes [v] from path [path] in [t]. *) + + val iter : (label list -> data -> unit) -> t -> unit + (** Apply a function to all contents. *) + +end + +module type Grp = +sig + type t + val nil : t + val is_nil : t -> bool + val add : t -> t -> t + val sub : t -> t -> t +end + +module Make (Label : Set.OrderedType) (Data : Grp) : S + with type label = Label.t and type data = Data.t +(** Generating functor, for a given type of labels and data. *) diff -Nru coq-doc-8.6/clib/unicode.ml coq-doc-8.15.0/clib/unicode.ml --- coq-doc-8.6/clib/unicode.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/unicode.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,388 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* 1 lsl ((i land 7) * 3) (* 001 *) + | IdentPart -> 2 lsl ((i land 7) * 3) (* 010 *) + | Symbol -> 3 lsl ((i land 7) * 3) (* 011 *) + | IdentSep -> 4 lsl ((i land 7) * 3) (* 100 *) + | Unknown -> 0 lsl ((i land 7) * 3) (* 000 *) + +(* Helper to reset 3 bits in a word. *) +let reset_mask i = + lnot (7 lsl ((i land 7) * 3)) + +(* Initialize the lookup table from a list of segments, assigning + a status to every character of each segment. The order of these + assignments is relevant: it is possible to assign status [s] to + a segment [(c1, c2)] and later assign [s'] to [c] even if [c] is + between [c1] and [c2]. *) +let mk_lookup_table_from_unicode_tables_for status tables = + List.iter + (List.iter + (fun (c1, c2) -> + for i = c1 to c2 do + table.(i lsr 3) <- + (table.(i lsr 3) land (reset_mask i)) lor (mask i status) + done)) + tables + +(* Look up into the table and interpret the found pattern. *) +let lookup x = + let v = (table.(x lsr 3) lsr ((x land 7) * 3)) land 7 in + if v = 1 then Letter + else if v = 2 then IdentPart + else if v = 3 then Symbol + else if v = 4 then IdentSep + else Unknown + +(* [classify] discriminates between 5 different kinds of + symbols based on the standard unicode classification (extracted from + Camomile). *) +let classify = + let single c = [ (c, c) ] in + (* General tables. *) + mk_lookup_table_from_unicode_tables_for Symbol + [ + Unicodetable.sm; (* Symbol, maths. *) + Unicodetable.sc; (* Symbol, currency. *) + Unicodetable.so; (* Symbol, modifier. *) + Unicodetable.pd; (* Punctuation, dash. *) + Unicodetable.pc; (* Punctuation, connector. *) + Unicodetable.pe; (* Punctuation, open. *) + Unicodetable.ps; (* Punctution, close. *) + Unicodetable.pi; (* Punctuation, initial quote. *) + Unicodetable.pf; (* Punctuation, final quote. *) + Unicodetable.po; (* Punctuation, other. *) + ]; + mk_lookup_table_from_unicode_tables_for Letter + [ + Unicodetable.lu; (* Letter, uppercase. *) + Unicodetable.ll; (* Letter, lowercase. *) + Unicodetable.lt; (* Letter, titlecase. *) + Unicodetable.lo; (* Letter, others. *) + Unicodetable.lm; (* Letter, modifier. *) + ]; + mk_lookup_table_from_unicode_tables_for IdentPart + [ + Unicodetable.nd; (* Number, decimal digits. *) + Unicodetable.nl; (* Number, letter. *) + Unicodetable.no; (* Number, other. *) + ]; + + (* Workaround. Some characters seems to be missing in + Camomile's category tables. We add them manually. *) + mk_lookup_table_from_unicode_tables_for Letter + [ + [(0x01D00, 0x01D7F)]; (* Phonetic Extensions. *) + [(0x01D80, 0x01DBF)]; (* Phonetic Extensions Suppl. *) + [(0x01DC0, 0x01DFF)]; (* Combining Diacritical Marks Suppl.*) + ]; + + (* Exceptions (from a previous version of this function). *) + mk_lookup_table_from_unicode_tables_for Symbol + [ + [(0x000B2, 0x000B3)]; (* Superscript 2-3. *) + single 0x000B9; (* Superscript 1. *) + single 0x02070; (* Superscript 0. *) + [(0x02074, 0x02079)]; (* Superscript 4-9. *) + single 0x0002E; (* Dot. *) + ]; + mk_lookup_table_from_unicode_tables_for IdentSep + [ + single 0x005F; (* Underscore. *) + single 0x00A0; (* Non breaking space. *) + ]; + mk_lookup_table_from_unicode_tables_for IdentPart + [ + single 0x0027; (* Single quote. *) + ]; + (* Lookup *) + lookup + +exception End_of_input + +let utf8_of_unicode n = + if n < 128 then + String.make 1 (Char.chr n) + else + let (m,s) = if n < 2048 then (2,192) else if n < 65536 then (3,224) else (4,240) in + String.init m (fun i -> + let j = (n lsr ((m - 1 - i) * 6)) land 63 in + Char.chr (j + if i = 0 then s else 128)) + +(* If [s] is some UTF-8 encoded string + and [i] is a position of some UTF-8 character within [s] + then [next_utf8 s i] returns [(j,n)] where: + - [j] indicates the position of the next UTF-8 character + - [n] represents the UTF-8 character at index [i] *) +let next_utf8 s i = + let err () = invalid_arg "utf8" in + let l = String.length s - i in + if l = 0 then raise End_of_input + else let a = Char.code s.[i] in if a <= 0x7F then + 1, a + else if a land 0x40 = 0 || l = 1 then err () + else let b = Char.code s.[i+1] in if b land 0xC0 <> 0x80 then err () + else if a land 0x20 = 0 then + 2, (a land 0x1F) lsl 6 + (b land 0x3F) + else if l = 2 then err () + else let c = Char.code s.[i+2] in if c land 0xC0 <> 0x80 then err () + else if a land 0x10 = 0 then + 3, (a land 0x0F) lsl 12 + (b land 0x3F) lsl 6 + (c land 0x3F) + else if l = 3 then err () + else let d = Char.code s.[i+3] in if d land 0xC0 <> 0x80 then err () + else if a land 0x08 = 0 then + 4, (a land 0x07) lsl 18 + (b land 0x3F) lsl 12 + + (c land 0x3F) lsl 6 + (d land 0x3F) + else err () + +let is_utf8 s = + let rec check i = + let (off, _) = next_utf8 s i in + check (i + off) + in + try check 0 with End_of_input -> true | Invalid_argument _ -> false + +(* Escape string if it contains non-utf8 characters *) + +let escaped_non_utf8 s = + let mk_escape x = Printf.sprintf "%%%X" x in + let buff = Buffer.create (String.length s * 3) in + let rec process_trailing_aux i j = + if i = j then i else + match String.unsafe_get s i with + | '\128'..'\191' -> process_trailing_aux (i+1) j + | _ -> i in + let process_trailing i n = + let j = if i+n-1 >= String.length s then i+1 else process_trailing_aux (i+1) (i+n) in + (if j = i+n then + Buffer.add_string buff (String.sub s i n) + else + let v = Array.init (j-i) (fun k -> mk_escape (Char.code s.[i+k])) in + Buffer.add_string buff (String.concat "" (Array.to_list v))); + j in + let rec process i = + if i >= String.length s then Buffer.contents buff else + let c = String.unsafe_get s i in + match c with + | '\000'..'\127' -> Buffer.add_char buff c; process (i+1) + | '\128'..'\191' | '\248'..'\255' -> Buffer.add_string buff (mk_escape (Char.code c)); process (i+1) + | '\192'..'\223' -> process (process_trailing i 2) + | '\224'..'\239' -> process (process_trailing i 3) + | '\240'..'\247' -> process (process_trailing i 4) + in + process 0 + +let escaped_if_non_utf8 s = + if is_utf8 s then s else escaped_non_utf8 s + +(* Check the well-formedness of an identifier *) + +let is_valid_ident_initial = function + | Letter | IdentSep -> true + | IdentPart | Symbol | Unknown -> false + +let initial_refutation j n s = + if is_valid_ident_initial (classify n) then None + else + let c = String.sub s 0 j in + Some (false, + "Invalid character '"^c^"' at beginning of identifier \""^s^"\".") + +let is_valid_ident_trailing = function + | Letter | IdentSep | IdentPart -> true + | Symbol | Unknown -> false + +let trailing_refutation i j n s = + if is_valid_ident_trailing (classify n) then None + else + let c = String.sub s i j in + Some (false, + "Invalid character '"^c^"' in identifier \""^s^"\".") + +let is_unknown = function + | Unknown -> true + | Letter | IdentSep | IdentPart | Symbol -> false + +let is_ident_part = function + | IdentPart -> true + | Letter | IdentSep | Symbol | Unknown -> false + +let is_ident_sep = function + | IdentSep -> true + | Letter | IdentPart | Symbol | Unknown -> false + +let ident_refutation s = + if s = ".." then None else try + let j, n = next_utf8 s 0 in + match initial_refutation j n s with + |None -> + begin try + let rec aux i = + let j, n = next_utf8 s i in + match trailing_refutation i j n s with + |None -> aux (i + j) + |x -> x + in aux j + with End_of_input -> None + end + |x -> x + with + | End_of_input -> Some (true,"The empty string is not an identifier.") + | Invalid_argument _ -> Some (true,escaped_non_utf8 s^": invalid utf8 sequence.") + +let lowercase_unicode = + let tree = Segmenttree.make Unicodetable.to_lower in + fun unicode -> + try + match Segmenttree.lookup unicode tree with + | `Abs c -> c + | `Delta d -> unicode + d + with Not_found -> unicode + +let lowercase_first_char s = + assert (s <> ""); + let j, n = next_utf8 s 0 in + utf8_of_unicode (lowercase_unicode n) + +let split_at_first_letter s = + let n, v = next_utf8 s 0 in + if ((* optim *) n = 1 && s.[0] != '_') || not (is_ident_sep (classify v)) then None + else begin + let n = ref n in + let p = ref 0 in + while !n < String.length s && + let n', v = next_utf8 s !n in + p := n'; + (* Test if not letter *) + ((* optim *) n' = 1 && (s.[!n] = '_' || s.[!n] = '\'')) + || let st = classify v in + is_ident_sep st || is_ident_part st + do n := !n + !p + done; + let s1 = String.sub s 0 !n in + let s2 = String.sub s !n (String.length s - !n) in + Some (s1,s2) + end + +(** For extraction, we need to encode unicode character into ascii ones *) + +let is_basic_ascii s = + let ok = ref true in + String.iter (fun c -> if Char.code c >= 128 then ok := false) s; + !ok + +let ascii_of_ident s = + let len = String.length s in + let has_UU i = + i+2 < len && s.[i]='_' && s.[i+1]='U' && s.[i+2]='U' + in + let i = ref 0 in + while !i < len && Char.code s.[!i] < 128 && not (has_UU !i) do + incr i + done; + if !i = len then s else + let out = Buffer.create (2*len) in + Buffer.add_substring out s 0 !i; + while !i < len do + let j, n = next_utf8 s !i in + if n >= 128 then + (Printf.bprintf out "_UU%04x_" n; i := !i + j) + else if has_UU !i then + (Buffer.add_string out "_UUU"; i := !i + 3) + else + (Buffer.add_char out s.[!i]; incr i) + done; + Buffer.contents out + +(* Compute length of an UTF-8 encoded string + Rem 1 : utf8_length <= String.length (equal if pure ascii) + Rem 2 : if used for an iso8859_1 encoded string, the result is + wrong in very rare cases. Such a wrong case corresponds to any + sequence of a character in range 192..253 immediately followed by a + character in range 128..191 (typical case in french is "déçu" which + is counted 3 instead of 4); then no real harm to use always + utf8_length even if using an iso8859_1 encoding *) + +(** FIXME: duplicate code with Pp *) + +let utf8_length s = + let len = String.length s + and cnt = ref 0 + and nc = ref 0 + and p = ref 0 in + while !p < len do + begin + match s.[!p] with + | '\000'..'\127' -> nc := 0 (* ascii char *) + | '\128'..'\191' -> nc := 0 (* cannot start with a continuation byte *) + | '\192'..'\223' -> nc := 1 (* expect 1 continuation byte *) + | '\224'..'\239' -> nc := 2 (* expect 2 continuation bytes *) + | '\240'..'\247' -> nc := 3 (* expect 3 continuation bytes *) + | '\248'..'\255' -> nc := 0 (* invalid byte *) + end ; + incr p ; + while !p < len && !nc > 0 do + match s.[!p] with + | '\128'..'\191' (* next continuation byte *) -> incr p ; decr nc + | _ (* not a continuation byte *) -> nc := 0 + done ; + incr cnt + done ; + !cnt + +(* Variant of String.sub for UTF8 character positions *) +let utf8_sub s start_u len_u = + let len_b = String.length s + and end_u = start_u + len_u + and cnt = ref 0 + and nc = ref 0 + and p = ref 0 in + let start_b = ref len_b in + while !p < len_b && !cnt < end_u do + if !cnt <= start_u then start_b := !p ; + begin + match s.[!p] with + | '\000'..'\127' -> nc := 0 (* ascii char *) + | '\128'..'\191' -> nc := 0 (* cannot start with a continuation byte *) + | '\192'..'\223' -> nc := 1 (* expect 1 continuation byte *) + | '\224'..'\239' -> nc := 2 (* expect 2 continuation bytes *) + | '\240'..'\247' -> nc := 3 (* expect 3 continuation bytes *) + | '\248'..'\255' -> nc := 0 (* invalid byte *) + end ; + incr p ; + while !p < len_b && !nc > 0 do + match s.[!p] with + | '\128'..'\191' (* next continuation byte *) -> incr p ; decr nc + | _ (* not a continuation byte *) -> nc := 0 + done ; + incr cnt + done ; + let end_b = !p in + String.sub s !start_b (end_b - !start_b) diff -Nru coq-doc-8.6/clib/unicode.mli coq-doc-8.15.0/clib/unicode.mli --- coq-doc-8.6/clib/unicode.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/unicode.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,60 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* status + +(** Return [None] if a given string can be used as a (Coq) identifier. + Return [Some (b,s)] otherwise, where [s] is an explanation and [b] is severity. *) +val ident_refutation : string -> (bool * string) option + +(** Tells if a valid initial character for an identifier *) +val is_valid_ident_initial : status -> bool + +(** Tells if a valid non-initial character for an identifier *) +val is_valid_ident_trailing : status -> bool + +(** Tells if a character is unclassified *) +val is_unknown : status -> bool + +(** First char of a string, converted to lowercase + @raise Assert_failure if the input string is empty. *) +val lowercase_first_char : string -> string + +(** Split a string supposed to be an ident at the first letter; + as an optimization, return None if the first character is a letter *) +val split_at_first_letter : string -> (string * string) option + +(** Return [true] if all UTF-8 characters in the input string are just plain + ASCII characters. Returns [false] otherwise. *) +val is_basic_ascii : string -> bool + +(** [ascii_of_ident s] maps UTF-8 string to a string composed solely from ASCII + characters. The non-ASCII characters are translated to ["_UUxxxx_"] where + {i xxxx} is the Unicode index of the character in hexadecimal (from four + to six hex digits). To avoid potential name clashes, any preexisting + substring ["_UU"] is turned into ["_UUU"]. *) +val ascii_of_ident : string -> string + +(** Validate an UTF-8 string *) +val is_utf8 : string -> bool + +(** Return the length of a valid UTF-8 string. *) +val utf8_length : string -> int + +(** Variant of {!String.sub} for UTF-8 strings. *) +val utf8_sub : string -> int -> int -> string + +(** Return a "%XX"-escaped string if it contains non UTF-8 characters. *) +val escaped_if_non_utf8 : string -> string diff -Nru coq-doc-8.6/clib/unicodetable.ml coq-doc-8.15.0/clib/unicodetable.ml --- coq-doc-8.6/clib/unicodetable.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/unicodetable.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,7427 @@ +(** Unicode tables generated using UUCD. *) + +(* Letter, Uppercase *) +let lu = [ + (0x00041,0x0005A); + (0x000C0,0x000D6); + (0x000D8,0x000DE); + (0x00100,0x00100); + (0x00102,0x00102); + (0x00104,0x00104); + (0x00106,0x00106); + (0x00108,0x00108); + (0x0010A,0x0010A); + (0x0010C,0x0010C); + (0x0010E,0x0010E); + (0x00110,0x00110); + (0x00112,0x00112); + (0x00114,0x00114); + (0x00116,0x00116); + (0x00118,0x00118); + (0x0011A,0x0011A); + (0x0011C,0x0011C); + (0x0011E,0x0011E); + (0x00120,0x00120); + (0x00122,0x00122); + (0x00124,0x00124); + (0x00126,0x00126); + (0x00128,0x00128); + (0x0012A,0x0012A); + (0x0012C,0x0012C); + (0x0012E,0x0012E); + (0x00130,0x00130); + (0x00132,0x00132); + (0x00134,0x00134); + (0x00136,0x00136); + (0x00139,0x00139); + (0x0013B,0x0013B); + (0x0013D,0x0013D); + (0x0013F,0x0013F); + (0x00141,0x00141); + (0x00143,0x00143); + (0x00145,0x00145); + (0x00147,0x00147); + (0x0014A,0x0014A); + (0x0014C,0x0014C); + (0x0014E,0x0014E); + (0x00150,0x00150); + (0x00152,0x00152); + (0x00154,0x00154); + (0x00156,0x00156); + (0x00158,0x00158); + (0x0015A,0x0015A); + (0x0015C,0x0015C); + (0x0015E,0x0015E); + (0x00160,0x00160); + (0x00162,0x00162); + (0x00164,0x00164); + (0x00166,0x00166); + (0x00168,0x00168); + (0x0016A,0x0016A); + (0x0016C,0x0016C); + (0x0016E,0x0016E); + (0x00170,0x00170); + (0x00172,0x00172); + (0x00174,0x00174); + (0x00176,0x00176); + (0x00178,0x00179); + (0x0017B,0x0017B); + (0x0017D,0x0017D); + (0x00181,0x00182); + (0x00184,0x00184); + (0x00186,0x00187); + (0x00189,0x0018B); + (0x0018E,0x00191); + (0x00193,0x00194); + (0x00196,0x00198); + (0x0019C,0x0019D); + (0x0019F,0x001A0); + (0x001A2,0x001A2); + (0x001A4,0x001A4); + (0x001A6,0x001A7); + (0x001A9,0x001A9); + (0x001AC,0x001AC); + (0x001AE,0x001AF); + (0x001B1,0x001B3); + (0x001B5,0x001B5); + (0x001B7,0x001B8); + (0x001BC,0x001BC); + (0x001C4,0x001C4); + (0x001C7,0x001C7); + (0x001CA,0x001CA); + (0x001CD,0x001CD); + (0x001CF,0x001CF); + (0x001D1,0x001D1); + (0x001D3,0x001D3); + (0x001D5,0x001D5); + (0x001D7,0x001D7); + (0x001D9,0x001D9); + (0x001DB,0x001DB); + (0x001DE,0x001DE); + (0x001E0,0x001E0); + (0x001E2,0x001E2); + (0x001E4,0x001E4); + (0x001E6,0x001E6); + (0x001E8,0x001E8); + (0x001EA,0x001EA); + (0x001EC,0x001EC); + (0x001EE,0x001EE); + (0x001F1,0x001F1); + (0x001F4,0x001F4); + (0x001F6,0x001F8); + (0x001FA,0x001FA); + (0x001FC,0x001FC); + (0x001FE,0x001FE); + (0x00200,0x00200); + (0x00202,0x00202); + (0x00204,0x00204); + (0x00206,0x00206); + (0x00208,0x00208); + (0x0020A,0x0020A); + (0x0020C,0x0020C); + (0x0020E,0x0020E); + (0x00210,0x00210); + (0x00212,0x00212); + (0x00214,0x00214); + (0x00216,0x00216); + (0x00218,0x00218); + (0x0021A,0x0021A); + (0x0021C,0x0021C); + (0x0021E,0x0021E); + (0x00220,0x00220); + (0x00222,0x00222); + (0x00224,0x00224); + (0x00226,0x00226); + (0x00228,0x00228); + (0x0022A,0x0022A); + (0x0022C,0x0022C); + (0x0022E,0x0022E); + (0x00230,0x00230); + (0x00232,0x00232); + (0x0023A,0x0023B); + (0x0023D,0x0023E); + (0x00241,0x00241); + (0x00243,0x00246); + (0x00248,0x00248); + (0x0024A,0x0024A); + (0x0024C,0x0024C); + (0x0024E,0x0024E); + (0x00370,0x00370); + (0x00372,0x00372); + (0x00376,0x00376); + (0x0037F,0x0037F); + (0x00386,0x00386); + (0x00388,0x0038A); + (0x0038C,0x0038C); + (0x0038E,0x0038F); + (0x00391,0x003A1); + (0x003A3,0x003AB); + (0x003CF,0x003CF); + (0x003D2,0x003D4); + (0x003D8,0x003D8); + (0x003DA,0x003DA); + (0x003DC,0x003DC); + (0x003DE,0x003DE); + (0x003E0,0x003E0); + (0x003E2,0x003E2); + (0x003E4,0x003E4); + (0x003E6,0x003E6); + (0x003E8,0x003E8); + (0x003EA,0x003EA); + (0x003EC,0x003EC); + (0x003EE,0x003EE); + (0x003F4,0x003F4); + (0x003F7,0x003F7); + (0x003F9,0x003FA); + (0x003FD,0x0042F); + (0x00460,0x00460); + (0x00462,0x00462); + (0x00464,0x00464); + (0x00466,0x00466); + (0x00468,0x00468); + (0x0046A,0x0046A); + (0x0046C,0x0046C); + (0x0046E,0x0046E); + (0x00470,0x00470); + (0x00472,0x00472); + (0x00474,0x00474); + (0x00476,0x00476); + (0x00478,0x00478); + (0x0047A,0x0047A); + (0x0047C,0x0047C); + (0x0047E,0x0047E); + (0x00480,0x00480); + (0x0048A,0x0048A); + (0x0048C,0x0048C); + (0x0048E,0x0048E); + (0x00490,0x00490); + (0x00492,0x00492); + (0x00494,0x00494); + (0x00496,0x00496); + (0x00498,0x00498); + (0x0049A,0x0049A); + (0x0049C,0x0049C); + (0x0049E,0x0049E); + (0x004A0,0x004A0); + (0x004A2,0x004A2); + (0x004A4,0x004A4); + (0x004A6,0x004A6); + (0x004A8,0x004A8); + (0x004AA,0x004AA); + (0x004AC,0x004AC); + (0x004AE,0x004AE); + (0x004B0,0x004B0); + (0x004B2,0x004B2); + (0x004B4,0x004B4); + (0x004B6,0x004B6); + (0x004B8,0x004B8); + (0x004BA,0x004BA); + (0x004BC,0x004BC); + (0x004BE,0x004BE); + (0x004C0,0x004C1); + (0x004C3,0x004C3); + (0x004C5,0x004C5); + (0x004C7,0x004C7); + (0x004C9,0x004C9); + (0x004CB,0x004CB); + (0x004CD,0x004CD); + (0x004D0,0x004D0); + (0x004D2,0x004D2); + (0x004D4,0x004D4); + (0x004D6,0x004D6); + (0x004D8,0x004D8); + (0x004DA,0x004DA); + (0x004DC,0x004DC); + (0x004DE,0x004DE); + (0x004E0,0x004E0); + (0x004E2,0x004E2); + (0x004E4,0x004E4); + (0x004E6,0x004E6); + (0x004E8,0x004E8); + (0x004EA,0x004EA); + (0x004EC,0x004EC); + (0x004EE,0x004EE); + (0x004F0,0x004F0); + (0x004F2,0x004F2); + (0x004F4,0x004F4); + (0x004F6,0x004F6); + (0x004F8,0x004F8); + (0x004FA,0x004FA); + (0x004FC,0x004FC); + (0x004FE,0x004FE); + (0x00500,0x00500); + (0x00502,0x00502); + (0x00504,0x00504); + (0x00506,0x00506); + (0x00508,0x00508); + (0x0050A,0x0050A); + (0x0050C,0x0050C); + (0x0050E,0x0050E); + (0x00510,0x00510); + (0x00512,0x00512); + (0x00514,0x00514); + (0x00516,0x00516); + (0x00518,0x00518); + (0x0051A,0x0051A); + (0x0051C,0x0051C); + (0x0051E,0x0051E); + (0x00520,0x00520); + (0x00522,0x00522); + (0x00524,0x00524); + (0x00526,0x00526); + (0x00528,0x00528); + (0x0052A,0x0052A); + (0x0052C,0x0052C); + (0x0052E,0x0052E); + (0x00531,0x00556); + (0x010A0,0x010C5); + (0x010C7,0x010C7); + (0x010CD,0x010CD); + (0x013A0,0x013F5); + (0x01E00,0x01E00); + (0x01E02,0x01E02); + (0x01E04,0x01E04); + (0x01E06,0x01E06); + (0x01E08,0x01E08); + (0x01E0A,0x01E0A); + (0x01E0C,0x01E0C); + (0x01E0E,0x01E0E); + (0x01E10,0x01E10); + (0x01E12,0x01E12); + (0x01E14,0x01E14); + (0x01E16,0x01E16); + (0x01E18,0x01E18); + (0x01E1A,0x01E1A); + (0x01E1C,0x01E1C); + (0x01E1E,0x01E1E); + (0x01E20,0x01E20); + (0x01E22,0x01E22); + (0x01E24,0x01E24); + (0x01E26,0x01E26); + (0x01E28,0x01E28); + (0x01E2A,0x01E2A); + (0x01E2C,0x01E2C); + (0x01E2E,0x01E2E); + (0x01E30,0x01E30); + (0x01E32,0x01E32); + (0x01E34,0x01E34); + (0x01E36,0x01E36); + (0x01E38,0x01E38); + (0x01E3A,0x01E3A); + (0x01E3C,0x01E3C); + (0x01E3E,0x01E3E); + (0x01E40,0x01E40); + (0x01E42,0x01E42); + (0x01E44,0x01E44); + (0x01E46,0x01E46); + (0x01E48,0x01E48); + (0x01E4A,0x01E4A); + (0x01E4C,0x01E4C); + (0x01E4E,0x01E4E); + (0x01E50,0x01E50); + (0x01E52,0x01E52); + (0x01E54,0x01E54); + (0x01E56,0x01E56); + (0x01E58,0x01E58); + (0x01E5A,0x01E5A); + (0x01E5C,0x01E5C); + (0x01E5E,0x01E5E); + (0x01E60,0x01E60); + (0x01E62,0x01E62); + (0x01E64,0x01E64); + (0x01E66,0x01E66); + (0x01E68,0x01E68); + (0x01E6A,0x01E6A); + (0x01E6C,0x01E6C); + (0x01E6E,0x01E6E); + (0x01E70,0x01E70); + (0x01E72,0x01E72); + (0x01E74,0x01E74); + (0x01E76,0x01E76); + (0x01E78,0x01E78); + (0x01E7A,0x01E7A); + (0x01E7C,0x01E7C); + (0x01E7E,0x01E7E); + (0x01E80,0x01E80); + (0x01E82,0x01E82); + (0x01E84,0x01E84); + (0x01E86,0x01E86); + (0x01E88,0x01E88); + (0x01E8A,0x01E8A); + (0x01E8C,0x01E8C); + (0x01E8E,0x01E8E); + (0x01E90,0x01E90); + (0x01E92,0x01E92); + (0x01E94,0x01E94); + (0x01E9E,0x01E9E); + (0x01EA0,0x01EA0); + (0x01EA2,0x01EA2); + (0x01EA4,0x01EA4); + (0x01EA6,0x01EA6); + (0x01EA8,0x01EA8); + (0x01EAA,0x01EAA); + (0x01EAC,0x01EAC); + (0x01EAE,0x01EAE); + (0x01EB0,0x01EB0); + (0x01EB2,0x01EB2); + (0x01EB4,0x01EB4); + (0x01EB6,0x01EB6); + (0x01EB8,0x01EB8); + (0x01EBA,0x01EBA); + (0x01EBC,0x01EBC); + (0x01EBE,0x01EBE); + (0x01EC0,0x01EC0); + (0x01EC2,0x01EC2); + (0x01EC4,0x01EC4); + (0x01EC6,0x01EC6); + (0x01EC8,0x01EC8); + (0x01ECA,0x01ECA); + (0x01ECC,0x01ECC); + (0x01ECE,0x01ECE); + (0x01ED0,0x01ED0); + (0x01ED2,0x01ED2); + (0x01ED4,0x01ED4); + (0x01ED6,0x01ED6); + (0x01ED8,0x01ED8); + (0x01EDA,0x01EDA); + (0x01EDC,0x01EDC); + (0x01EDE,0x01EDE); + (0x01EE0,0x01EE0); + (0x01EE2,0x01EE2); + (0x01EE4,0x01EE4); + (0x01EE6,0x01EE6); + (0x01EE8,0x01EE8); + (0x01EEA,0x01EEA); + (0x01EEC,0x01EEC); + (0x01EEE,0x01EEE); + (0x01EF0,0x01EF0); + (0x01EF2,0x01EF2); + (0x01EF4,0x01EF4); + (0x01EF6,0x01EF6); + (0x01EF8,0x01EF8); + (0x01EFA,0x01EFA); + (0x01EFC,0x01EFC); + (0x01EFE,0x01EFE); + (0x01F08,0x01F0F); + (0x01F18,0x01F1D); + (0x01F28,0x01F2F); + (0x01F38,0x01F3F); + (0x01F48,0x01F4D); + (0x01F59,0x01F59); + (0x01F5B,0x01F5B); + (0x01F5D,0x01F5D); + (0x01F5F,0x01F5F); + (0x01F68,0x01F6F); + (0x01FB8,0x01FBB); + (0x01FC8,0x01FCB); + (0x01FD8,0x01FDB); + (0x01FE8,0x01FEC); + (0x01FF8,0x01FFB); + (0x02102,0x02102); + (0x02107,0x02107); + (0x0210B,0x0210D); + (0x02110,0x02112); + (0x02115,0x02115); + (0x02119,0x0211D); + (0x02124,0x02124); + (0x02126,0x02126); + (0x02128,0x02128); + (0x0212A,0x0212D); + (0x02130,0x02133); + (0x0213E,0x0213F); + (0x02145,0x02145); + (0x02183,0x02183); + (0x02C00,0x02C2E); + (0x02C60,0x02C60); + (0x02C62,0x02C64); + (0x02C67,0x02C67); + (0x02C69,0x02C69); + (0x02C6B,0x02C6B); + (0x02C6D,0x02C70); + (0x02C72,0x02C72); + (0x02C75,0x02C75); + (0x02C7E,0x02C80); + (0x02C82,0x02C82); + (0x02C84,0x02C84); + (0x02C86,0x02C86); + (0x02C88,0x02C88); + (0x02C8A,0x02C8A); + (0x02C8C,0x02C8C); + (0x02C8E,0x02C8E); + (0x02C90,0x02C90); + (0x02C92,0x02C92); + (0x02C94,0x02C94); + (0x02C96,0x02C96); + (0x02C98,0x02C98); + (0x02C9A,0x02C9A); + (0x02C9C,0x02C9C); + (0x02C9E,0x02C9E); + (0x02CA0,0x02CA0); + (0x02CA2,0x02CA2); + (0x02CA4,0x02CA4); + (0x02CA6,0x02CA6); + (0x02CA8,0x02CA8); + (0x02CAA,0x02CAA); + (0x02CAC,0x02CAC); + (0x02CAE,0x02CAE); + (0x02CB0,0x02CB0); + (0x02CB2,0x02CB2); + (0x02CB4,0x02CB4); + (0x02CB6,0x02CB6); + (0x02CB8,0x02CB8); + (0x02CBA,0x02CBA); + (0x02CBC,0x02CBC); + (0x02CBE,0x02CBE); + (0x02CC0,0x02CC0); + (0x02CC2,0x02CC2); + (0x02CC4,0x02CC4); + (0x02CC6,0x02CC6); + (0x02CC8,0x02CC8); + (0x02CCA,0x02CCA); + (0x02CCC,0x02CCC); + (0x02CCE,0x02CCE); + (0x02CD0,0x02CD0); + (0x02CD2,0x02CD2); + (0x02CD4,0x02CD4); + (0x02CD6,0x02CD6); + (0x02CD8,0x02CD8); + (0x02CDA,0x02CDA); + (0x02CDC,0x02CDC); + (0x02CDE,0x02CDE); + (0x02CE0,0x02CE0); + (0x02CE2,0x02CE2); + (0x02CEB,0x02CEB); + (0x02CED,0x02CED); + (0x02CF2,0x02CF2); + (0x0A640,0x0A640); + (0x0A642,0x0A642); + (0x0A644,0x0A644); + (0x0A646,0x0A646); + (0x0A648,0x0A648); + (0x0A64A,0x0A64A); + (0x0A64C,0x0A64C); + (0x0A64E,0x0A64E); + (0x0A650,0x0A650); + (0x0A652,0x0A652); + (0x0A654,0x0A654); + (0x0A656,0x0A656); + (0x0A658,0x0A658); + (0x0A65A,0x0A65A); + (0x0A65C,0x0A65C); + (0x0A65E,0x0A65E); + (0x0A660,0x0A660); + (0x0A662,0x0A662); + (0x0A664,0x0A664); + (0x0A666,0x0A666); + (0x0A668,0x0A668); + (0x0A66A,0x0A66A); + (0x0A66C,0x0A66C); + (0x0A680,0x0A680); + (0x0A682,0x0A682); + (0x0A684,0x0A684); + (0x0A686,0x0A686); + (0x0A688,0x0A688); + (0x0A68A,0x0A68A); + (0x0A68C,0x0A68C); + (0x0A68E,0x0A68E); + (0x0A690,0x0A690); + (0x0A692,0x0A692); + (0x0A694,0x0A694); + (0x0A696,0x0A696); + (0x0A698,0x0A698); + (0x0A69A,0x0A69A); + (0x0A722,0x0A722); + (0x0A724,0x0A724); + (0x0A726,0x0A726); + (0x0A728,0x0A728); + (0x0A72A,0x0A72A); + (0x0A72C,0x0A72C); + (0x0A72E,0x0A72E); + (0x0A732,0x0A732); + (0x0A734,0x0A734); + (0x0A736,0x0A736); + (0x0A738,0x0A738); + (0x0A73A,0x0A73A); + (0x0A73C,0x0A73C); + (0x0A73E,0x0A73E); + (0x0A740,0x0A740); + (0x0A742,0x0A742); + (0x0A744,0x0A744); + (0x0A746,0x0A746); + (0x0A748,0x0A748); + (0x0A74A,0x0A74A); + (0x0A74C,0x0A74C); + (0x0A74E,0x0A74E); + (0x0A750,0x0A750); + (0x0A752,0x0A752); + (0x0A754,0x0A754); + (0x0A756,0x0A756); + (0x0A758,0x0A758); + (0x0A75A,0x0A75A); + (0x0A75C,0x0A75C); + (0x0A75E,0x0A75E); + (0x0A760,0x0A760); + (0x0A762,0x0A762); + (0x0A764,0x0A764); + (0x0A766,0x0A766); + (0x0A768,0x0A768); + (0x0A76A,0x0A76A); + (0x0A76C,0x0A76C); + (0x0A76E,0x0A76E); + (0x0A779,0x0A779); + (0x0A77B,0x0A77B); + (0x0A77D,0x0A77E); + (0x0A780,0x0A780); + (0x0A782,0x0A782); + (0x0A784,0x0A784); + (0x0A786,0x0A786); + (0x0A78B,0x0A78B); + (0x0A78D,0x0A78D); + (0x0A790,0x0A790); + (0x0A792,0x0A792); + (0x0A796,0x0A796); + (0x0A798,0x0A798); + (0x0A79A,0x0A79A); + (0x0A79C,0x0A79C); + (0x0A79E,0x0A79E); + (0x0A7A0,0x0A7A0); + (0x0A7A2,0x0A7A2); + (0x0A7A4,0x0A7A4); + (0x0A7A6,0x0A7A6); + (0x0A7A8,0x0A7A8); + (0x0A7AA,0x0A7AE); + (0x0A7B0,0x0A7B4); + (0x0A7B6,0x0A7B6); + (0x0FF21,0x0FF3A); + (0x10400,0x10427); + (0x104B0,0x104D3); + (0x10C80,0x10CB2); + (0x118A0,0x118BF); + (0x1D400,0x1D419); + (0x1D434,0x1D44D); + (0x1D468,0x1D481); + (0x1D49C,0x1D49C); + (0x1D49E,0x1D49F); + (0x1D4A2,0x1D4A2); + (0x1D4A5,0x1D4A6); + (0x1D4A9,0x1D4AC); + (0x1D4AE,0x1D4B5); + (0x1D4D0,0x1D4E9); + (0x1D504,0x1D505); + (0x1D507,0x1D50A); + (0x1D50D,0x1D514); + (0x1D516,0x1D51C); + (0x1D538,0x1D539); + (0x1D53B,0x1D53E); + (0x1D540,0x1D544); + (0x1D546,0x1D546); + (0x1D54A,0x1D550); + (0x1D56C,0x1D585); + (0x1D5A0,0x1D5B9); + (0x1D5D4,0x1D5ED); + (0x1D608,0x1D621); + (0x1D63C,0x1D655); + (0x1D670,0x1D689); + (0x1D6A8,0x1D6C0); + (0x1D6E2,0x1D6FA); + (0x1D71C,0x1D734); + (0x1D756,0x1D76E); + (0x1D790,0x1D7A8); + (0x1D7CA,0x1D7CA) +] +(* Letter, Lowercase *) +let ll = [ + (0x00061,0x0007A); + (0x000B5,0x000B5); + (0x000DF,0x000F6); + (0x000F8,0x000FF); + (0x00101,0x00101); + (0x00103,0x00103); + (0x00105,0x00105); + (0x00107,0x00107); + (0x00109,0x00109); + (0x0010B,0x0010B); + (0x0010D,0x0010D); + (0x0010F,0x0010F); + (0x00111,0x00111); + (0x00113,0x00113); + (0x00115,0x00115); + (0x00117,0x00117); + (0x00119,0x00119); + (0x0011B,0x0011B); + (0x0011D,0x0011D); + (0x0011F,0x0011F); + (0x00121,0x00121); + (0x00123,0x00123); + (0x00125,0x00125); + (0x00127,0x00127); + (0x00129,0x00129); + (0x0012B,0x0012B); + (0x0012D,0x0012D); + (0x0012F,0x0012F); + (0x00131,0x00131); + (0x00133,0x00133); + (0x00135,0x00135); + (0x00137,0x00138); + (0x0013A,0x0013A); + (0x0013C,0x0013C); + (0x0013E,0x0013E); + (0x00140,0x00140); + (0x00142,0x00142); + (0x00144,0x00144); + (0x00146,0x00146); + (0x00148,0x00149); + (0x0014B,0x0014B); + (0x0014D,0x0014D); + (0x0014F,0x0014F); + (0x00151,0x00151); + (0x00153,0x00153); + (0x00155,0x00155); + (0x00157,0x00157); + (0x00159,0x00159); + (0x0015B,0x0015B); + (0x0015D,0x0015D); + (0x0015F,0x0015F); + (0x00161,0x00161); + (0x00163,0x00163); + (0x00165,0x00165); + (0x00167,0x00167); + (0x00169,0x00169); + (0x0016B,0x0016B); + (0x0016D,0x0016D); + (0x0016F,0x0016F); + (0x00171,0x00171); + (0x00173,0x00173); + (0x00175,0x00175); + (0x00177,0x00177); + (0x0017A,0x0017A); + (0x0017C,0x0017C); + (0x0017E,0x00180); + (0x00183,0x00183); + (0x00185,0x00185); + (0x00188,0x00188); + (0x0018C,0x0018D); + (0x00192,0x00192); + (0x00195,0x00195); + (0x00199,0x0019B); + (0x0019E,0x0019E); + (0x001A1,0x001A1); + (0x001A3,0x001A3); + (0x001A5,0x001A5); + (0x001A8,0x001A8); + (0x001AA,0x001AB); + (0x001AD,0x001AD); + (0x001B0,0x001B0); + (0x001B4,0x001B4); + (0x001B6,0x001B6); + (0x001B9,0x001BA); + (0x001BD,0x001BF); + (0x001C6,0x001C6); + (0x001C9,0x001C9); + (0x001CC,0x001CC); + (0x001CE,0x001CE); + (0x001D0,0x001D0); + (0x001D2,0x001D2); + (0x001D4,0x001D4); + (0x001D6,0x001D6); + (0x001D8,0x001D8); + (0x001DA,0x001DA); + (0x001DC,0x001DD); + (0x001DF,0x001DF); + (0x001E1,0x001E1); + (0x001E3,0x001E3); + (0x001E5,0x001E5); + (0x001E7,0x001E7); + (0x001E9,0x001E9); + (0x001EB,0x001EB); + (0x001ED,0x001ED); + (0x001EF,0x001F0); + (0x001F3,0x001F3); + (0x001F5,0x001F5); + (0x001F9,0x001F9); + (0x001FB,0x001FB); + (0x001FD,0x001FD); + (0x001FF,0x001FF); + (0x00201,0x00201); + (0x00203,0x00203); + (0x00205,0x00205); + (0x00207,0x00207); + (0x00209,0x00209); + (0x0020B,0x0020B); + (0x0020D,0x0020D); + (0x0020F,0x0020F); + (0x00211,0x00211); + (0x00213,0x00213); + (0x00215,0x00215); + (0x00217,0x00217); + (0x00219,0x00219); + (0x0021B,0x0021B); + (0x0021D,0x0021D); + (0x0021F,0x0021F); + (0x00221,0x00221); + (0x00223,0x00223); + (0x00225,0x00225); + (0x00227,0x00227); + (0x00229,0x00229); + (0x0022B,0x0022B); + (0x0022D,0x0022D); + (0x0022F,0x0022F); + (0x00231,0x00231); + (0x00233,0x00239); + (0x0023C,0x0023C); + (0x0023F,0x00240); + (0x00242,0x00242); + (0x00247,0x00247); + (0x00249,0x00249); + (0x0024B,0x0024B); + (0x0024D,0x0024D); + (0x0024F,0x00293); + (0x00295,0x002AF); + (0x00371,0x00371); + (0x00373,0x00373); + (0x00377,0x00377); + (0x0037B,0x0037D); + (0x00390,0x00390); + (0x003AC,0x003CE); + (0x003D0,0x003D1); + (0x003D5,0x003D7); + (0x003D9,0x003D9); + (0x003DB,0x003DB); + (0x003DD,0x003DD); + (0x003DF,0x003DF); + (0x003E1,0x003E1); + (0x003E3,0x003E3); + (0x003E5,0x003E5); + (0x003E7,0x003E7); + (0x003E9,0x003E9); + (0x003EB,0x003EB); + (0x003ED,0x003ED); + (0x003EF,0x003F3); + (0x003F5,0x003F5); + (0x003F8,0x003F8); + (0x003FB,0x003FC); + (0x00430,0x0045F); + (0x00461,0x00461); + (0x00463,0x00463); + (0x00465,0x00465); + (0x00467,0x00467); + (0x00469,0x00469); + (0x0046B,0x0046B); + (0x0046D,0x0046D); + (0x0046F,0x0046F); + (0x00471,0x00471); + (0x00473,0x00473); + (0x00475,0x00475); + (0x00477,0x00477); + (0x00479,0x00479); + (0x0047B,0x0047B); + (0x0047D,0x0047D); + (0x0047F,0x0047F); + (0x00481,0x00481); + (0x0048B,0x0048B); + (0x0048D,0x0048D); + (0x0048F,0x0048F); + (0x00491,0x00491); + (0x00493,0x00493); + (0x00495,0x00495); + (0x00497,0x00497); + (0x00499,0x00499); + (0x0049B,0x0049B); + (0x0049D,0x0049D); + (0x0049F,0x0049F); + (0x004A1,0x004A1); + (0x004A3,0x004A3); + (0x004A5,0x004A5); + (0x004A7,0x004A7); + (0x004A9,0x004A9); + (0x004AB,0x004AB); + (0x004AD,0x004AD); + (0x004AF,0x004AF); + (0x004B1,0x004B1); + (0x004B3,0x004B3); + (0x004B5,0x004B5); + (0x004B7,0x004B7); + (0x004B9,0x004B9); + (0x004BB,0x004BB); + (0x004BD,0x004BD); + (0x004BF,0x004BF); + (0x004C2,0x004C2); + (0x004C4,0x004C4); + (0x004C6,0x004C6); + (0x004C8,0x004C8); + (0x004CA,0x004CA); + (0x004CC,0x004CC); + (0x004CE,0x004CF); + (0x004D1,0x004D1); + (0x004D3,0x004D3); + (0x004D5,0x004D5); + (0x004D7,0x004D7); + (0x004D9,0x004D9); + (0x004DB,0x004DB); + (0x004DD,0x004DD); + (0x004DF,0x004DF); + (0x004E1,0x004E1); + (0x004E3,0x004E3); + (0x004E5,0x004E5); + (0x004E7,0x004E7); + (0x004E9,0x004E9); + (0x004EB,0x004EB); + (0x004ED,0x004ED); + (0x004EF,0x004EF); + (0x004F1,0x004F1); + (0x004F3,0x004F3); + (0x004F5,0x004F5); + (0x004F7,0x004F7); + (0x004F9,0x004F9); + (0x004FB,0x004FB); + (0x004FD,0x004FD); + (0x004FF,0x004FF); + (0x00501,0x00501); + (0x00503,0x00503); + (0x00505,0x00505); + (0x00507,0x00507); + (0x00509,0x00509); + (0x0050B,0x0050B); + (0x0050D,0x0050D); + (0x0050F,0x0050F); + (0x00511,0x00511); + (0x00513,0x00513); + (0x00515,0x00515); + (0x00517,0x00517); + (0x00519,0x00519); + (0x0051B,0x0051B); + (0x0051D,0x0051D); + (0x0051F,0x0051F); + (0x00521,0x00521); + (0x00523,0x00523); + (0x00525,0x00525); + (0x00527,0x00527); + (0x00529,0x00529); + (0x0052B,0x0052B); + (0x0052D,0x0052D); + (0x0052F,0x0052F); + (0x00561,0x00587); + (0x013F8,0x013FD); + (0x01C80,0x01C88); + (0x01D00,0x01D2B); + (0x01D6B,0x01D77); + (0x01D79,0x01D9A); + (0x01E01,0x01E01); + (0x01E03,0x01E03); + (0x01E05,0x01E05); + (0x01E07,0x01E07); + (0x01E09,0x01E09); + (0x01E0B,0x01E0B); + (0x01E0D,0x01E0D); + (0x01E0F,0x01E0F); + (0x01E11,0x01E11); + (0x01E13,0x01E13); + (0x01E15,0x01E15); + (0x01E17,0x01E17); + (0x01E19,0x01E19); + (0x01E1B,0x01E1B); + (0x01E1D,0x01E1D); + (0x01E1F,0x01E1F); + (0x01E21,0x01E21); + (0x01E23,0x01E23); + (0x01E25,0x01E25); + (0x01E27,0x01E27); + (0x01E29,0x01E29); + (0x01E2B,0x01E2B); + (0x01E2D,0x01E2D); + (0x01E2F,0x01E2F); + (0x01E31,0x01E31); + (0x01E33,0x01E33); + (0x01E35,0x01E35); + (0x01E37,0x01E37); + (0x01E39,0x01E39); + (0x01E3B,0x01E3B); + (0x01E3D,0x01E3D); + (0x01E3F,0x01E3F); + (0x01E41,0x01E41); + (0x01E43,0x01E43); + (0x01E45,0x01E45); + (0x01E47,0x01E47); + (0x01E49,0x01E49); + (0x01E4B,0x01E4B); + (0x01E4D,0x01E4D); + (0x01E4F,0x01E4F); + (0x01E51,0x01E51); + (0x01E53,0x01E53); + (0x01E55,0x01E55); + (0x01E57,0x01E57); + (0x01E59,0x01E59); + (0x01E5B,0x01E5B); + (0x01E5D,0x01E5D); + (0x01E5F,0x01E5F); + (0x01E61,0x01E61); + (0x01E63,0x01E63); + (0x01E65,0x01E65); + (0x01E67,0x01E67); + (0x01E69,0x01E69); + (0x01E6B,0x01E6B); + (0x01E6D,0x01E6D); + (0x01E6F,0x01E6F); + (0x01E71,0x01E71); + (0x01E73,0x01E73); + (0x01E75,0x01E75); + (0x01E77,0x01E77); + (0x01E79,0x01E79); + (0x01E7B,0x01E7B); + (0x01E7D,0x01E7D); + (0x01E7F,0x01E7F); + (0x01E81,0x01E81); + (0x01E83,0x01E83); + (0x01E85,0x01E85); + (0x01E87,0x01E87); + (0x01E89,0x01E89); + (0x01E8B,0x01E8B); + (0x01E8D,0x01E8D); + (0x01E8F,0x01E8F); + (0x01E91,0x01E91); + (0x01E93,0x01E93); + (0x01E95,0x01E9D); + (0x01E9F,0x01E9F); + (0x01EA1,0x01EA1); + (0x01EA3,0x01EA3); + (0x01EA5,0x01EA5); + (0x01EA7,0x01EA7); + (0x01EA9,0x01EA9); + (0x01EAB,0x01EAB); + (0x01EAD,0x01EAD); + (0x01EAF,0x01EAF); + (0x01EB1,0x01EB1); + (0x01EB3,0x01EB3); + (0x01EB5,0x01EB5); + (0x01EB7,0x01EB7); + (0x01EB9,0x01EB9); + (0x01EBB,0x01EBB); + (0x01EBD,0x01EBD); + (0x01EBF,0x01EBF); + (0x01EC1,0x01EC1); + (0x01EC3,0x01EC3); + (0x01EC5,0x01EC5); + (0x01EC7,0x01EC7); + (0x01EC9,0x01EC9); + (0x01ECB,0x01ECB); + (0x01ECD,0x01ECD); + (0x01ECF,0x01ECF); + (0x01ED1,0x01ED1); + (0x01ED3,0x01ED3); + (0x01ED5,0x01ED5); + (0x01ED7,0x01ED7); + (0x01ED9,0x01ED9); + (0x01EDB,0x01EDB); + (0x01EDD,0x01EDD); + (0x01EDF,0x01EDF); + (0x01EE1,0x01EE1); + (0x01EE3,0x01EE3); + (0x01EE5,0x01EE5); + (0x01EE7,0x01EE7); + (0x01EE9,0x01EE9); + (0x01EEB,0x01EEB); + (0x01EED,0x01EED); + (0x01EEF,0x01EEF); + (0x01EF1,0x01EF1); + (0x01EF3,0x01EF3); + (0x01EF5,0x01EF5); + (0x01EF7,0x01EF7); + (0x01EF9,0x01EF9); + (0x01EFB,0x01EFB); + (0x01EFD,0x01EFD); + (0x01EFF,0x01F07); + (0x01F10,0x01F15); + (0x01F20,0x01F27); + (0x01F30,0x01F37); + (0x01F40,0x01F45); + (0x01F50,0x01F57); + (0x01F60,0x01F67); + (0x01F70,0x01F7D); + (0x01F80,0x01F87); + (0x01F90,0x01F97); + (0x01FA0,0x01FA7); + (0x01FB0,0x01FB4); + (0x01FB6,0x01FB7); + (0x01FBE,0x01FBE); + (0x01FC2,0x01FC4); + (0x01FC6,0x01FC7); + (0x01FD0,0x01FD3); + (0x01FD6,0x01FD7); + (0x01FE0,0x01FE7); + (0x01FF2,0x01FF4); + (0x01FF6,0x01FF7); + (0x0210A,0x0210A); + (0x0210E,0x0210F); + (0x02113,0x02113); + (0x0212F,0x0212F); + (0x02134,0x02134); + (0x02139,0x02139); + (0x0213C,0x0213D); + (0x02146,0x02149); + (0x0214E,0x0214E); + (0x02184,0x02184); + (0x02C30,0x02C5E); + (0x02C61,0x02C61); + (0x02C65,0x02C66); + (0x02C68,0x02C68); + (0x02C6A,0x02C6A); + (0x02C6C,0x02C6C); + (0x02C71,0x02C71); + (0x02C73,0x02C74); + (0x02C76,0x02C7B); + (0x02C81,0x02C81); + (0x02C83,0x02C83); + (0x02C85,0x02C85); + (0x02C87,0x02C87); + (0x02C89,0x02C89); + (0x02C8B,0x02C8B); + (0x02C8D,0x02C8D); + (0x02C8F,0x02C8F); + (0x02C91,0x02C91); + (0x02C93,0x02C93); + (0x02C95,0x02C95); + (0x02C97,0x02C97); + (0x02C99,0x02C99); + (0x02C9B,0x02C9B); + (0x02C9D,0x02C9D); + (0x02C9F,0x02C9F); + (0x02CA1,0x02CA1); + (0x02CA3,0x02CA3); + (0x02CA5,0x02CA5); + (0x02CA7,0x02CA7); + (0x02CA9,0x02CA9); + (0x02CAB,0x02CAB); + (0x02CAD,0x02CAD); + (0x02CAF,0x02CAF); + (0x02CB1,0x02CB1); + (0x02CB3,0x02CB3); + (0x02CB5,0x02CB5); + (0x02CB7,0x02CB7); + (0x02CB9,0x02CB9); + (0x02CBB,0x02CBB); + (0x02CBD,0x02CBD); + (0x02CBF,0x02CBF); + (0x02CC1,0x02CC1); + (0x02CC3,0x02CC3); + (0x02CC5,0x02CC5); + (0x02CC7,0x02CC7); + (0x02CC9,0x02CC9); + (0x02CCB,0x02CCB); + (0x02CCD,0x02CCD); + (0x02CCF,0x02CCF); + (0x02CD1,0x02CD1); + (0x02CD3,0x02CD3); + (0x02CD5,0x02CD5); + (0x02CD7,0x02CD7); + (0x02CD9,0x02CD9); + (0x02CDB,0x02CDB); + (0x02CDD,0x02CDD); + (0x02CDF,0x02CDF); + (0x02CE1,0x02CE1); + (0x02CE3,0x02CE4); + (0x02CEC,0x02CEC); + (0x02CEE,0x02CEE); + (0x02CF3,0x02CF3); + (0x02D00,0x02D25); + (0x02D27,0x02D27); + (0x02D2D,0x02D2D); + (0x0A641,0x0A641); + (0x0A643,0x0A643); + (0x0A645,0x0A645); + (0x0A647,0x0A647); + (0x0A649,0x0A649); + (0x0A64B,0x0A64B); + (0x0A64D,0x0A64D); + (0x0A64F,0x0A64F); + (0x0A651,0x0A651); + (0x0A653,0x0A653); + (0x0A655,0x0A655); + (0x0A657,0x0A657); + (0x0A659,0x0A659); + (0x0A65B,0x0A65B); + (0x0A65D,0x0A65D); + (0x0A65F,0x0A65F); + (0x0A661,0x0A661); + (0x0A663,0x0A663); + (0x0A665,0x0A665); + (0x0A667,0x0A667); + (0x0A669,0x0A669); + (0x0A66B,0x0A66B); + (0x0A66D,0x0A66D); + (0x0A681,0x0A681); + (0x0A683,0x0A683); + (0x0A685,0x0A685); + (0x0A687,0x0A687); + (0x0A689,0x0A689); + (0x0A68B,0x0A68B); + (0x0A68D,0x0A68D); + (0x0A68F,0x0A68F); + (0x0A691,0x0A691); + (0x0A693,0x0A693); + (0x0A695,0x0A695); + (0x0A697,0x0A697); + (0x0A699,0x0A699); + (0x0A69B,0x0A69B); + (0x0A723,0x0A723); + (0x0A725,0x0A725); + (0x0A727,0x0A727); + (0x0A729,0x0A729); + (0x0A72B,0x0A72B); + (0x0A72D,0x0A72D); + (0x0A72F,0x0A731); + (0x0A733,0x0A733); + (0x0A735,0x0A735); + (0x0A737,0x0A737); + (0x0A739,0x0A739); + (0x0A73B,0x0A73B); + (0x0A73D,0x0A73D); + (0x0A73F,0x0A73F); + (0x0A741,0x0A741); + (0x0A743,0x0A743); + (0x0A745,0x0A745); + (0x0A747,0x0A747); + (0x0A749,0x0A749); + (0x0A74B,0x0A74B); + (0x0A74D,0x0A74D); + (0x0A74F,0x0A74F); + (0x0A751,0x0A751); + (0x0A753,0x0A753); + (0x0A755,0x0A755); + (0x0A757,0x0A757); + (0x0A759,0x0A759); + (0x0A75B,0x0A75B); + (0x0A75D,0x0A75D); + (0x0A75F,0x0A75F); + (0x0A761,0x0A761); + (0x0A763,0x0A763); + (0x0A765,0x0A765); + (0x0A767,0x0A767); + (0x0A769,0x0A769); + (0x0A76B,0x0A76B); + (0x0A76D,0x0A76D); + (0x0A76F,0x0A76F); + (0x0A771,0x0A778); + (0x0A77A,0x0A77A); + (0x0A77C,0x0A77C); + (0x0A77F,0x0A77F); + (0x0A781,0x0A781); + (0x0A783,0x0A783); + (0x0A785,0x0A785); + (0x0A787,0x0A787); + (0x0A78C,0x0A78C); + (0x0A78E,0x0A78E); + (0x0A791,0x0A791); + (0x0A793,0x0A795); + (0x0A797,0x0A797); + (0x0A799,0x0A799); + (0x0A79B,0x0A79B); + (0x0A79D,0x0A79D); + (0x0A79F,0x0A79F); + (0x0A7A1,0x0A7A1); + (0x0A7A3,0x0A7A3); + (0x0A7A5,0x0A7A5); + (0x0A7A7,0x0A7A7); + (0x0A7A9,0x0A7A9); + (0x0A7B5,0x0A7B5); + (0x0A7B7,0x0A7B7); + (0x0A7FA,0x0A7FA); + (0x0AB30,0x0AB5A); + (0x0AB60,0x0AB65); + (0x0AB70,0x0ABBF); + (0x0FB00,0x0FB06); + (0x0FB13,0x0FB17); + (0x0FF41,0x0FF5A); + (0x10428,0x1044F); + (0x104D8,0x104FB); + (0x10CC0,0x10CF2); + (0x118C0,0x118DF); + (0x1D41A,0x1D433); + (0x1D44E,0x1D454); + (0x1D456,0x1D467); + (0x1D482,0x1D49B); + (0x1D4B6,0x1D4B9); + (0x1D4BB,0x1D4BB); + (0x1D4BD,0x1D4C3); + (0x1D4C5,0x1D4CF); + (0x1D4EA,0x1D503); + (0x1D51E,0x1D537); + (0x1D552,0x1D56B); + (0x1D586,0x1D59F); + (0x1D5BA,0x1D5D3); + (0x1D5EE,0x1D607); + (0x1D622,0x1D63B); + (0x1D656,0x1D66F); + (0x1D68A,0x1D6A5); + (0x1D6C2,0x1D6DA); + (0x1D6DC,0x1D6E1); + (0x1D6FC,0x1D714); + (0x1D716,0x1D71B); + (0x1D736,0x1D74E); + (0x1D750,0x1D755); + (0x1D770,0x1D788); + (0x1D78A,0x1D78F); + (0x1D7AA,0x1D7C2); + (0x1D7C4,0x1D7C9); + (0x1D7CB,0x1D7CB) +] +(* Letter, Titlecase *) +let lt = [ + (0x001C5,0x001C5); + (0x001C8,0x001C8); + (0x001CB,0x001CB); + (0x001F2,0x001F2); + (0x01F88,0x01F8F); + (0x01F98,0x01F9F); + (0x01FA8,0x01FAF); + (0x01FBC,0x01FBC); + (0x01FCC,0x01FCC) +] +(* Mark, Non-Spacing *) +let mn = [ + (0x00300,0x0036F); + (0x00483,0x00487); + (0x00591,0x005BD); + (0x005BF,0x005BF); + (0x005C1,0x005C2); + (0x005C4,0x005C5); + (0x005C7,0x005C7); + (0x00610,0x0061A); + (0x0064B,0x0065F); + (0x00670,0x00670); + (0x006D6,0x006DC); + (0x006DF,0x006E4); + (0x006E7,0x006E8); + (0x006EA,0x006ED); + (0x00711,0x00711); + (0x00730,0x0074A); + (0x007A6,0x007B0); + (0x007EB,0x007F3); + (0x00816,0x00819); + (0x0081B,0x00823); + (0x00825,0x00827); + (0x00829,0x0082D); + (0x00859,0x0085B); + (0x008D4,0x008E1); + (0x008E3,0x00902); + (0x0093A,0x0093A); + (0x0093C,0x0093C); + (0x00941,0x00948); + (0x0094D,0x0094D); + (0x00951,0x00957); + (0x00962,0x00963); + (0x00981,0x00981); + (0x009BC,0x009BC); + (0x009C1,0x009C4); + (0x009CD,0x009CD); + (0x009E2,0x009E3); + (0x00A01,0x00A02); + (0x00A3C,0x00A3C); + (0x00A41,0x00A42); + (0x00A47,0x00A48); + (0x00A4B,0x00A4D); + (0x00A51,0x00A51); + (0x00A70,0x00A71); + (0x00A75,0x00A75); + (0x00A81,0x00A82); + (0x00ABC,0x00ABC); + (0x00AC1,0x00AC5); + (0x00AC7,0x00AC8); + (0x00ACD,0x00ACD); + (0x00AE2,0x00AE3); + (0x00B01,0x00B01); + (0x00B3C,0x00B3C); + (0x00B3F,0x00B3F); + (0x00B41,0x00B44); + (0x00B4D,0x00B4D); + (0x00B56,0x00B56); + (0x00B62,0x00B63); + (0x00B82,0x00B82); + (0x00BC0,0x00BC0); + (0x00BCD,0x00BCD); + (0x00C00,0x00C00); + (0x00C3E,0x00C40); + (0x00C46,0x00C48); + (0x00C4A,0x00C4D); + (0x00C55,0x00C56); + (0x00C62,0x00C63); + (0x00C81,0x00C81); + (0x00CBC,0x00CBC); + (0x00CBF,0x00CBF); + (0x00CC6,0x00CC6); + (0x00CCC,0x00CCD); + (0x00CE2,0x00CE3); + (0x00D01,0x00D01); + (0x00D41,0x00D44); + (0x00D4D,0x00D4D); + (0x00D62,0x00D63); + (0x00DCA,0x00DCA); + (0x00DD2,0x00DD4); + (0x00DD6,0x00DD6); + (0x00E31,0x00E31); + (0x00E34,0x00E3A); + (0x00E47,0x00E4E); + (0x00EB1,0x00EB1); + (0x00EB4,0x00EB9); + (0x00EBB,0x00EBC); + (0x00EC8,0x00ECD); + (0x00F18,0x00F19); + (0x00F35,0x00F35); + (0x00F37,0x00F37); + (0x00F39,0x00F39); + (0x00F71,0x00F7E); + (0x00F80,0x00F84); + (0x00F86,0x00F87); + (0x00F8D,0x00F97); + (0x00F99,0x00FBC); + (0x00FC6,0x00FC6); + (0x0102D,0x01030); + (0x01032,0x01037); + (0x01039,0x0103A); + (0x0103D,0x0103E); + (0x01058,0x01059); + (0x0105E,0x01060); + (0x01071,0x01074); + (0x01082,0x01082); + (0x01085,0x01086); + (0x0108D,0x0108D); + (0x0109D,0x0109D); + (0x0135D,0x0135F); + (0x01712,0x01714); + (0x01732,0x01734); + (0x01752,0x01753); + (0x01772,0x01773); + (0x017B4,0x017B5); + (0x017B7,0x017BD); + (0x017C6,0x017C6); + (0x017C9,0x017D3); + (0x017DD,0x017DD); + (0x0180B,0x0180D); + (0x01885,0x01886); + (0x018A9,0x018A9); + (0x01920,0x01922); + (0x01927,0x01928); + (0x01932,0x01932); + (0x01939,0x0193B); + (0x01A17,0x01A18); + (0x01A1B,0x01A1B); + (0x01A56,0x01A56); + (0x01A58,0x01A5E); + (0x01A60,0x01A60); + (0x01A62,0x01A62); + (0x01A65,0x01A6C); + (0x01A73,0x01A7C); + (0x01A7F,0x01A7F); + (0x01AB0,0x01ABD); + (0x01B00,0x01B03); + (0x01B34,0x01B34); + (0x01B36,0x01B3A); + (0x01B3C,0x01B3C); + (0x01B42,0x01B42); + (0x01B6B,0x01B73); + (0x01B80,0x01B81); + (0x01BA2,0x01BA5); + (0x01BA8,0x01BA9); + (0x01BAB,0x01BAD); + (0x01BE6,0x01BE6); + (0x01BE8,0x01BE9); + (0x01BED,0x01BED); + (0x01BEF,0x01BF1); + (0x01C2C,0x01C33); + (0x01C36,0x01C37); + (0x01CD0,0x01CD2); + (0x01CD4,0x01CE0); + (0x01CE2,0x01CE8); + (0x01CED,0x01CED); + (0x01CF4,0x01CF4); + (0x01CF8,0x01CF9); + (0x01DC0,0x01DF5); + (0x01DFB,0x01DFF); + (0x020D0,0x020DC); + (0x020E1,0x020E1); + (0x020E5,0x020F0); + (0x02CEF,0x02CF1); + (0x02D7F,0x02D7F); + (0x02DE0,0x02DFF); + (0x0302A,0x0302D); + (0x03099,0x0309A); + (0x0A66F,0x0A66F); + (0x0A674,0x0A67D); + (0x0A69E,0x0A69F); + (0x0A6F0,0x0A6F1); + (0x0A802,0x0A802); + (0x0A806,0x0A806); + (0x0A80B,0x0A80B); + (0x0A825,0x0A826); + (0x0A8C4,0x0A8C5); + (0x0A8E0,0x0A8F1); + (0x0A926,0x0A92D); + (0x0A947,0x0A951); + (0x0A980,0x0A982); + (0x0A9B3,0x0A9B3); + (0x0A9B6,0x0A9B9); + (0x0A9BC,0x0A9BC); + (0x0A9E5,0x0A9E5); + (0x0AA29,0x0AA2E); + (0x0AA31,0x0AA32); + (0x0AA35,0x0AA36); + (0x0AA43,0x0AA43); + (0x0AA4C,0x0AA4C); + (0x0AA7C,0x0AA7C); + (0x0AAB0,0x0AAB0); + (0x0AAB2,0x0AAB4); + (0x0AAB7,0x0AAB8); + (0x0AABE,0x0AABF); + (0x0AAC1,0x0AAC1); + (0x0AAEC,0x0AAED); + (0x0AAF6,0x0AAF6); + (0x0ABE5,0x0ABE5); + (0x0ABE8,0x0ABE8); + (0x0ABED,0x0ABED); + (0x0FB1E,0x0FB1E); + (0x0FE00,0x0FE0F); + (0x0FE20,0x0FE2F); + (0x101FD,0x101FD); + (0x102E0,0x102E0); + (0x10376,0x1037A); + (0x10A01,0x10A03); + (0x10A05,0x10A06); + (0x10A0C,0x10A0F); + (0x10A38,0x10A3A); + (0x10A3F,0x10A3F); + (0x10AE5,0x10AE6); + (0x11001,0x11001); + (0x11038,0x11046); + (0x1107F,0x11081); + (0x110B3,0x110B6); + (0x110B9,0x110BA); + (0x11100,0x11102); + (0x11127,0x1112B); + (0x1112D,0x11134); + (0x11173,0x11173); + (0x11180,0x11181); + (0x111B6,0x111BE); + (0x111CA,0x111CC); + (0x1122F,0x11231); + (0x11234,0x11234); + (0x11236,0x11237); + (0x1123E,0x1123E); + (0x112DF,0x112DF); + (0x112E3,0x112EA); + (0x11300,0x11301); + (0x1133C,0x1133C); + (0x11340,0x11340); + (0x11366,0x1136C); + (0x11370,0x11374); + (0x11438,0x1143F); + (0x11442,0x11444); + (0x11446,0x11446); + (0x114B3,0x114B8); + (0x114BA,0x114BA); + (0x114BF,0x114C0); + (0x114C2,0x114C3); + (0x115B2,0x115B5); + (0x115BC,0x115BD); + (0x115BF,0x115C0); + (0x115DC,0x115DD); + (0x11633,0x1163A); + (0x1163D,0x1163D); + (0x1163F,0x11640); + (0x116AB,0x116AB); + (0x116AD,0x116AD); + (0x116B0,0x116B5); + (0x116B7,0x116B7); + (0x1171D,0x1171F); + (0x11722,0x11725); + (0x11727,0x1172B); + (0x11C30,0x11C36); + (0x11C38,0x11C3D); + (0x11C3F,0x11C3F); + (0x11C92,0x11CA7); + (0x11CAA,0x11CB0); + (0x11CB2,0x11CB3); + (0x11CB5,0x11CB6); + (0x16AF0,0x16AF4); + (0x16B30,0x16B36); + (0x16F8F,0x16F92); + (0x1BC9D,0x1BC9E); + (0x1D167,0x1D169); + (0x1D17B,0x1D182); + (0x1D185,0x1D18B); + (0x1D1AA,0x1D1AD); + (0x1D242,0x1D244); + (0x1DA00,0x1DA36); + (0x1DA3B,0x1DA6C); + (0x1DA75,0x1DA75); + (0x1DA84,0x1DA84); + (0x1DA9B,0x1DA9F); + (0x1DAA1,0x1DAAF); + (0x1E000,0x1E006); + (0x1E008,0x1E018); + (0x1E01B,0x1E021); + (0x1E023,0x1E024); + (0x1E026,0x1E02A); + (0x1E8D0,0x1E8D6); + (0x1E944,0x1E94A) +] +(* Mark, Spacing Combining *) +let mc = [ + (0x00903,0x00903); + (0x0093B,0x0093B); + (0x0093E,0x00940); + (0x00949,0x0094C); + (0x0094E,0x0094F); + (0x00982,0x00983); + (0x009BE,0x009C0); + (0x009C7,0x009C8); + (0x009CB,0x009CC); + (0x009D7,0x009D7); + (0x00A03,0x00A03); + (0x00A3E,0x00A40); + (0x00A83,0x00A83); + (0x00ABE,0x00AC0); + (0x00AC9,0x00AC9); + (0x00ACB,0x00ACC); + (0x00B02,0x00B03); + (0x00B3E,0x00B3E); + (0x00B40,0x00B40); + (0x00B47,0x00B48); + (0x00B4B,0x00B4C); + (0x00B57,0x00B57); + (0x00BBE,0x00BBF); + (0x00BC1,0x00BC2); + (0x00BC6,0x00BC8); + (0x00BCA,0x00BCC); + (0x00BD7,0x00BD7); + (0x00C01,0x00C03); + (0x00C41,0x00C44); + (0x00C82,0x00C83); + (0x00CBE,0x00CBE); + (0x00CC0,0x00CC4); + (0x00CC7,0x00CC8); + (0x00CCA,0x00CCB); + (0x00CD5,0x00CD6); + (0x00D02,0x00D03); + (0x00D3E,0x00D40); + (0x00D46,0x00D48); + (0x00D4A,0x00D4C); + (0x00D57,0x00D57); + (0x00D82,0x00D83); + (0x00DCF,0x00DD1); + (0x00DD8,0x00DDF); + (0x00DF2,0x00DF3); + (0x00F3E,0x00F3F); + (0x00F7F,0x00F7F); + (0x0102B,0x0102C); + (0x01031,0x01031); + (0x01038,0x01038); + (0x0103B,0x0103C); + (0x01056,0x01057); + (0x01062,0x01064); + (0x01067,0x0106D); + (0x01083,0x01084); + (0x01087,0x0108C); + (0x0108F,0x0108F); + (0x0109A,0x0109C); + (0x017B6,0x017B6); + (0x017BE,0x017C5); + (0x017C7,0x017C8); + (0x01923,0x01926); + (0x01929,0x0192B); + (0x01930,0x01931); + (0x01933,0x01938); + (0x01A19,0x01A1A); + (0x01A55,0x01A55); + (0x01A57,0x01A57); + (0x01A61,0x01A61); + (0x01A63,0x01A64); + (0x01A6D,0x01A72); + (0x01B04,0x01B04); + (0x01B35,0x01B35); + (0x01B3B,0x01B3B); + (0x01B3D,0x01B41); + (0x01B43,0x01B44); + (0x01B82,0x01B82); + (0x01BA1,0x01BA1); + (0x01BA6,0x01BA7); + (0x01BAA,0x01BAA); + (0x01BE7,0x01BE7); + (0x01BEA,0x01BEC); + (0x01BEE,0x01BEE); + (0x01BF2,0x01BF3); + (0x01C24,0x01C2B); + (0x01C34,0x01C35); + (0x01CE1,0x01CE1); + (0x01CF2,0x01CF3); + (0x0302E,0x0302F); + (0x0A823,0x0A824); + (0x0A827,0x0A827); + (0x0A880,0x0A881); + (0x0A8B4,0x0A8C3); + (0x0A952,0x0A953); + (0x0A983,0x0A983); + (0x0A9B4,0x0A9B5); + (0x0A9BA,0x0A9BB); + (0x0A9BD,0x0A9C0); + (0x0AA2F,0x0AA30); + (0x0AA33,0x0AA34); + (0x0AA4D,0x0AA4D); + (0x0AA7B,0x0AA7B); + (0x0AA7D,0x0AA7D); + (0x0AAEB,0x0AAEB); + (0x0AAEE,0x0AAEF); + (0x0AAF5,0x0AAF5); + (0x0ABE3,0x0ABE4); + (0x0ABE6,0x0ABE7); + (0x0ABE9,0x0ABEA); + (0x0ABEC,0x0ABEC); + (0x11000,0x11000); + (0x11002,0x11002); + (0x11082,0x11082); + (0x110B0,0x110B2); + (0x110B7,0x110B8); + (0x1112C,0x1112C); + (0x11182,0x11182); + (0x111B3,0x111B5); + (0x111BF,0x111C0); + (0x1122C,0x1122E); + (0x11232,0x11233); + (0x11235,0x11235); + (0x112E0,0x112E2); + (0x11302,0x11303); + (0x1133E,0x1133F); + (0x11341,0x11344); + (0x11347,0x11348); + (0x1134B,0x1134D); + (0x11357,0x11357); + (0x11362,0x11363); + (0x11435,0x11437); + (0x11440,0x11441); + (0x11445,0x11445); + (0x114B0,0x114B2); + (0x114B9,0x114B9); + (0x114BB,0x114BE); + (0x114C1,0x114C1); + (0x115AF,0x115B1); + (0x115B8,0x115BB); + (0x115BE,0x115BE); + (0x11630,0x11632); + (0x1163B,0x1163C); + (0x1163E,0x1163E); + (0x116AC,0x116AC); + (0x116AE,0x116AF); + (0x116B6,0x116B6); + (0x11720,0x11721); + (0x11726,0x11726); + (0x11C2F,0x11C2F); + (0x11C3E,0x11C3E); + (0x11CA9,0x11CA9); + (0x11CB1,0x11CB1); + (0x11CB4,0x11CB4); + (0x16F51,0x16F7E); + (0x1D165,0x1D166) +] +(* Mark, Enclosing *) +let me = [ + (0x00488,0x00489); + (0x01ABE,0x01ABE); + (0x020DD,0x020E0); + (0x020E2,0x020E4) +] +(* Number, Decimal Digit *) +let nd = [ + (0x00030,0x00039); + (0x00660,0x00669); + (0x006F0,0x006F9); + (0x007C0,0x007C9); + (0x00966,0x0096F); + (0x009E6,0x009EF); + (0x00A66,0x00A6F); + (0x00AE6,0x00AEF); + (0x00B66,0x00B6F); + (0x00BE6,0x00BEF); + (0x00C66,0x00C6F); + (0x00CE6,0x00CEF); + (0x00D66,0x00D6F); + (0x00DE6,0x00DEF); + (0x00E50,0x00E59); + (0x00ED0,0x00ED9); + (0x00F20,0x00F29); + (0x01040,0x01049); + (0x01090,0x01099); + (0x017E0,0x017E9); + (0x01810,0x01819); + (0x01946,0x0194F); + (0x019D0,0x019D9); + (0x01A80,0x01A89); + (0x01A90,0x01A99); + (0x01B50,0x01B59); + (0x01BB0,0x01BB9); + (0x01C40,0x01C49); + (0x01C50,0x01C59); + (0x0A620,0x0A629); + (0x0A8D0,0x0A8D9); + (0x0A900,0x0A909); + (0x0A9D0,0x0A9D9); + (0x0A9F0,0x0A9F9); + (0x0AA50,0x0AA59); + (0x0ABF0,0x0ABF9); + (0x0FF10,0x0FF19); + (0x104A0,0x104A9); + (0x11066,0x1106F); + (0x110F0,0x110F9); + (0x11136,0x1113F); + (0x111D0,0x111D9); + (0x112F0,0x112F9); + (0x11450,0x11459); + (0x114D0,0x114D9); + (0x11650,0x11659); + (0x116C0,0x116C9); + (0x11730,0x11739); + (0x118E0,0x118E9); + (0x11C50,0x11C59); + (0x16A60,0x16A69); + (0x16B50,0x16B59); + (0x1D7CE,0x1D7FF) +] +(* Number, Letter *) +let nl = [ + (0x016EE,0x016F0); + (0x02160,0x02182); + (0x02185,0x02188); + (0x03007,0x03007); + (0x03021,0x03029); + (0x03038,0x0303A); + (0x0A6E6,0x0A6EF); + (0x10140,0x10174); + (0x10341,0x10341); + (0x1034A,0x1034A); + (0x103D1,0x103D5) +] +(* Number, Other *) +let no = [ + (0x000B2,0x000B3); + (0x000B9,0x000B9); + (0x000BC,0x000BE); + (0x009F4,0x009F9); + (0x00B72,0x00B77); + (0x00BF0,0x00BF2); + (0x00C78,0x00C7E); + (0x00D58,0x00D5E); + (0x00D70,0x00D78); + (0x00F2A,0x00F33); + (0x01369,0x0137C); + (0x017F0,0x017F9); + (0x019DA,0x019DA); + (0x02070,0x02070); + (0x02074,0x02079); + (0x02080,0x02089); + (0x02150,0x0215F); + (0x02189,0x02189); + (0x02460,0x0249B); + (0x024EA,0x024FF); + (0x02776,0x02793); + (0x02CFD,0x02CFD); + (0x03192,0x03195); + (0x03220,0x03229); + (0x03248,0x0324F); + (0x03251,0x0325F); + (0x03280,0x03289); + (0x032B1,0x032BF); + (0x0A830,0x0A835); + (0x10107,0x10133); + (0x10175,0x10178); + (0x1018A,0x1018B); + (0x102E1,0x102FB); + (0x10320,0x10323); + (0x10858,0x1085F); + (0x10879,0x1087F); + (0x108A7,0x108AF); + (0x108FB,0x108FF); + (0x10916,0x1091B); + (0x109BC,0x109BD); + (0x109C0,0x109CF); + (0x109D2,0x109FF); + (0x10A40,0x10A47); + (0x10A7D,0x10A7E); + (0x10A9D,0x10A9F); + (0x10AEB,0x10AEF); + (0x10B58,0x10B5F); + (0x10B78,0x10B7F); + (0x10BA9,0x10BAF); + (0x10CFA,0x10CFF); + (0x10E60,0x10E7E); + (0x11052,0x11065); + (0x111E1,0x111F4); + (0x1173A,0x1173B); + (0x118EA,0x118F2); + (0x11C5A,0x11C6C); + (0x16B5B,0x16B61); + (0x1D360,0x1D371); + (0x1E8C7,0x1E8CF) +] +(* Separator, Space *) +let zs = [ + (0x00020,0x00020); + (0x000A0,0x000A0); + (0x01680,0x01680); + (0x02000,0x0200A); + (0x0202F,0x0202F); + (0x0205F,0x0205F) +] +(* Separator, Line *) +let zl = [ + +] +(* Separator, Paragraph *) +let zp = [ + +] +(* Other, Control *) +let cc = [ + (0x00000,0x0001F) +] +(* Other, Format *) +let cf = [ + (0x000AD,0x000AD); + (0x00600,0x00605); + (0x0061C,0x0061C); + (0x006DD,0x006DD); + (0x0070F,0x0070F); + (0x008E2,0x008E2); + (0x0180E,0x0180E); + (0x0200B,0x0200F); + (0x0202A,0x0202E); + (0x02060,0x02064); + (0x02066,0x0206F); + (0x0FEFF,0x0FEFF); + (0x0FFF9,0x0FFFB); + (0x110BD,0x110BD); + (0x1BCA0,0x1BCA3); + (0x1D173,0x1D17A); + (0xE0001,0xE0001) +] +(* Other, Surrogate *) +let cs = [ + +] +(* Other, Private Use *) +let co = [ + (0x0E000,0x0F8FF); + (0xF0000,0xFFFFD) +] +(* Other, Not Assigned *) +let cn = [ + (0x00378,0x00379); + (0x00380,0x00383); + (0x0038B,0x0038B); + (0x0038D,0x0038D); + (0x003A2,0x003A2); + (0x00530,0x00530); + (0x00557,0x00558); + (0x00560,0x00560); + (0x00588,0x00588); + (0x0058B,0x0058C); + (0x00590,0x00590); + (0x005C8,0x005CF); + (0x005EB,0x005EF); + (0x005F5,0x005FF); + (0x0061D,0x0061D); + (0x0070E,0x0070E); + (0x0074B,0x0074C); + (0x007B2,0x007BF); + (0x007FB,0x007FF); + (0x0082E,0x0082F); + (0x0083F,0x0083F); + (0x0085C,0x0085D); + (0x0085F,0x0089F); + (0x008B5,0x008B5); + (0x008BE,0x008D3); + (0x00984,0x00984); + (0x0098D,0x0098E); + (0x00991,0x00992); + (0x009A9,0x009A9); + (0x009B1,0x009B1); + (0x009B3,0x009B5); + (0x009BA,0x009BB); + (0x009C5,0x009C6); + (0x009C9,0x009CA); + (0x009CF,0x009D6); + (0x009D8,0x009DB); + (0x009DE,0x009DE); + (0x009E4,0x009E5); + (0x009FC,0x00A00); + (0x00A04,0x00A04); + (0x00A0B,0x00A0E); + (0x00A11,0x00A12); + (0x00A29,0x00A29); + (0x00A31,0x00A31); + (0x00A34,0x00A34); + (0x00A37,0x00A37); + (0x00A3A,0x00A3B); + (0x00A3D,0x00A3D); + (0x00A43,0x00A46); + (0x00A49,0x00A4A); + (0x00A4E,0x00A50); + (0x00A52,0x00A58); + (0x00A5D,0x00A5D); + (0x00A5F,0x00A65); + (0x00A76,0x00A80); + (0x00A84,0x00A84); + (0x00A8E,0x00A8E); + (0x00A92,0x00A92); + (0x00AA9,0x00AA9); + (0x00AB1,0x00AB1); + (0x00AB4,0x00AB4); + (0x00ABA,0x00ABB); + (0x00AC6,0x00AC6); + (0x00ACA,0x00ACA); + (0x00ACE,0x00ACF); + (0x00AD1,0x00ADF); + (0x00AE4,0x00AE5); + (0x00AF2,0x00AF8); + (0x00AFA,0x00B00); + (0x00B04,0x00B04); + (0x00B0D,0x00B0E); + (0x00B11,0x00B12); + (0x00B29,0x00B29); + (0x00B31,0x00B31); + (0x00B34,0x00B34); + (0x00B3A,0x00B3B); + (0x00B45,0x00B46); + (0x00B49,0x00B4A); + (0x00B4E,0x00B55); + (0x00B58,0x00B5B); + (0x00B5E,0x00B5E); + (0x00B64,0x00B65); + (0x00B78,0x00B81); + (0x00B84,0x00B84); + (0x00B8B,0x00B8D); + (0x00B91,0x00B91); + (0x00B96,0x00B98); + (0x00B9B,0x00B9B); + (0x00B9D,0x00B9D); + (0x00BA0,0x00BA2); + (0x00BA5,0x00BA7); + (0x00BAB,0x00BAD); + (0x00BBA,0x00BBD); + (0x00BC3,0x00BC5); + (0x00BC9,0x00BC9); + (0x00BCE,0x00BCF); + (0x00BD1,0x00BD6); + (0x00BD8,0x00BE5); + (0x00BFB,0x00BFF); + (0x00C04,0x00C04); + (0x00C0D,0x00C0D); + (0x00C11,0x00C11); + (0x00C29,0x00C29); + (0x00C3A,0x00C3C); + (0x00C45,0x00C45); + (0x00C49,0x00C49); + (0x00C4E,0x00C54); + (0x00C57,0x00C57); + (0x00C5B,0x00C5F); + (0x00C64,0x00C65); + (0x00C70,0x00C77); + (0x00C84,0x00C84); + (0x00C8D,0x00C8D); + (0x00C91,0x00C91); + (0x00CA9,0x00CA9); + (0x00CB4,0x00CB4); + (0x00CBA,0x00CBB); + (0x00CC5,0x00CC5); + (0x00CC9,0x00CC9); + (0x00CCE,0x00CD4); + (0x00CD7,0x00CDD); + (0x00CDF,0x00CDF); + (0x00CE4,0x00CE5); + (0x00CF0,0x00CF0); + (0x00CF3,0x00D00); + (0x00D04,0x00D04); + (0x00D0D,0x00D0D); + (0x00D11,0x00D11); + (0x00D3B,0x00D3C); + (0x00D45,0x00D45); + (0x00D49,0x00D49); + (0x00D50,0x00D53); + (0x00D64,0x00D65); + (0x00D80,0x00D81); + (0x00D84,0x00D84); + (0x00D97,0x00D99); + (0x00DB2,0x00DB2); + (0x00DBC,0x00DBC); + (0x00DBE,0x00DBF); + (0x00DC7,0x00DC9); + (0x00DCB,0x00DCE); + (0x00DD5,0x00DD5); + (0x00DD7,0x00DD7); + (0x00DE0,0x00DE5); + (0x00DF0,0x00DF1); + (0x00DF5,0x00E00); + (0x00E3B,0x00E3E); + (0x00E5C,0x00E80); + (0x00E83,0x00E83); + (0x00E85,0x00E86); + (0x00E89,0x00E89); + (0x00E8B,0x00E8C); + (0x00E8E,0x00E93); + (0x00E98,0x00E98); + (0x00EA0,0x00EA0); + (0x00EA4,0x00EA4); + (0x00EA6,0x00EA6); + (0x00EA8,0x00EA9); + (0x00EAC,0x00EAC); + (0x00EBA,0x00EBA); + (0x00EBE,0x00EBF); + (0x00EC5,0x00EC5); + (0x00EC7,0x00EC7); + (0x00ECE,0x00ECF); + (0x00EDA,0x00EDB); + (0x00EE0,0x00EFF); + (0x00F48,0x00F48); + (0x00F6D,0x00F70); + (0x00F98,0x00F98); + (0x00FBD,0x00FBD); + (0x00FCD,0x00FCD); + (0x00FDB,0x00FFF); + (0x010C6,0x010C6); + (0x010C8,0x010CC); + (0x010CE,0x010CF); + (0x01249,0x01249); + (0x0124E,0x0124F); + (0x01257,0x01257); + (0x01259,0x01259); + (0x0125E,0x0125F); + (0x01289,0x01289); + (0x0128E,0x0128F); + (0x012B1,0x012B1); + (0x012B6,0x012B7); + (0x012BF,0x012BF); + (0x012C1,0x012C1); + (0x012C6,0x012C7); + (0x012D7,0x012D7); + (0x01311,0x01311); + (0x01316,0x01317); + (0x0135B,0x0135C); + (0x0137D,0x0137F); + (0x0139A,0x0139F); + (0x013F6,0x013F7); + (0x013FE,0x013FF); + (0x0169D,0x0169F); + (0x016F9,0x016FF); + (0x0170D,0x0170D); + (0x01715,0x0171F); + (0x01737,0x0173F); + (0x01754,0x0175F); + (0x0176D,0x0176D); + (0x01771,0x01771); + (0x01774,0x0177F); + (0x017DE,0x017DF); + (0x017EA,0x017EF); + (0x017FA,0x017FF); + (0x0180F,0x0180F); + (0x0181A,0x0181F); + (0x01878,0x0187F); + (0x018AB,0x018AF); + (0x018F6,0x018FF); + (0x0191F,0x0191F); + (0x0192C,0x0192F); + (0x0193C,0x0193F); + (0x01941,0x01943); + (0x0196E,0x0196F); + (0x01975,0x0197F); + (0x019AC,0x019AF); + (0x019CA,0x019CF); + (0x019DB,0x019DD); + (0x01A1C,0x01A1D); + (0x01A5F,0x01A5F); + (0x01A7D,0x01A7E); + (0x01A8A,0x01A8F); + (0x01A9A,0x01A9F); + (0x01AAE,0x01AAF); + (0x01ABF,0x01AFF); + (0x01B4C,0x01B4F); + (0x01B7D,0x01B7F); + (0x01BF4,0x01BFB); + (0x01C38,0x01C3A); + (0x01C4A,0x01C4C); + (0x01C89,0x01CBF); + (0x01CC8,0x01CCF); + (0x01CF7,0x01CF7); + (0x01CFA,0x01CFF); + (0x01DF6,0x01DFA); + (0x01F16,0x01F17); + (0x01F1E,0x01F1F); + (0x01F46,0x01F47); + (0x01F4E,0x01F4F); + (0x01F58,0x01F58); + (0x01F5A,0x01F5A); + (0x01F5C,0x01F5C); + (0x01F5E,0x01F5E); + (0x01F7E,0x01F7F); + (0x01FB5,0x01FB5); + (0x01FC5,0x01FC5); + (0x01FD4,0x01FD5); + (0x01FDC,0x01FDC); + (0x01FF0,0x01FF1); + (0x01FF5,0x01FF5); + (0x01FFF,0x01FFF); + (0x02065,0x02065); + (0x02072,0x02073); + (0x0208F,0x0208F); + (0x0209D,0x0209F); + (0x020BF,0x020CF); + (0x020F1,0x020FF); + (0x0218C,0x0218F); + (0x023FF,0x023FF); + (0x02427,0x0243F); + (0x0244B,0x0245F); + (0x02B74,0x02B75); + (0x02B96,0x02B97); + (0x02BBA,0x02BBC); + (0x02BC9,0x02BC9); + (0x02BD2,0x02BEB); + (0x02BF0,0x02BFF); + (0x02C2F,0x02C2F); + (0x02C5F,0x02C5F); + (0x02CF4,0x02CF8); + (0x02D26,0x02D26); + (0x02D28,0x02D2C); + (0x02D2E,0x02D2F); + (0x02D68,0x02D6E); + (0x02D71,0x02D7E); + (0x02D97,0x02D9F); + (0x02DA7,0x02DA7); + (0x02DAF,0x02DAF); + (0x02DB7,0x02DB7); + (0x02DBF,0x02DBF); + (0x02DC7,0x02DC7); + (0x02DCF,0x02DCF); + (0x02DD7,0x02DD7); + (0x02DDF,0x02DDF); + (0x02E45,0x02E7F); + (0x02E9A,0x02E9A); + (0x02EF4,0x02EFF); + (0x02FD6,0x02FEF); + (0x02FFC,0x02FFF); + (0x03040,0x03040); + (0x03097,0x03098); + (0x03100,0x03104); + (0x0312E,0x03130); + (0x0318F,0x0318F); + (0x031BB,0x031BF); + (0x031E4,0x031EF); + (0x0321F,0x0321F); + (0x032FF,0x032FF); + (0x04DB6,0x04DBF); + (0x09FD6,0x09FFF); + (0x0A48D,0x0A48F); + (0x0A4C7,0x0A4CF); + (0x0A62C,0x0A63F); + (0x0A6F8,0x0A6FF); + (0x0A7AF,0x0A7AF); + (0x0A7B8,0x0A7F6); + (0x0A82C,0x0A82F); + (0x0A83A,0x0A83F); + (0x0A878,0x0A87F); + (0x0A8C6,0x0A8CD); + (0x0A8DA,0x0A8DF); + (0x0A8FE,0x0A8FF); + (0x0A954,0x0A95E); + (0x0A97D,0x0A97F); + (0x0A9CE,0x0A9CE); + (0x0A9DA,0x0A9DD); + (0x0A9FF,0x0A9FF); + (0x0AA37,0x0AA3F); + (0x0AA4E,0x0AA4F); + (0x0AA5A,0x0AA5B); + (0x0AAC3,0x0AADA); + (0x0AAF7,0x0AB00); + (0x0AB07,0x0AB08); + (0x0AB0F,0x0AB10); + (0x0AB17,0x0AB1F); + (0x0AB27,0x0AB27); + (0x0AB2F,0x0AB2F); + (0x0AB66,0x0AB6F); + (0x0ABEE,0x0ABEF); + (0x0ABFA,0x0ABFF); + (0x0D7A4,0x0D7AF); + (0x0D7C7,0x0D7CA); + (0x0D7FC,0x0D7FF); + (0x0FA6E,0x0FA6F); + (0x0FADA,0x0FAFF); + (0x0FB07,0x0FB12); + (0x0FB18,0x0FB1C); + (0x0FB37,0x0FB37); + (0x0FB3D,0x0FB3D); + (0x0FB3F,0x0FB3F); + (0x0FB42,0x0FB42); + (0x0FB45,0x0FB45); + (0x0FBC2,0x0FBD2); + (0x0FD40,0x0FD4F); + (0x0FD90,0x0FD91); + (0x0FDC8,0x0FDEF); + (0x0FDFE,0x0FDFF); + (0x0FE1A,0x0FE1F); + (0x0FE53,0x0FE53); + (0x0FE67,0x0FE67); + (0x0FE6C,0x0FE6F); + (0x0FE75,0x0FE75); + (0x0FEFD,0x0FEFE); + (0x0FF00,0x0FF00); + (0x0FFBF,0x0FFC1); + (0x0FFC8,0x0FFC9); + (0x0FFD0,0x0FFD1); + (0x0FFD8,0x0FFD9); + (0x0FFDD,0x0FFDF); + (0x0FFE7,0x0FFE7); + (0x0FFEF,0x0FFF8); + (0x0FFFE,0x0FFFF); + (0x1000C,0x1000C); + (0x10027,0x10027); + (0x1003B,0x1003B); + (0x1003E,0x1003E); + (0x1004E,0x1004F); + (0x1005E,0x1007F); + (0x100FB,0x100FF); + (0x10103,0x10106); + (0x10134,0x10136); + (0x1018F,0x1018F); + (0x1019C,0x1019F); + (0x101A1,0x101CF); + (0x101FE,0x1027F); + (0x1029D,0x1029F); + (0x102D1,0x102DF); + (0x102FC,0x102FF); + (0x10324,0x1032F); + (0x1034B,0x1034F); + (0x1037B,0x1037F); + (0x1039E,0x1039E); + (0x103C4,0x103C7); + (0x103D6,0x103FF); + (0x1049E,0x1049F); + (0x104AA,0x104AF); + (0x104D4,0x104D7); + (0x104FC,0x104FF); + (0x10528,0x1052F); + (0x10564,0x1056E); + (0x10570,0x105FF); + (0x10737,0x1073F); + (0x10756,0x1075F); + (0x10768,0x107FF); + (0x10806,0x10807); + (0x10809,0x10809); + (0x10836,0x10836); + (0x10839,0x1083B); + (0x1083D,0x1083E); + (0x10856,0x10856); + (0x1089F,0x108A6); + (0x108B0,0x108DF); + (0x108F3,0x108F3); + (0x108F6,0x108FA); + (0x1091C,0x1091E); + (0x1093A,0x1093E); + (0x10940,0x1097F); + (0x109B8,0x109BB); + (0x109D0,0x109D1); + (0x10A04,0x10A04); + (0x10A07,0x10A0B); + (0x10A14,0x10A14); + (0x10A18,0x10A18); + (0x10A34,0x10A37); + (0x10A3B,0x10A3E); + (0x10A48,0x10A4F); + (0x10A59,0x10A5F); + (0x10AA0,0x10ABF); + (0x10AE7,0x10AEA); + (0x10AF7,0x10AFF); + (0x10B36,0x10B38); + (0x10B56,0x10B57); + (0x10B73,0x10B77); + (0x10B92,0x10B98); + (0x10B9D,0x10BA8); + (0x10BB0,0x10BFF); + (0x10C49,0x10C7F); + (0x10CB3,0x10CBF); + (0x10CF3,0x10CF9); + (0x10D00,0x10E5F); + (0x10E7F,0x10FFF); + (0x1104E,0x11051); + (0x11070,0x1107E); + (0x110C2,0x110CF); + (0x110E9,0x110EF); + (0x110FA,0x110FF); + (0x11135,0x11135); + (0x11144,0x1114F); + (0x11177,0x1117F); + (0x111CE,0x111CF); + (0x111E0,0x111E0); + (0x111F5,0x111FF); + (0x11212,0x11212); + (0x1123F,0x1127F); + (0x11287,0x11287); + (0x11289,0x11289); + (0x1128E,0x1128E); + (0x1129E,0x1129E); + (0x112AA,0x112AF); + (0x112EB,0x112EF); + (0x112FA,0x112FF); + (0x11304,0x11304); + (0x1130D,0x1130E); + (0x11311,0x11312); + (0x11329,0x11329); + (0x11331,0x11331); + (0x11334,0x11334); + (0x1133A,0x1133B); + (0x11345,0x11346); + (0x11349,0x1134A); + (0x1134E,0x1134F); + (0x11351,0x11356); + (0x11358,0x1135C); + (0x11364,0x11365); + (0x1136D,0x1136F); + (0x11375,0x113FF); + (0x1145A,0x1145A); + (0x1145C,0x1145C); + (0x1145E,0x1147F); + (0x114C8,0x114CF); + (0x114DA,0x1157F); + (0x115B6,0x115B7); + (0x115DE,0x115FF); + (0x11645,0x1164F); + (0x1165A,0x1165F); + (0x1166D,0x1167F); + (0x116B8,0x116BF); + (0x116CA,0x116FF); + (0x1171A,0x1171C); + (0x1172C,0x1172F); + (0x11740,0x1189F); + (0x118F3,0x118FE); + (0x11900,0x11ABF); + (0x11AF9,0x11BFF); + (0x11C09,0x11C09); + (0x11C37,0x11C37); + (0x11C46,0x11C4F); + (0x11C6D,0x11C6F); + (0x11C90,0x11C91); + (0x11CA8,0x11CA8); + (0x11CB7,0x11FFF); + (0x1239A,0x123FF); + (0x1246F,0x1246F); + (0x12475,0x1247F); + (0x12544,0x12FFF); + (0x1342F,0x143FF); + (0x14647,0x167FF); + (0x16A39,0x16A3F); + (0x16A5F,0x16A5F); + (0x16A6A,0x16A6D); + (0x16A70,0x16ACF); + (0x16AEE,0x16AEF); + (0x16AF6,0x16AFF); + (0x16B46,0x16B4F); + (0x16B5A,0x16B5A); + (0x16B62,0x16B62); + (0x16B78,0x16B7C); + (0x16B90,0x16EFF); + (0x16F45,0x16F4F); + (0x16F7F,0x16F8E); + (0x16FA0,0x16FDF); + (0x16FE1,0x16FFF); + (0x187ED,0x187FF); + (0x18AF3,0x1AFFF); + (0x1B002,0x1BBFF); + (0x1BC6B,0x1BC6F); + (0x1BC7D,0x1BC7F); + (0x1BC89,0x1BC8F); + (0x1BC9A,0x1BC9B); + (0x1BCA4,0x1CFFF); + (0x1D0F6,0x1D0FF); + (0x1D127,0x1D128); + (0x1D1E9,0x1D1FF); + (0x1D246,0x1D2FF); + (0x1D357,0x1D35F); + (0x1D372,0x1D3FF); + (0x1D455,0x1D455); + (0x1D49D,0x1D49D); + (0x1D4A0,0x1D4A1); + (0x1D4A3,0x1D4A4); + (0x1D4A7,0x1D4A8); + (0x1D4AD,0x1D4AD); + (0x1D4BA,0x1D4BA); + (0x1D4BC,0x1D4BC); + (0x1D4C4,0x1D4C4); + (0x1D506,0x1D506); + (0x1D50B,0x1D50C); + (0x1D515,0x1D515); + (0x1D51D,0x1D51D); + (0x1D53A,0x1D53A); + (0x1D53F,0x1D53F); + (0x1D545,0x1D545); + (0x1D547,0x1D549); + (0x1D551,0x1D551); + (0x1D6A6,0x1D6A7); + (0x1D7CC,0x1D7CD); + (0x1DA8C,0x1DA9A); + (0x1DAA0,0x1DAA0); + (0x1DAB0,0x1DFFF); + (0x1E007,0x1E007); + (0x1E019,0x1E01A); + (0x1E022,0x1E022); + (0x1E025,0x1E025); + (0x1E02B,0x1E7FF); + (0x1E8C5,0x1E8C6); + (0x1E8D7,0x1E8FF); + (0x1E94B,0x1E94F); + (0x1E95A,0x1E95D); + (0x1E960,0x1EDFF); + (0x1EE04,0x1EE04); + (0x1EE20,0x1EE20); + (0x1EE23,0x1EE23); + (0x1EE25,0x1EE26); + (0x1EE28,0x1EE28); + (0x1EE33,0x1EE33); + (0x1EE38,0x1EE38); + (0x1EE3A,0x1EE3A); + (0x1EE3C,0x1EE41); + (0x1EE43,0x1EE46); + (0x1EE48,0x1EE48); + (0x1EE4A,0x1EE4A); + (0x1EE4C,0x1EE4C); + (0x1EE50,0x1EE50); + (0x1EE53,0x1EE53); + (0x1EE55,0x1EE56); + (0x1EE58,0x1EE58); + (0x1EE5A,0x1EE5A); + (0x1EE5C,0x1EE5C); + (0x1EE5E,0x1EE5E); + (0x1EE60,0x1EE60); + (0x1EE63,0x1EE63); + (0x1EE65,0x1EE66); + (0x1EE6B,0x1EE6B); + (0x1EE73,0x1EE73); + (0x1EE78,0x1EE78); + (0x1EE7D,0x1EE7D); + (0x1EE7F,0x1EE7F); + (0x1EE8A,0x1EE8A); + (0x1EE9C,0x1EEA0); + (0x1EEA4,0x1EEA4); + (0x1EEAA,0x1EEAA); + (0x1EEBC,0x1EEEF); + (0x1EEF2,0x1EFFF); + (0x1F02C,0x1F02F); + (0x1F094,0x1F09F); + (0x1F0AF,0x1F0B0); + (0x1F0C0,0x1F0C0); + (0x1F0D0,0x1F0D0); + (0x1F0F6,0x1F0FF); + (0x1F10D,0x1F10F); + (0x1F12F,0x1F12F); + (0x1F16C,0x1F16F); + (0x1F1AD,0x1F1E5); + (0x1F203,0x1F20F); + (0x1F23C,0x1F23F); + (0x1F249,0x1F24F); + (0x1F252,0x1F2FF); + (0x1F6D3,0x1F6DF); + (0x1F6ED,0x1F6EF); + (0x1F6F7,0x1F6FF); + (0x1F774,0x1F77F); + (0x1F7D5,0x1F7FF); + (0x1F80C,0x1F80F); + (0x1F848,0x1F84F); + (0x1F85A,0x1F85F); + (0x1F888,0x1F88F); + (0x1F8AE,0x1F90F); + (0x1F91F,0x1F91F); + (0x1F928,0x1F92F); + (0x1F931,0x1F932); + (0x1F93F,0x1F93F); + (0x1F94C,0x1F94F); + (0x1F95F,0x1F97F); + (0x1F992,0x1F9BF); + (0x1F9C1,0x1FFFF); + (0x2A6D7,0x2A6FF); + (0x2B735,0x2B73F); + (0x2B81E,0x2B81F); + (0x2CEA2,0x2F7FF); + (0x2FA1E,0xE0000); + (0xE0002,0xE001F); + (0xE0080,0xE00FF); + (0xE01F0,0xEFFFF); + (0xFFFFE,0xFFFFF) +] +(* Letter, Modifier *) +let lm = [ + (0x002B0,0x002C1); + (0x002C6,0x002D1); + (0x002E0,0x002E4); + (0x002EC,0x002EC); + (0x002EE,0x002EE); + (0x00374,0x00374); + (0x0037A,0x0037A); + (0x00559,0x00559); + (0x00640,0x00640); + (0x006E5,0x006E6); + (0x007F4,0x007F5); + (0x007FA,0x007FA); + (0x0081A,0x0081A); + (0x00824,0x00824); + (0x00828,0x00828); + (0x00971,0x00971); + (0x00E46,0x00E46); + (0x00EC6,0x00EC6); + (0x010FC,0x010FC); + (0x017D7,0x017D7); + (0x01843,0x01843); + (0x01AA7,0x01AA7); + (0x01C78,0x01C7D); + (0x01D2C,0x01D6A); + (0x01D78,0x01D78); + (0x01D9B,0x01DBF); + (0x02071,0x02071); + (0x0207F,0x0207F); + (0x02090,0x0209C); + (0x02C7C,0x02C7D); + (0x02D6F,0x02D6F); + (0x02E2F,0x02E2F); + (0x03005,0x03005); + (0x03031,0x03035); + (0x0303B,0x0303B); + (0x0309D,0x0309E); + (0x030FC,0x030FE); + (0x0A015,0x0A015); + (0x0A4F8,0x0A4FD); + (0x0A60C,0x0A60C); + (0x0A67F,0x0A67F); + (0x0A69C,0x0A69D); + (0x0A717,0x0A71F); + (0x0A770,0x0A770); + (0x0A788,0x0A788); + (0x0A7F8,0x0A7F9); + (0x0A9CF,0x0A9CF); + (0x0A9E6,0x0A9E6); + (0x0AA70,0x0AA70); + (0x0AADD,0x0AADD); + (0x0AAF3,0x0AAF4); + (0x0AB5C,0x0AB5F); + (0x0FF70,0x0FF70); + (0x0FF9E,0x0FF9F); + (0x16B40,0x16B43); + (0x16F93,0x16F9F) +] +(* Letter, Other *) +let lo = [ + (0x000AA,0x000AA); + (0x000BA,0x000BA); + (0x001BB,0x001BB); + (0x001C0,0x001C3); + (0x00294,0x00294); + (0x005D0,0x005EA); + (0x005F0,0x005F2); + (0x00620,0x0063F); + (0x00641,0x0064A); + (0x0066E,0x0066F); + (0x00671,0x006D3); + (0x006D5,0x006D5); + (0x006EE,0x006EF); + (0x006FA,0x006FC); + (0x006FF,0x006FF); + (0x00710,0x00710); + (0x00712,0x0072F); + (0x0074D,0x007A5); + (0x007B1,0x007B1); + (0x007CA,0x007EA); + (0x00800,0x00815); + (0x00840,0x00858); + (0x008A0,0x008B4); + (0x008B6,0x008BD); + (0x00904,0x00939); + (0x0093D,0x0093D); + (0x00950,0x00950); + (0x00958,0x00961); + (0x00972,0x00980); + (0x00985,0x0098C); + (0x0098F,0x00990); + (0x00993,0x009A8); + (0x009AA,0x009B0); + (0x009B2,0x009B2); + (0x009B6,0x009B9); + (0x009BD,0x009BD); + (0x009CE,0x009CE); + (0x009DC,0x009DD); + (0x009DF,0x009E1); + (0x009F0,0x009F1); + (0x00A05,0x00A0A); + (0x00A0F,0x00A10); + (0x00A13,0x00A28); + (0x00A2A,0x00A30); + (0x00A32,0x00A33); + (0x00A35,0x00A36); + (0x00A38,0x00A39); + (0x00A59,0x00A5C); + (0x00A5E,0x00A5E); + (0x00A72,0x00A74); + (0x00A85,0x00A8D); + (0x00A8F,0x00A91); + (0x00A93,0x00AA8); + (0x00AAA,0x00AB0); + (0x00AB2,0x00AB3); + (0x00AB5,0x00AB9); + (0x00ABD,0x00ABD); + (0x00AD0,0x00AD0); + (0x00AE0,0x00AE1); + (0x00AF9,0x00AF9); + (0x00B05,0x00B0C); + (0x00B0F,0x00B10); + (0x00B13,0x00B28); + (0x00B2A,0x00B30); + (0x00B32,0x00B33); + (0x00B35,0x00B39); + (0x00B3D,0x00B3D); + (0x00B5C,0x00B5D); + (0x00B5F,0x00B61); + (0x00B71,0x00B71); + (0x00B83,0x00B83); + (0x00B85,0x00B8A); + (0x00B8E,0x00B90); + (0x00B92,0x00B95); + (0x00B99,0x00B9A); + (0x00B9C,0x00B9C); + (0x00B9E,0x00B9F); + (0x00BA3,0x00BA4); + (0x00BA8,0x00BAA); + (0x00BAE,0x00BB9); + (0x00BD0,0x00BD0); + (0x00C05,0x00C0C); + (0x00C0E,0x00C10); + (0x00C12,0x00C28); + (0x00C2A,0x00C39); + (0x00C3D,0x00C3D); + (0x00C58,0x00C5A); + (0x00C60,0x00C61); + (0x00C80,0x00C80); + (0x00C85,0x00C8C); + (0x00C8E,0x00C90); + (0x00C92,0x00CA8); + (0x00CAA,0x00CB3); + (0x00CB5,0x00CB9); + (0x00CBD,0x00CBD); + (0x00CDE,0x00CDE); + (0x00CE0,0x00CE1); + (0x00CF1,0x00CF2); + (0x00D05,0x00D0C); + (0x00D0E,0x00D10); + (0x00D12,0x00D3A); + (0x00D3D,0x00D3D); + (0x00D4E,0x00D4E); + (0x00D54,0x00D56); + (0x00D5F,0x00D61); + (0x00D7A,0x00D7F); + (0x00D85,0x00D96); + (0x00D9A,0x00DB1); + (0x00DB3,0x00DBB); + (0x00DBD,0x00DBD); + (0x00DC0,0x00DC6); + (0x00E01,0x00E30); + (0x00E32,0x00E33); + (0x00E40,0x00E45); + (0x00E81,0x00E82); + (0x00E84,0x00E84); + (0x00E87,0x00E88); + (0x00E8A,0x00E8A); + (0x00E8D,0x00E8D); + (0x00E94,0x00E97); + (0x00E99,0x00E9F); + (0x00EA1,0x00EA3); + (0x00EA5,0x00EA5); + (0x00EA7,0x00EA7); + (0x00EAA,0x00EAB); + (0x00EAD,0x00EB0); + (0x00EB2,0x00EB3); + (0x00EBD,0x00EBD); + (0x00EC0,0x00EC4); + (0x00EDC,0x00EDF); + (0x00F00,0x00F00); + (0x00F40,0x00F47); + (0x00F49,0x00F6C); + (0x00F88,0x00F8C); + (0x01000,0x0102A); + (0x0103F,0x0103F); + (0x01050,0x01055); + (0x0105A,0x0105D); + (0x01061,0x01061); + (0x01065,0x01066); + (0x0106E,0x01070); + (0x01075,0x01081); + (0x0108E,0x0108E); + (0x010D0,0x010FA); + (0x010FD,0x01248); + (0x0124A,0x0124D); + (0x01250,0x01256); + (0x01258,0x01258); + (0x0125A,0x0125D); + (0x01260,0x01288); + (0x0128A,0x0128D); + (0x01290,0x012B0); + (0x012B2,0x012B5); + (0x012B8,0x012BE); + (0x012C0,0x012C0); + (0x012C2,0x012C5); + (0x012C8,0x012D6); + (0x012D8,0x01310); + (0x01312,0x01315); + (0x01318,0x0135A); + (0x01380,0x0138F); + (0x01401,0x0166C); + (0x0166F,0x0167F); + (0x01681,0x0169A); + (0x016A0,0x016EA); + (0x016F1,0x016F8); + (0x01700,0x0170C); + (0x0170E,0x01711); + (0x01720,0x01731); + (0x01740,0x01751); + (0x01760,0x0176C); + (0x0176E,0x01770); + (0x01780,0x017B3); + (0x017DC,0x017DC); + (0x01820,0x01842); + (0x01844,0x01877); + (0x01880,0x01884); + (0x01887,0x018A8); + (0x018AA,0x018AA); + (0x018B0,0x018F5); + (0x01900,0x0191E); + (0x01950,0x0196D); + (0x01970,0x01974); + (0x01980,0x019AB); + (0x019B0,0x019C9); + (0x01A00,0x01A16); + (0x01A20,0x01A54); + (0x01B05,0x01B33); + (0x01B45,0x01B4B); + (0x01B83,0x01BA0); + (0x01BAE,0x01BAF); + (0x01BBA,0x01BE5); + (0x01C00,0x01C23); + (0x01C4D,0x01C4F); + (0x01C5A,0x01C77); + (0x01CE9,0x01CEC); + (0x01CEE,0x01CF1); + (0x01CF5,0x01CF6); + (0x02135,0x02138); + (0x02D30,0x02D67); + (0x02D80,0x02D96); + (0x02DA0,0x02DA6); + (0x02DA8,0x02DAE); + (0x02DB0,0x02DB6); + (0x02DB8,0x02DBE); + (0x02DC0,0x02DC6); + (0x02DC8,0x02DCE); + (0x02DD0,0x02DD6); + (0x02DD8,0x02DDE); + (0x03006,0x03006); + (0x0303C,0x0303C); + (0x03041,0x03096); + (0x0309F,0x0309F); + (0x030A1,0x030FA); + (0x030FF,0x030FF); + (0x03105,0x0312D); + (0x03131,0x0318E); + (0x031A0,0x031BA); + (0x031F0,0x031FF); + (0x03400,0x04DB5); + (0x04E00,0x09FD5); + (0x0A000,0x0A014); + (0x0A016,0x0A48C); + (0x0A4D0,0x0A4F7); + (0x0A500,0x0A60B); + (0x0A610,0x0A61F); + (0x0A62A,0x0A62B); + (0x0A66E,0x0A66E); + (0x0A6A0,0x0A6E5); + (0x0A78F,0x0A78F); + (0x0A7F7,0x0A7F7); + (0x0A7FB,0x0A801); + (0x0A803,0x0A805); + (0x0A807,0x0A80A); + (0x0A80C,0x0A822); + (0x0A840,0x0A873); + (0x0A882,0x0A8B3); + (0x0A8F2,0x0A8F7); + (0x0A8FB,0x0A8FB); + (0x0A8FD,0x0A8FD); + (0x0A90A,0x0A925); + (0x0A930,0x0A946); + (0x0A960,0x0A97C); + (0x0A984,0x0A9B2); + (0x0A9E0,0x0A9E4); + (0x0A9E7,0x0A9EF); + (0x0A9FA,0x0A9FE); + (0x0AA00,0x0AA28); + (0x0AA40,0x0AA42); + (0x0AA44,0x0AA4B); + (0x0AA60,0x0AA6F); + (0x0AA71,0x0AA76); + (0x0AA7A,0x0AA7A); + (0x0AA7E,0x0AAAF); + (0x0AAB1,0x0AAB1); + (0x0AAB5,0x0AAB6); + (0x0AAB9,0x0AABD); + (0x0AAC0,0x0AAC0); + (0x0AAC2,0x0AAC2); + (0x0AADB,0x0AADC); + (0x0AAE0,0x0AAEA); + (0x0AAF2,0x0AAF2); + (0x0AB01,0x0AB06); + (0x0AB09,0x0AB0E); + (0x0AB11,0x0AB16); + (0x0AB20,0x0AB26); + (0x0AB28,0x0AB2E); + (0x0ABC0,0x0ABE2); + (0x0AC00,0x0D7A3); + (0x0D7B0,0x0D7C6); + (0x0D7CB,0x0D7FB); + (0x0F900,0x0FA6D); + (0x0FA70,0x0FAD9); + (0x0FB1D,0x0FB1D); + (0x0FB1F,0x0FB28); + (0x0FB2A,0x0FB36); + (0x0FB38,0x0FB3C); + (0x0FB3E,0x0FB3E); + (0x0FB40,0x0FB41); + (0x0FB43,0x0FB44); + (0x0FB46,0x0FBB1); + (0x0FBD3,0x0FD3D); + (0x0FD50,0x0FD8F); + (0x0FD92,0x0FDC7); + (0x0FDF0,0x0FDFB); + (0x0FE70,0x0FE74); + (0x0FE76,0x0FEFC); + (0x0FF66,0x0FF6F); + (0x0FF71,0x0FF9D); + (0x0FFA0,0x0FFBE); + (0x0FFC2,0x0FFC7); + (0x0FFCA,0x0FFCF); + (0x0FFD2,0x0FFD7); + (0x0FFDA,0x0FFDC); + (0x10000,0x1000B); + (0x1000D,0x10026); + (0x10028,0x1003A); + (0x1003C,0x1003D); + (0x1003F,0x1004D); + (0x10050,0x1005D); + (0x10080,0x100FA); + (0x10280,0x1029C); + (0x102A0,0x102D0); + (0x10300,0x1031F); + (0x10330,0x10340); + (0x10342,0x10349); + (0x10350,0x10375); + (0x10380,0x1039D); + (0x103A0,0x103C3); + (0x103C8,0x103CF); + (0x10450,0x1049D); + (0x10500,0x10527); + (0x10530,0x10563); + (0x10600,0x10736); + (0x10740,0x10755); + (0x10760,0x10767); + (0x10800,0x10805); + (0x10808,0x10808); + (0x1080A,0x10835); + (0x10837,0x10838); + (0x1083C,0x1083C); + (0x1083F,0x10855); + (0x10860,0x10876); + (0x10880,0x1089E); + (0x108E0,0x108F2); + (0x108F4,0x108F5); + (0x10900,0x10915); + (0x10920,0x10939); + (0x10980,0x109B7); + (0x109BE,0x109BF); + (0x10A00,0x10A00); + (0x10A10,0x10A13); + (0x10A15,0x10A17); + (0x10A19,0x10A33); + (0x10A60,0x10A7C); + (0x10A80,0x10A9C); + (0x10AC0,0x10AC7); + (0x10AC9,0x10AE4); + (0x10B00,0x10B35); + (0x10B40,0x10B55); + (0x10B60,0x10B72); + (0x10B80,0x10B91); + (0x10C00,0x10C48); + (0x11003,0x11037); + (0x11083,0x110AF); + (0x110D0,0x110E8); + (0x11103,0x11126); + (0x11150,0x11172); + (0x11176,0x11176); + (0x11183,0x111B2); + (0x111C1,0x111C4); + (0x111DA,0x111DA); + (0x111DC,0x111DC); + (0x11200,0x11211); + (0x11213,0x1122B); + (0x11280,0x11286); + (0x11288,0x11288); + (0x1128A,0x1128D); + (0x1128F,0x1129D); + (0x1129F,0x112A8); + (0x112B0,0x112DE); + (0x11305,0x1130C); + (0x1130F,0x11310); + (0x11313,0x11328); + (0x1132A,0x11330); + (0x11332,0x11333); + (0x11335,0x11339); + (0x1133D,0x1133D); + (0x11350,0x11350); + (0x1135D,0x11361); + (0x11400,0x11434); + (0x11447,0x1144A); + (0x11480,0x114AF); + (0x114C4,0x114C5); + (0x114C7,0x114C7); + (0x11580,0x115AE); + (0x115D8,0x115DB); + (0x11600,0x1162F); + (0x11644,0x11644); + (0x11680,0x116AA); + (0x11700,0x11719); + (0x118FF,0x118FF); + (0x11AC0,0x11AF8); + (0x11C00,0x11C08); + (0x11C0A,0x11C2E); + (0x11C40,0x11C40); + (0x11C72,0x11C8F); + (0x12000,0x12399); + (0x12480,0x12543); + (0x13000,0x1342E); + (0x14400,0x14646); + (0x16800,0x16A38); + (0x16A40,0x16A5E); + (0x16AD0,0x16AED); + (0x16B00,0x16B2F); + (0x16B63,0x16B77); + (0x16B7D,0x16B8F); + (0x16F00,0x16F44); + (0x16F50,0x16F50); + (0x17000,0x187EC); + (0x18800,0x18AF2); + (0x1B000,0x1B001); + (0x1BC00,0x1BC6A); + (0x1BC70,0x1BC7C); + (0x1BC80,0x1BC88); + (0x1BC90,0x1BC99); + (0x1E800,0x1E8C4); + (0x1EE00,0x1EE03); + (0x1EE05,0x1EE1F); + (0x1EE21,0x1EE22); + (0x1EE24,0x1EE24); + (0x1EE27,0x1EE27); + (0x1EE29,0x1EE32); + (0x1EE34,0x1EE37); + (0x1EE39,0x1EE39); + (0x1EE3B,0x1EE3B); + (0x1EE42,0x1EE42); + (0x1EE47,0x1EE47); + (0x1EE49,0x1EE49); + (0x1EE4B,0x1EE4B); + (0x1EE4D,0x1EE4F); + (0x1EE51,0x1EE52); + (0x1EE54,0x1EE54); + (0x1EE57,0x1EE57); + (0x1EE59,0x1EE59); + (0x1EE5B,0x1EE5B); + (0x1EE5D,0x1EE5D); + (0x1EE5F,0x1EE5F); + (0x1EE61,0x1EE62); + (0x1EE64,0x1EE64); + (0x1EE67,0x1EE6A); + (0x1EE6C,0x1EE72); + (0x1EE74,0x1EE77); + (0x1EE79,0x1EE7C); + (0x1EE7E,0x1EE7E); + (0x1EE80,0x1EE89); + (0x1EE8B,0x1EE9B); + (0x1EEA1,0x1EEA3); + (0x1EEA5,0x1EEA9); + (0x1EEAB,0x1EEBB); + (0x20000,0x2A6D6); + (0x2A700,0x2B734); + (0x2B740,0x2B81D); + (0x2B820,0x2CEA1) +] +(* Punctuation, Connector *) +let pc = [ + (0x0005F,0x0005F); + (0x0203F,0x02040); + (0x02054,0x02054); + (0x0FE33,0x0FE34); + (0x0FE4D,0x0FE4F) +] +(* Punctuation, Dash *) +let pd = [ + (0x0002D,0x0002D); + (0x0058A,0x0058A); + (0x005BE,0x005BE); + (0x01400,0x01400); + (0x01806,0x01806); + (0x02010,0x02015); + (0x02E17,0x02E17); + (0x02E1A,0x02E1A); + (0x02E3A,0x02E3B); + (0x02E40,0x02E40); + (0x0301C,0x0301C); + (0x03030,0x03030); + (0x030A0,0x030A0); + (0x0FE31,0x0FE32); + (0x0FE58,0x0FE58); + (0x0FE63,0x0FE63) +] +(* Punctuation, Open *) +let ps = [ + (0x00028,0x00028); + (0x0005B,0x0005B); + (0x0007B,0x0007B); + (0x00F3A,0x00F3A); + (0x00F3C,0x00F3C); + (0x0169B,0x0169B); + (0x0201A,0x0201A); + (0x0201E,0x0201E); + (0x02045,0x02045); + (0x0207D,0x0207D); + (0x0208D,0x0208D); + (0x02308,0x02308); + (0x0230A,0x0230A); + (0x02329,0x02329); + (0x02768,0x02768); + (0x0276A,0x0276A); + (0x0276C,0x0276C); + (0x0276E,0x0276E); + (0x02770,0x02770); + (0x02772,0x02772); + (0x02774,0x02774); + (0x027C5,0x027C5); + (0x027E6,0x027E6); + (0x027E8,0x027E8); + (0x027EA,0x027EA); + (0x027EC,0x027EC); + (0x027EE,0x027EE); + (0x02983,0x02983); + (0x02985,0x02985); + (0x02987,0x02987); + (0x02989,0x02989); + (0x0298B,0x0298B); + (0x0298D,0x0298D); + (0x0298F,0x0298F); + (0x02991,0x02991); + (0x02993,0x02993); + (0x02995,0x02995); + (0x02997,0x02997); + (0x029D8,0x029D8); + (0x029DA,0x029DA); + (0x029FC,0x029FC); + (0x02E22,0x02E22); + (0x02E24,0x02E24); + (0x02E26,0x02E26); + (0x02E28,0x02E28); + (0x02E42,0x02E42); + (0x03008,0x03008); + (0x0300A,0x0300A); + (0x0300C,0x0300C); + (0x0300E,0x0300E); + (0x03010,0x03010); + (0x03014,0x03014); + (0x03016,0x03016); + (0x03018,0x03018); + (0x0301A,0x0301A); + (0x0301D,0x0301D); + (0x0FD3F,0x0FD3F); + (0x0FE17,0x0FE17); + (0x0FE35,0x0FE35); + (0x0FE37,0x0FE37); + (0x0FE39,0x0FE39); + (0x0FE3B,0x0FE3B); + (0x0FE3D,0x0FE3D); + (0x0FE3F,0x0FE3F); + (0x0FE41,0x0FE41); + (0x0FE43,0x0FE43); + (0x0FE47,0x0FE47); + (0x0FE59,0x0FE59); + (0x0FE5B,0x0FE5B); + (0x0FE5D,0x0FE5D); + (0x0FF08,0x0FF08); + (0x0FF3B,0x0FF3B); + (0x0FF5B,0x0FF5B); + (0x0FF5F,0x0FF5F) +] +(* Punctuation, Close *) +let pe = [ + (0x00029,0x00029); + (0x0005D,0x0005D); + (0x0007D,0x0007D); + (0x00F3B,0x00F3B); + (0x00F3D,0x00F3D); + (0x0169C,0x0169C); + (0x02046,0x02046); + (0x0207E,0x0207E); + (0x0208E,0x0208E); + (0x02309,0x02309); + (0x0230B,0x0230B); + (0x0232A,0x0232A); + (0x02769,0x02769); + (0x0276B,0x0276B); + (0x0276D,0x0276D); + (0x0276F,0x0276F); + (0x02771,0x02771); + (0x02773,0x02773); + (0x02775,0x02775); + (0x027C6,0x027C6); + (0x027E7,0x027E7); + (0x027E9,0x027E9); + (0x027EB,0x027EB); + (0x027ED,0x027ED); + (0x027EF,0x027EF); + (0x02984,0x02984); + (0x02986,0x02986); + (0x02988,0x02988); + (0x0298A,0x0298A); + (0x0298C,0x0298C); + (0x0298E,0x0298E); + (0x02990,0x02990); + (0x02992,0x02992); + (0x02994,0x02994); + (0x02996,0x02996); + (0x02998,0x02998); + (0x029D9,0x029D9); + (0x029DB,0x029DB); + (0x029FD,0x029FD); + (0x02E23,0x02E23); + (0x02E25,0x02E25); + (0x02E27,0x02E27); + (0x02E29,0x02E29); + (0x03009,0x03009); + (0x0300B,0x0300B); + (0x0300D,0x0300D); + (0x0300F,0x0300F); + (0x03011,0x03011); + (0x03015,0x03015); + (0x03017,0x03017); + (0x03019,0x03019); + (0x0301B,0x0301B); + (0x0301E,0x0301F); + (0x0FD3E,0x0FD3E); + (0x0FE18,0x0FE18); + (0x0FE36,0x0FE36); + (0x0FE38,0x0FE38); + (0x0FE3A,0x0FE3A); + (0x0FE3C,0x0FE3C); + (0x0FE3E,0x0FE3E); + (0x0FE40,0x0FE40); + (0x0FE42,0x0FE42); + (0x0FE44,0x0FE44); + (0x0FE48,0x0FE48); + (0x0FE5A,0x0FE5A); + (0x0FE5C,0x0FE5C); + (0x0FE5E,0x0FE5E); + (0x0FF09,0x0FF09); + (0x0FF3D,0x0FF3D); + (0x0FF5D,0x0FF5D); + (0x0FF60,0x0FF60) +] +(* Punctuation, Initial quote *) +let pi = [ + (0x000AB,0x000AB); + (0x02018,0x02018); + (0x0201B,0x0201C); + (0x0201F,0x0201F); + (0x02039,0x02039); + (0x02E02,0x02E02); + (0x02E04,0x02E04); + (0x02E09,0x02E09); + (0x02E0C,0x02E0C); + (0x02E1C,0x02E1C) +] +(* Punctuation, Final quote *) +let pf = [ + (0x000BB,0x000BB); + (0x02019,0x02019); + (0x0201D,0x0201D); + (0x0203A,0x0203A); + (0x02E03,0x02E03); + (0x02E05,0x02E05); + (0x02E0A,0x02E0A); + (0x02E0D,0x02E0D); + (0x02E1D,0x02E1D) +] +(* Punctuation, Other *) +let po = [ + (0x00021,0x00023); + (0x00025,0x00027); + (0x0002A,0x0002A); + (0x0002C,0x0002C); + (0x0002E,0x0002F); + (0x0003A,0x0003B); + (0x0003F,0x00040); + (0x0005C,0x0005C); + (0x000A1,0x000A1); + (0x000A7,0x000A7); + (0x000B6,0x000B7); + (0x000BF,0x000BF); + (0x0037E,0x0037E); + (0x00387,0x00387); + (0x0055A,0x0055F); + (0x00589,0x00589); + (0x005C0,0x005C0); + (0x005C3,0x005C3); + (0x005C6,0x005C6); + (0x005F3,0x005F4); + (0x00609,0x0060A); + (0x0060C,0x0060D); + (0x0061B,0x0061B); + (0x0061E,0x0061F); + (0x0066A,0x0066D); + (0x006D4,0x006D4); + (0x00700,0x0070D); + (0x007F7,0x007F9); + (0x00830,0x0083E); + (0x0085E,0x0085E); + (0x00964,0x00965); + (0x00970,0x00970); + (0x00AF0,0x00AF0); + (0x00DF4,0x00DF4); + (0x00E4F,0x00E4F); + (0x00E5A,0x00E5B); + (0x00F04,0x00F12); + (0x00F14,0x00F14); + (0x00F85,0x00F85); + (0x00FD0,0x00FD4); + (0x00FD9,0x00FDA); + (0x0104A,0x0104F); + (0x010FB,0x010FB); + (0x01360,0x01368); + (0x0166D,0x0166E); + (0x016EB,0x016ED); + (0x01735,0x01736); + (0x017D4,0x017D6); + (0x017D8,0x017DA); + (0x01800,0x01805); + (0x01807,0x0180A); + (0x01944,0x01945); + (0x01A1E,0x01A1F); + (0x01AA0,0x01AA6); + (0x01AA8,0x01AAD); + (0x01B5A,0x01B60); + (0x01BFC,0x01BFF); + (0x01C3B,0x01C3F); + (0x01C7E,0x01C7F); + (0x01CC0,0x01CC7); + (0x01CD3,0x01CD3); + (0x02016,0x02017); + (0x02020,0x02027); + (0x02030,0x02038); + (0x0203B,0x0203E); + (0x02041,0x02043); + (0x02047,0x02051); + (0x02053,0x02053); + (0x02055,0x0205E); + (0x02CF9,0x02CFC); + (0x02CFE,0x02CFF); + (0x02D70,0x02D70); + (0x02E00,0x02E01); + (0x02E06,0x02E08); + (0x02E0B,0x02E0B); + (0x02E0E,0x02E16); + (0x02E18,0x02E19); + (0x02E1B,0x02E1B); + (0x02E1E,0x02E1F); + (0x02E2A,0x02E2E); + (0x02E30,0x02E39); + (0x02E3C,0x02E3F); + (0x02E41,0x02E41); + (0x02E43,0x02E44); + (0x03001,0x03003); + (0x0303D,0x0303D); + (0x030FB,0x030FB); + (0x0A4FE,0x0A4FF); + (0x0A60D,0x0A60F); + (0x0A673,0x0A673); + (0x0A67E,0x0A67E); + (0x0A6F2,0x0A6F7); + (0x0A874,0x0A877); + (0x0A8CE,0x0A8CF); + (0x0A8F8,0x0A8FA); + (0x0A8FC,0x0A8FC); + (0x0A92E,0x0A92F); + (0x0A95F,0x0A95F); + (0x0A9C1,0x0A9CD); + (0x0A9DE,0x0A9DF); + (0x0AA5C,0x0AA5F); + (0x0AADE,0x0AADF); + (0x0AAF0,0x0AAF1); + (0x0ABEB,0x0ABEB); + (0x0FE10,0x0FE16); + (0x0FE19,0x0FE19); + (0x0FE30,0x0FE30); + (0x0FE45,0x0FE46); + (0x0FE49,0x0FE4C); + (0x0FE50,0x0FE52); + (0x0FE54,0x0FE57); + (0x0FE5F,0x0FE61); + (0x0FE68,0x0FE68); + (0x0FE6A,0x0FE6B); + (0x0FF01,0x0FF03); + (0x0FF05,0x0FF07); + (0x0FF0A,0x0FF0A); + (0x0FF0C,0x0FF0C); + (0x0FF0E,0x0FF0F); + (0x0FF1A,0x0FF1B); + (0x0FF1F,0x0FF20); + (0x0FF3C,0x0FF3C); + (0x0FF61,0x0FF61); + (0x0FF64,0x0FF65); + (0x10100,0x10102); + (0x1039F,0x1039F); + (0x103D0,0x103D0); + (0x1056F,0x1056F); + (0x10857,0x10857); + (0x1091F,0x1091F); + (0x1093F,0x1093F); + (0x10A50,0x10A58); + (0x10A7F,0x10A7F); + (0x10AF0,0x10AF6); + (0x10B39,0x10B3F); + (0x10B99,0x10B9C); + (0x11047,0x1104D); + (0x110BB,0x110BC); + (0x110BE,0x110C1); + (0x11140,0x11143); + (0x11174,0x11175); + (0x111C5,0x111C9); + (0x111CD,0x111CD); + (0x111DB,0x111DB); + (0x111DD,0x111DF); + (0x11238,0x1123D); + (0x112A9,0x112A9); + (0x1144B,0x1144F); + (0x1145B,0x1145B); + (0x1145D,0x1145D); + (0x114C6,0x114C6); + (0x115C1,0x115D7); + (0x11641,0x11643); + (0x11660,0x1166C); + (0x1173C,0x1173E); + (0x11C41,0x11C45); + (0x11C70,0x11C71); + (0x12470,0x12474); + (0x16A6E,0x16A6F); + (0x16AF5,0x16AF5); + (0x16B37,0x16B3B); + (0x16B44,0x16B44); + (0x1BC9F,0x1BC9F); + (0x1DA87,0x1DA8B) +] +(* Symbol, Math *) +let sm = [ + (0x0002B,0x0002B); + (0x0003C,0x0003E); + (0x0007C,0x0007C); + (0x0007E,0x0007E); + (0x000AC,0x000AC); + (0x000B1,0x000B1); + (0x000D7,0x000D7); + (0x000F7,0x000F7); + (0x003F6,0x003F6); + (0x00606,0x00608); + (0x02044,0x02044); + (0x02052,0x02052); + (0x0207A,0x0207C); + (0x0208A,0x0208C); + (0x02118,0x02118); + (0x02140,0x02144); + (0x0214B,0x0214B); + (0x02190,0x02194); + (0x0219A,0x0219B); + (0x021A0,0x021A0); + (0x021A3,0x021A3); + (0x021A6,0x021A6); + (0x021AE,0x021AE); + (0x021CE,0x021CF); + (0x021D2,0x021D2); + (0x021D4,0x021D4); + (0x021F4,0x022FF); + (0x02320,0x02321); + (0x0237C,0x0237C); + (0x0239B,0x023B3); + (0x023DC,0x023E1); + (0x025B7,0x025B7); + (0x025C1,0x025C1); + (0x025F8,0x025FF); + (0x0266F,0x0266F); + (0x027C0,0x027C4); + (0x027C7,0x027E5); + (0x027F0,0x027FF); + (0x02900,0x02982); + (0x02999,0x029D7); + (0x029DC,0x029FB); + (0x029FE,0x02AFF); + (0x02B30,0x02B44); + (0x02B47,0x02B4C); + (0x0FB29,0x0FB29); + (0x0FE62,0x0FE62); + (0x0FE64,0x0FE66); + (0x0FF0B,0x0FF0B); + (0x0FF1C,0x0FF1E); + (0x0FF5C,0x0FF5C); + (0x0FF5E,0x0FF5E); + (0x0FFE2,0x0FFE2); + (0x0FFE9,0x0FFEC); + (0x1D6C1,0x1D6C1); + (0x1D6DB,0x1D6DB); + (0x1D6FB,0x1D6FB); + (0x1D715,0x1D715); + (0x1D735,0x1D735); + (0x1D74F,0x1D74F); + (0x1D76F,0x1D76F); + (0x1D789,0x1D789); + (0x1D7A9,0x1D7A9); + (0x1D7C3,0x1D7C3) +] +(* Symbol, Currency *) +let sc = [ + (0x00024,0x00024); + (0x000A2,0x000A5); + (0x0058F,0x0058F); + (0x0060B,0x0060B); + (0x009F2,0x009F3); + (0x009FB,0x009FB); + (0x00AF1,0x00AF1); + (0x00BF9,0x00BF9); + (0x00E3F,0x00E3F); + (0x017DB,0x017DB); + (0x020A0,0x020BE); + (0x0A838,0x0A838); + (0x0FDFC,0x0FDFC); + (0x0FE69,0x0FE69); + (0x0FF04,0x0FF04); + (0x0FFE0,0x0FFE1) +] +(* Symbol, Modifier *) +let sk = [ + (0x0005E,0x0005E); + (0x00060,0x00060); + (0x000A8,0x000A8); + (0x000AF,0x000AF); + (0x000B4,0x000B4); + (0x000B8,0x000B8); + (0x002C2,0x002C5); + (0x002D2,0x002DF); + (0x002E5,0x002EB); + (0x002ED,0x002ED); + (0x002EF,0x002FF); + (0x00375,0x00375); + (0x00384,0x00385); + (0x01FBD,0x01FBD); + (0x01FBF,0x01FC1); + (0x01FCD,0x01FCF); + (0x01FDD,0x01FDF); + (0x01FED,0x01FEF); + (0x01FFD,0x01FFE); + (0x0309B,0x0309C); + (0x0A700,0x0A716); + (0x0A720,0x0A721); + (0x0A789,0x0A78A); + (0x0AB5B,0x0AB5B); + (0x0FBB2,0x0FBC1); + (0x0FF3E,0x0FF3E); + (0x0FF40,0x0FF40); + (0x0FFE3,0x0FFE3) +] +(* Symbol, Other *) +let so = [ + (0x000A6,0x000A6); + (0x000A9,0x000A9); + (0x000AE,0x000AE); + (0x000B0,0x000B0); + (0x00482,0x00482); + (0x0058D,0x0058E); + (0x0060E,0x0060F); + (0x006DE,0x006DE); + (0x006E9,0x006E9); + (0x006FD,0x006FE); + (0x007F6,0x007F6); + (0x009FA,0x009FA); + (0x00B70,0x00B70); + (0x00BF3,0x00BF8); + (0x00BFA,0x00BFA); + (0x00C7F,0x00C7F); + (0x00D4F,0x00D4F); + (0x00D79,0x00D79); + (0x00F01,0x00F03); + (0x00F13,0x00F13); + (0x00F15,0x00F17); + (0x00F1A,0x00F1F); + (0x00F34,0x00F34); + (0x00F36,0x00F36); + (0x00F38,0x00F38); + (0x00FBE,0x00FC5); + (0x00FC7,0x00FCC); + (0x00FCE,0x00FCF); + (0x00FD5,0x00FD8); + (0x0109E,0x0109F); + (0x01390,0x01399); + (0x01940,0x01940); + (0x019DE,0x019FF); + (0x01B61,0x01B6A); + (0x01B74,0x01B7C); + (0x02100,0x02101); + (0x02103,0x02106); + (0x02108,0x02109); + (0x02114,0x02114); + (0x02116,0x02117); + (0x0211E,0x02123); + (0x02125,0x02125); + (0x02127,0x02127); + (0x02129,0x02129); + (0x0212E,0x0212E); + (0x0213A,0x0213B); + (0x0214A,0x0214A); + (0x0214C,0x0214D); + (0x0214F,0x0214F); + (0x0218A,0x0218B); + (0x02195,0x02199); + (0x0219C,0x0219F); + (0x021A1,0x021A2); + (0x021A4,0x021A5); + (0x021A7,0x021AD); + (0x021AF,0x021CD); + (0x021D0,0x021D1); + (0x021D3,0x021D3); + (0x021D5,0x021F3); + (0x02300,0x02307); + (0x0230C,0x0231F); + (0x02322,0x02328); + (0x0232B,0x0237B); + (0x0237D,0x0239A); + (0x023B4,0x023DB); + (0x023E2,0x023FE); + (0x02400,0x02426); + (0x02440,0x0244A); + (0x0249C,0x024E9); + (0x02500,0x025B6); + (0x025B8,0x025C0); + (0x025C2,0x025F7); + (0x02600,0x0266E); + (0x02670,0x02767); + (0x02794,0x027BF); + (0x02800,0x028FF); + (0x02B00,0x02B2F); + (0x02B45,0x02B46); + (0x02B4D,0x02B73); + (0x02B76,0x02B95); + (0x02B98,0x02BB9); + (0x02BBD,0x02BC8); + (0x02BCA,0x02BD1); + (0x02BEC,0x02BEF); + (0x02CE5,0x02CEA); + (0x02E80,0x02E99); + (0x02E9B,0x02EF3); + (0x02F00,0x02FD5); + (0x02FF0,0x02FFB); + (0x03004,0x03004); + (0x03012,0x03013); + (0x03020,0x03020); + (0x03036,0x03037); + (0x0303E,0x0303F); + (0x03190,0x03191); + (0x03196,0x0319F); + (0x031C0,0x031E3); + (0x03200,0x0321E); + (0x0322A,0x03247); + (0x03250,0x03250); + (0x03260,0x0327F); + (0x0328A,0x032B0); + (0x032C0,0x032FE); + (0x03300,0x033FF); + (0x04DC0,0x04DFF); + (0x0A490,0x0A4C6); + (0x0A828,0x0A82B); + (0x0A836,0x0A837); + (0x0A839,0x0A839); + (0x0AA77,0x0AA79); + (0x0FDFD,0x0FDFD); + (0x0FFE4,0x0FFE4); + (0x0FFE8,0x0FFE8); + (0x0FFED,0x0FFEE); + (0x0FFFC,0x0FFFD); + (0x10137,0x1013F); + (0x10179,0x10189); + (0x1018C,0x1018E); + (0x10190,0x1019B); + (0x101A0,0x101A0); + (0x101D0,0x101FC); + (0x10877,0x10878); + (0x10AC8,0x10AC8); + (0x1173F,0x1173F); + (0x16B3C,0x16B3F); + (0x16B45,0x16B45); + (0x1BC9C,0x1BC9C); + (0x1D000,0x1D0F5); + (0x1D100,0x1D126); + (0x1D129,0x1D164); + (0x1D16A,0x1D16C); + (0x1D183,0x1D184); + (0x1D18C,0x1D1A9); + (0x1D1AE,0x1D1E8); + (0x1D200,0x1D241); + (0x1D245,0x1D245); + (0x1D300,0x1D356); + (0x1D800,0x1D9FF); + (0x1DA37,0x1DA3A); + (0x1DA6D,0x1DA74); + (0x1DA76,0x1DA83); + (0x1DA85,0x1DA86); + (0x1F000,0x1F02B); + (0x1F030,0x1F093); + (0x1F0A0,0x1F0AE); + (0x1F0B1,0x1F0BF); + (0x1F0C1,0x1F0CF); + (0x1F0D1,0x1F0F5); + (0x1F110,0x1F12E); + (0x1F130,0x1F16B); + (0x1F170,0x1F1AC); + (0x1F1E6,0x1F202); + (0x1F210,0x1F23B); + (0x1F240,0x1F248); + (0x1F250,0x1F251); + (0x1F300,0x1F3FA); + (0x1F400,0x1F6D2); + (0x1F6E0,0x1F6EC); + (0x1F6F0,0x1F6F6); + (0x1F700,0x1F773); + (0x1F780,0x1F7D4); + (0x1F800,0x1F80B); + (0x1F810,0x1F847); + (0x1F850,0x1F859); + (0x1F860,0x1F887); + (0x1F890,0x1F8AD); + (0x1F910,0x1F91E); + (0x1F920,0x1F927); + (0x1F930,0x1F930); + (0x1F933,0x1F93E); + (0x1F940,0x1F94B); + (0x1F950,0x1F95E); + (0x1F980,0x1F991) +] +let to_lower = [ + (0x00041,0x0005A), `Delta (32); + (0x000C0,0x000D6), `Delta (32); + (0x000D8,0x000DE), `Delta (32); + (0x00100,0x00100), `Abs (0x00101); + (0x00102,0x00102), `Abs (0x00103); + (0x00104,0x00104), `Abs (0x00105); + (0x00106,0x00106), `Abs (0x00107); + (0x00108,0x00108), `Abs (0x00109); + (0x0010A,0x0010A), `Abs (0x0010B); + (0x0010C,0x0010C), `Abs (0x0010D); + (0x0010E,0x0010E), `Abs (0x0010F); + (0x00110,0x00110), `Abs (0x00111); + (0x00112,0x00112), `Abs (0x00113); + (0x00114,0x00114), `Abs (0x00115); + (0x00116,0x00116), `Abs (0x00117); + (0x00118,0x00118), `Abs (0x00119); + (0x0011A,0x0011A), `Abs (0x0011B); + (0x0011C,0x0011C), `Abs (0x0011D); + (0x0011E,0x0011E), `Abs (0x0011F); + (0x00120,0x00120), `Abs (0x00121); + (0x00122,0x00122), `Abs (0x00123); + (0x00124,0x00124), `Abs (0x00125); + (0x00126,0x00126), `Abs (0x00127); + (0x00128,0x00128), `Abs (0x00129); + (0x0012A,0x0012A), `Abs (0x0012B); + (0x0012C,0x0012C), `Abs (0x0012D); + (0x0012E,0x0012E), `Abs (0x0012F); + (0x00130,0x00130), `Abs (0x00069); + (0x00132,0x00132), `Abs (0x00133); + (0x00134,0x00134), `Abs (0x00135); + (0x00136,0x00136), `Abs (0x00137); + (0x00139,0x00139), `Abs (0x0013A); + (0x0013B,0x0013B), `Abs (0x0013C); + (0x0013D,0x0013D), `Abs (0x0013E); + (0x0013F,0x0013F), `Abs (0x00140); + (0x00141,0x00141), `Abs (0x00142); + (0x00143,0x00143), `Abs (0x00144); + (0x00145,0x00145), `Abs (0x00146); + (0x00147,0x00147), `Abs (0x00148); + (0x0014A,0x0014A), `Abs (0x0014B); + (0x0014C,0x0014C), `Abs (0x0014D); + (0x0014E,0x0014E), `Abs (0x0014F); + (0x00150,0x00150), `Abs (0x00151); + (0x00152,0x00152), `Abs (0x00153); + (0x00154,0x00154), `Abs (0x00155); + (0x00156,0x00156), `Abs (0x00157); + (0x00158,0x00158), `Abs (0x00159); + (0x0015A,0x0015A), `Abs (0x0015B); + (0x0015C,0x0015C), `Abs (0x0015D); + (0x0015E,0x0015E), `Abs (0x0015F); + (0x00160,0x00160), `Abs (0x00161); + (0x00162,0x00162), `Abs (0x00163); + (0x00164,0x00164), `Abs (0x00165); + (0x00166,0x00166), `Abs (0x00167); + (0x00168,0x00168), `Abs (0x00169); + (0x0016A,0x0016A), `Abs (0x0016B); + (0x0016C,0x0016C), `Abs (0x0016D); + (0x0016E,0x0016E), `Abs (0x0016F); + (0x00170,0x00170), `Abs (0x00171); + (0x00172,0x00172), `Abs (0x00173); + (0x00174,0x00174), `Abs (0x00175); + (0x00176,0x00176), `Abs (0x00177); + (0x00178,0x00178), `Abs (0x000FF); + (0x00179,0x00179), `Abs (0x0017A); + (0x0017B,0x0017B), `Abs (0x0017C); + (0x0017D,0x0017D), `Abs (0x0017E); + (0x00181,0x00181), `Abs (0x00253); + (0x00182,0x00182), `Abs (0x00183); + (0x00184,0x00184), `Abs (0x00185); + (0x00186,0x00186), `Abs (0x00254); + (0x00187,0x00187), `Abs (0x00188); + (0x00189,0x0018A), `Delta (205); + (0x0018B,0x0018B), `Abs (0x0018C); + (0x0018E,0x0018E), `Abs (0x001DD); + (0x0018F,0x0018F), `Abs (0x00259); + (0x00190,0x00190), `Abs (0x0025B); + (0x00191,0x00191), `Abs (0x00192); + (0x00193,0x00193), `Abs (0x00260); + (0x00194,0x00194), `Abs (0x00263); + (0x00196,0x00196), `Abs (0x00269); + (0x00197,0x00197), `Abs (0x00268); + (0x00198,0x00198), `Abs (0x00199); + (0x0019C,0x0019C), `Abs (0x0026F); + (0x0019D,0x0019D), `Abs (0x00272); + (0x0019F,0x0019F), `Abs (0x00275); + (0x001A0,0x001A0), `Abs (0x001A1); + (0x001A2,0x001A2), `Abs (0x001A3); + (0x001A4,0x001A4), `Abs (0x001A5); + (0x001A6,0x001A6), `Abs (0x00280); + (0x001A7,0x001A7), `Abs (0x001A8); + (0x001A9,0x001A9), `Abs (0x00283); + (0x001AC,0x001AC), `Abs (0x001AD); + (0x001AE,0x001AE), `Abs (0x00288); + (0x001AF,0x001AF), `Abs (0x001B0); + (0x001B1,0x001B2), `Delta (217); + (0x001B3,0x001B3), `Abs (0x001B4); + (0x001B5,0x001B5), `Abs (0x001B6); + (0x001B7,0x001B7), `Abs (0x00292); + (0x001B8,0x001B8), `Abs (0x001B9); + (0x001BC,0x001BC), `Abs (0x001BD); + (0x001C4,0x001C4), `Abs (0x001C6); + (0x001C7,0x001C7), `Abs (0x001C9); + (0x001CA,0x001CA), `Abs (0x001CC); + (0x001CD,0x001CD), `Abs (0x001CE); + (0x001CF,0x001CF), `Abs (0x001D0); + (0x001D1,0x001D1), `Abs (0x001D2); + (0x001D3,0x001D3), `Abs (0x001D4); + (0x001D5,0x001D5), `Abs (0x001D6); + (0x001D7,0x001D7), `Abs (0x001D8); + (0x001D9,0x001D9), `Abs (0x001DA); + (0x001DB,0x001DB), `Abs (0x001DC); + (0x001DE,0x001DE), `Abs (0x001DF); + (0x001E0,0x001E0), `Abs (0x001E1); + (0x001E2,0x001E2), `Abs (0x001E3); + (0x001E4,0x001E4), `Abs (0x001E5); + (0x001E6,0x001E6), `Abs (0x001E7); + (0x001E8,0x001E8), `Abs (0x001E9); + (0x001EA,0x001EA), `Abs (0x001EB); + (0x001EC,0x001EC), `Abs (0x001ED); + (0x001EE,0x001EE), `Abs (0x001EF); + (0x001F1,0x001F1), `Abs (0x001F3); + (0x001F4,0x001F4), `Abs (0x001F5); + (0x001F6,0x001F6), `Abs (0x00195); + (0x001F7,0x001F7), `Abs (0x001BF); + (0x001F8,0x001F8), `Abs (0x001F9); + (0x001FA,0x001FA), `Abs (0x001FB); + (0x001FC,0x001FC), `Abs (0x001FD); + (0x001FE,0x001FE), `Abs (0x001FF); + (0x00200,0x00200), `Abs (0x00201); + (0x00202,0x00202), `Abs (0x00203); + (0x00204,0x00204), `Abs (0x00205); + (0x00206,0x00206), `Abs (0x00207); + (0x00208,0x00208), `Abs (0x00209); + (0x0020A,0x0020A), `Abs (0x0020B); + (0x0020C,0x0020C), `Abs (0x0020D); + (0x0020E,0x0020E), `Abs (0x0020F); + (0x00210,0x00210), `Abs (0x00211); + (0x00212,0x00212), `Abs (0x00213); + (0x00214,0x00214), `Abs (0x00215); + (0x00216,0x00216), `Abs (0x00217); + (0x00218,0x00218), `Abs (0x00219); + (0x0021A,0x0021A), `Abs (0x0021B); + (0x0021C,0x0021C), `Abs (0x0021D); + (0x0021E,0x0021E), `Abs (0x0021F); + (0x00220,0x00220), `Abs (0x0019E); + (0x00222,0x00222), `Abs (0x00223); + (0x00224,0x00224), `Abs (0x00225); + (0x00226,0x00226), `Abs (0x00227); + (0x00228,0x00228), `Abs (0x00229); + (0x0022A,0x0022A), `Abs (0x0022B); + (0x0022C,0x0022C), `Abs (0x0022D); + (0x0022E,0x0022E), `Abs (0x0022F); + (0x00230,0x00230), `Abs (0x00231); + (0x00232,0x00232), `Abs (0x00233); + (0x0023A,0x0023A), `Abs (0x02C65); + (0x0023B,0x0023B), `Abs (0x0023C); + (0x0023D,0x0023D), `Abs (0x0019A); + (0x0023E,0x0023E), `Abs (0x02C66); + (0x00241,0x00241), `Abs (0x00242); + (0x00243,0x00243), `Abs (0x00180); + (0x00244,0x00244), `Abs (0x00289); + (0x00245,0x00245), `Abs (0x0028C); + (0x00246,0x00246), `Abs (0x00247); + (0x00248,0x00248), `Abs (0x00249); + (0x0024A,0x0024A), `Abs (0x0024B); + (0x0024C,0x0024C), `Abs (0x0024D); + (0x0024E,0x0024E), `Abs (0x0024F); + (0x00370,0x00370), `Abs (0x00371); + (0x00372,0x00372), `Abs (0x00373); + (0x00376,0x00376), `Abs (0x00377); + (0x0037F,0x0037F), `Abs (0x003F3); + (0x00386,0x00386), `Abs (0x003AC); + (0x00388,0x0038A), `Delta (37); + (0x0038C,0x0038C), `Abs (0x003CC); + (0x0038E,0x0038F), `Delta (63); + (0x00391,0x003A1), `Delta (32); + (0x003A3,0x003AB), `Delta (32); + (0x003CF,0x003CF), `Abs (0x003D7); + (0x003D2,0x003D4), `Delta (0); + (0x003D8,0x003D8), `Abs (0x003D9); + (0x003DA,0x003DA), `Abs (0x003DB); + (0x003DC,0x003DC), `Abs (0x003DD); + (0x003DE,0x003DE), `Abs (0x003DF); + (0x003E0,0x003E0), `Abs (0x003E1); + (0x003E2,0x003E2), `Abs (0x003E3); + (0x003E4,0x003E4), `Abs (0x003E5); + (0x003E6,0x003E6), `Abs (0x003E7); + (0x003E8,0x003E8), `Abs (0x003E9); + (0x003EA,0x003EA), `Abs (0x003EB); + (0x003EC,0x003EC), `Abs (0x003ED); + (0x003EE,0x003EE), `Abs (0x003EF); + (0x003F4,0x003F4), `Abs (0x003B8); + (0x003F7,0x003F7), `Abs (0x003F8); + (0x003F9,0x003F9), `Abs (0x003F2); + (0x003FA,0x003FA), `Abs (0x003FB); + (0x003FD,0x003FF), `Delta (-130); + (0x00400,0x0040F), `Delta (80); + (0x00410,0x0042F), `Delta (32); + (0x00460,0x00460), `Abs (0x00461); + (0x00462,0x00462), `Abs (0x00463); + (0x00464,0x00464), `Abs (0x00465); + (0x00466,0x00466), `Abs (0x00467); + (0x00468,0x00468), `Abs (0x00469); + (0x0046A,0x0046A), `Abs (0x0046B); + (0x0046C,0x0046C), `Abs (0x0046D); + (0x0046E,0x0046E), `Abs (0x0046F); + (0x00470,0x00470), `Abs (0x00471); + (0x00472,0x00472), `Abs (0x00473); + (0x00474,0x00474), `Abs (0x00475); + (0x00476,0x00476), `Abs (0x00477); + (0x00478,0x00478), `Abs (0x00479); + (0x0047A,0x0047A), `Abs (0x0047B); + (0x0047C,0x0047C), `Abs (0x0047D); + (0x0047E,0x0047E), `Abs (0x0047F); + (0x00480,0x00480), `Abs (0x00481); + (0x0048A,0x0048A), `Abs (0x0048B); + (0x0048C,0x0048C), `Abs (0x0048D); + (0x0048E,0x0048E), `Abs (0x0048F); + (0x00490,0x00490), `Abs (0x00491); + (0x00492,0x00492), `Abs (0x00493); + (0x00494,0x00494), `Abs (0x00495); + (0x00496,0x00496), `Abs (0x00497); + (0x00498,0x00498), `Abs (0x00499); + (0x0049A,0x0049A), `Abs (0x0049B); + (0x0049C,0x0049C), `Abs (0x0049D); + (0x0049E,0x0049E), `Abs (0x0049F); + (0x004A0,0x004A0), `Abs (0x004A1); + (0x004A2,0x004A2), `Abs (0x004A3); + (0x004A4,0x004A4), `Abs (0x004A5); + (0x004A6,0x004A6), `Abs (0x004A7); + (0x004A8,0x004A8), `Abs (0x004A9); + (0x004AA,0x004AA), `Abs (0x004AB); + (0x004AC,0x004AC), `Abs (0x004AD); + (0x004AE,0x004AE), `Abs (0x004AF); + (0x004B0,0x004B0), `Abs (0x004B1); + (0x004B2,0x004B2), `Abs (0x004B3); + (0x004B4,0x004B4), `Abs (0x004B5); + (0x004B6,0x004B6), `Abs (0x004B7); + (0x004B8,0x004B8), `Abs (0x004B9); + (0x004BA,0x004BA), `Abs (0x004BB); + (0x004BC,0x004BC), `Abs (0x004BD); + (0x004BE,0x004BE), `Abs (0x004BF); + (0x004C0,0x004C0), `Abs (0x004CF); + (0x004C1,0x004C1), `Abs (0x004C2); + (0x004C3,0x004C3), `Abs (0x004C4); + (0x004C5,0x004C5), `Abs (0x004C6); + (0x004C7,0x004C7), `Abs (0x004C8); + (0x004C9,0x004C9), `Abs (0x004CA); + (0x004CB,0x004CB), `Abs (0x004CC); + (0x004CD,0x004CD), `Abs (0x004CE); + (0x004D0,0x004D0), `Abs (0x004D1); + (0x004D2,0x004D2), `Abs (0x004D3); + (0x004D4,0x004D4), `Abs (0x004D5); + (0x004D6,0x004D6), `Abs (0x004D7); + (0x004D8,0x004D8), `Abs (0x004D9); + (0x004DA,0x004DA), `Abs (0x004DB); + (0x004DC,0x004DC), `Abs (0x004DD); + (0x004DE,0x004DE), `Abs (0x004DF); + (0x004E0,0x004E0), `Abs (0x004E1); + (0x004E2,0x004E2), `Abs (0x004E3); + (0x004E4,0x004E4), `Abs (0x004E5); + (0x004E6,0x004E6), `Abs (0x004E7); + (0x004E8,0x004E8), `Abs (0x004E9); + (0x004EA,0x004EA), `Abs (0x004EB); + (0x004EC,0x004EC), `Abs (0x004ED); + (0x004EE,0x004EE), `Abs (0x004EF); + (0x004F0,0x004F0), `Abs (0x004F1); + (0x004F2,0x004F2), `Abs (0x004F3); + (0x004F4,0x004F4), `Abs (0x004F5); + (0x004F6,0x004F6), `Abs (0x004F7); + (0x004F8,0x004F8), `Abs (0x004F9); + (0x004FA,0x004FA), `Abs (0x004FB); + (0x004FC,0x004FC), `Abs (0x004FD); + (0x004FE,0x004FE), `Abs (0x004FF); + (0x00500,0x00500), `Abs (0x00501); + (0x00502,0x00502), `Abs (0x00503); + (0x00504,0x00504), `Abs (0x00505); + (0x00506,0x00506), `Abs (0x00507); + (0x00508,0x00508), `Abs (0x00509); + (0x0050A,0x0050A), `Abs (0x0050B); + (0x0050C,0x0050C), `Abs (0x0050D); + (0x0050E,0x0050E), `Abs (0x0050F); + (0x00510,0x00510), `Abs (0x00511); + (0x00512,0x00512), `Abs (0x00513); + (0x00514,0x00514), `Abs (0x00515); + (0x00516,0x00516), `Abs (0x00517); + (0x00518,0x00518), `Abs (0x00519); + (0x0051A,0x0051A), `Abs (0x0051B); + (0x0051C,0x0051C), `Abs (0x0051D); + (0x0051E,0x0051E), `Abs (0x0051F); + (0x00520,0x00520), `Abs (0x00521); + (0x00522,0x00522), `Abs (0x00523); + (0x00524,0x00524), `Abs (0x00525); + (0x00526,0x00526), `Abs (0x00527); + (0x00528,0x00528), `Abs (0x00529); + (0x0052A,0x0052A), `Abs (0x0052B); + (0x0052C,0x0052C), `Abs (0x0052D); + (0x0052E,0x0052E), `Abs (0x0052F); + (0x00531,0x00556), `Delta (48); + (0x010A0,0x010C5), `Delta (7264); + (0x010C7,0x010C7), `Abs (0x02D27); + (0x010CD,0x010CD), `Abs (0x02D2D); + (0x013A0,0x013EF), `Delta (38864); + (0x013F0,0x013F5), `Delta (8); + (0x01E00,0x01E00), `Abs (0x01E01); + (0x01E02,0x01E02), `Abs (0x01E03); + (0x01E04,0x01E04), `Abs (0x01E05); + (0x01E06,0x01E06), `Abs (0x01E07); + (0x01E08,0x01E08), `Abs (0x01E09); + (0x01E0A,0x01E0A), `Abs (0x01E0B); + (0x01E0C,0x01E0C), `Abs (0x01E0D); + (0x01E0E,0x01E0E), `Abs (0x01E0F); + (0x01E10,0x01E10), `Abs (0x01E11); + (0x01E12,0x01E12), `Abs (0x01E13); + (0x01E14,0x01E14), `Abs (0x01E15); + (0x01E16,0x01E16), `Abs (0x01E17); + (0x01E18,0x01E18), `Abs (0x01E19); + (0x01E1A,0x01E1A), `Abs (0x01E1B); + (0x01E1C,0x01E1C), `Abs (0x01E1D); + (0x01E1E,0x01E1E), `Abs (0x01E1F); + (0x01E20,0x01E20), `Abs (0x01E21); + (0x01E22,0x01E22), `Abs (0x01E23); + (0x01E24,0x01E24), `Abs (0x01E25); + (0x01E26,0x01E26), `Abs (0x01E27); + (0x01E28,0x01E28), `Abs (0x01E29); + (0x01E2A,0x01E2A), `Abs (0x01E2B); + (0x01E2C,0x01E2C), `Abs (0x01E2D); + (0x01E2E,0x01E2E), `Abs (0x01E2F); + (0x01E30,0x01E30), `Abs (0x01E31); + (0x01E32,0x01E32), `Abs (0x01E33); + (0x01E34,0x01E34), `Abs (0x01E35); + (0x01E36,0x01E36), `Abs (0x01E37); + (0x01E38,0x01E38), `Abs (0x01E39); + (0x01E3A,0x01E3A), `Abs (0x01E3B); + (0x01E3C,0x01E3C), `Abs (0x01E3D); + (0x01E3E,0x01E3E), `Abs (0x01E3F); + (0x01E40,0x01E40), `Abs (0x01E41); + (0x01E42,0x01E42), `Abs (0x01E43); + (0x01E44,0x01E44), `Abs (0x01E45); + (0x01E46,0x01E46), `Abs (0x01E47); + (0x01E48,0x01E48), `Abs (0x01E49); + (0x01E4A,0x01E4A), `Abs (0x01E4B); + (0x01E4C,0x01E4C), `Abs (0x01E4D); + (0x01E4E,0x01E4E), `Abs (0x01E4F); + (0x01E50,0x01E50), `Abs (0x01E51); + (0x01E52,0x01E52), `Abs (0x01E53); + (0x01E54,0x01E54), `Abs (0x01E55); + (0x01E56,0x01E56), `Abs (0x01E57); + (0x01E58,0x01E58), `Abs (0x01E59); + (0x01E5A,0x01E5A), `Abs (0x01E5B); + (0x01E5C,0x01E5C), `Abs (0x01E5D); + (0x01E5E,0x01E5E), `Abs (0x01E5F); + (0x01E60,0x01E60), `Abs (0x01E61); + (0x01E62,0x01E62), `Abs (0x01E63); + (0x01E64,0x01E64), `Abs (0x01E65); + (0x01E66,0x01E66), `Abs (0x01E67); + (0x01E68,0x01E68), `Abs (0x01E69); + (0x01E6A,0x01E6A), `Abs (0x01E6B); + (0x01E6C,0x01E6C), `Abs (0x01E6D); + (0x01E6E,0x01E6E), `Abs (0x01E6F); + (0x01E70,0x01E70), `Abs (0x01E71); + (0x01E72,0x01E72), `Abs (0x01E73); + (0x01E74,0x01E74), `Abs (0x01E75); + (0x01E76,0x01E76), `Abs (0x01E77); + (0x01E78,0x01E78), `Abs (0x01E79); + (0x01E7A,0x01E7A), `Abs (0x01E7B); + (0x01E7C,0x01E7C), `Abs (0x01E7D); + (0x01E7E,0x01E7E), `Abs (0x01E7F); + (0x01E80,0x01E80), `Abs (0x01E81); + (0x01E82,0x01E82), `Abs (0x01E83); + (0x01E84,0x01E84), `Abs (0x01E85); + (0x01E86,0x01E86), `Abs (0x01E87); + (0x01E88,0x01E88), `Abs (0x01E89); + (0x01E8A,0x01E8A), `Abs (0x01E8B); + (0x01E8C,0x01E8C), `Abs (0x01E8D); + (0x01E8E,0x01E8E), `Abs (0x01E8F); + (0x01E90,0x01E90), `Abs (0x01E91); + (0x01E92,0x01E92), `Abs (0x01E93); + (0x01E94,0x01E94), `Abs (0x01E95); + (0x01E9E,0x01E9E), `Abs (0x000DF); + (0x01EA0,0x01EA0), `Abs (0x01EA1); + (0x01EA2,0x01EA2), `Abs (0x01EA3); + (0x01EA4,0x01EA4), `Abs (0x01EA5); + (0x01EA6,0x01EA6), `Abs (0x01EA7); + (0x01EA8,0x01EA8), `Abs (0x01EA9); + (0x01EAA,0x01EAA), `Abs (0x01EAB); + (0x01EAC,0x01EAC), `Abs (0x01EAD); + (0x01EAE,0x01EAE), `Abs (0x01EAF); + (0x01EB0,0x01EB0), `Abs (0x01EB1); + (0x01EB2,0x01EB2), `Abs (0x01EB3); + (0x01EB4,0x01EB4), `Abs (0x01EB5); + (0x01EB6,0x01EB6), `Abs (0x01EB7); + (0x01EB8,0x01EB8), `Abs (0x01EB9); + (0x01EBA,0x01EBA), `Abs (0x01EBB); + (0x01EBC,0x01EBC), `Abs (0x01EBD); + (0x01EBE,0x01EBE), `Abs (0x01EBF); + (0x01EC0,0x01EC0), `Abs (0x01EC1); + (0x01EC2,0x01EC2), `Abs (0x01EC3); + (0x01EC4,0x01EC4), `Abs (0x01EC5); + (0x01EC6,0x01EC6), `Abs (0x01EC7); + (0x01EC8,0x01EC8), `Abs (0x01EC9); + (0x01ECA,0x01ECA), `Abs (0x01ECB); + (0x01ECC,0x01ECC), `Abs (0x01ECD); + (0x01ECE,0x01ECE), `Abs (0x01ECF); + (0x01ED0,0x01ED0), `Abs (0x01ED1); + (0x01ED2,0x01ED2), `Abs (0x01ED3); + (0x01ED4,0x01ED4), `Abs (0x01ED5); + (0x01ED6,0x01ED6), `Abs (0x01ED7); + (0x01ED8,0x01ED8), `Abs (0x01ED9); + (0x01EDA,0x01EDA), `Abs (0x01EDB); + (0x01EDC,0x01EDC), `Abs (0x01EDD); + (0x01EDE,0x01EDE), `Abs (0x01EDF); + (0x01EE0,0x01EE0), `Abs (0x01EE1); + (0x01EE2,0x01EE2), `Abs (0x01EE3); + (0x01EE4,0x01EE4), `Abs (0x01EE5); + (0x01EE6,0x01EE6), `Abs (0x01EE7); + (0x01EE8,0x01EE8), `Abs (0x01EE9); + (0x01EEA,0x01EEA), `Abs (0x01EEB); + (0x01EEC,0x01EEC), `Abs (0x01EED); + (0x01EEE,0x01EEE), `Abs (0x01EEF); + (0x01EF0,0x01EF0), `Abs (0x01EF1); + (0x01EF2,0x01EF2), `Abs (0x01EF3); + (0x01EF4,0x01EF4), `Abs (0x01EF5); + (0x01EF6,0x01EF6), `Abs (0x01EF7); + (0x01EF8,0x01EF8), `Abs (0x01EF9); + (0x01EFA,0x01EFA), `Abs (0x01EFB); + (0x01EFC,0x01EFC), `Abs (0x01EFD); + (0x01EFE,0x01EFE), `Abs (0x01EFF); + (0x01F08,0x01F0F), `Delta (-8); + (0x01F18,0x01F1D), `Delta (-8); + (0x01F28,0x01F2F), `Delta (-8); + (0x01F38,0x01F3F), `Delta (-8); + (0x01F48,0x01F4D), `Delta (-8); + (0x01F59,0x01F59), `Abs (0x01F51); + (0x01F5B,0x01F5B), `Abs (0x01F53); + (0x01F5D,0x01F5D), `Abs (0x01F55); + (0x01F5F,0x01F5F), `Abs (0x01F57); + (0x01F68,0x01F6F), `Delta (-8); + (0x01FB8,0x01FB9), `Delta (-8); + (0x01FBA,0x01FBB), `Delta (-74); + (0x01FC8,0x01FCB), `Delta (-86); + (0x01FD8,0x01FD9), `Delta (-8); + (0x01FDA,0x01FDB), `Delta (-100); + (0x01FE8,0x01FE9), `Delta (-8); + (0x01FEA,0x01FEB), `Delta (-112); + (0x01FEC,0x01FEC), `Abs (0x01FE5); + (0x01FF8,0x01FF9), `Delta (-128); + (0x01FFA,0x01FFB), `Delta (-126); + (0x02102,0x02102), `Abs (0x02102); + (0x02107,0x02107), `Abs (0x02107); + (0x0210B,0x0210D), `Delta (0); + (0x02110,0x02112), `Delta (0); + (0x02115,0x02115), `Abs (0x02115); + (0x02119,0x0211D), `Delta (0); + (0x02124,0x02124), `Abs (0x02124); + (0x02126,0x02126), `Abs (0x003C9); + (0x02128,0x02128), `Abs (0x02128); + (0x0212A,0x0212A), `Abs (0x0006B); + (0x0212B,0x0212B), `Abs (0x000E5); + (0x0212C,0x0212D), `Delta (0); + (0x02130,0x02131), `Delta (0); + (0x02132,0x02132), `Abs (0x0214E); + (0x02133,0x02133), `Abs (0x02133); + (0x0213E,0x0213F), `Delta (0); + (0x02145,0x02145), `Abs (0x02145); + (0x02183,0x02183), `Abs (0x02184); + (0x02C00,0x02C2E), `Delta (48); + (0x02C60,0x02C60), `Abs (0x02C61); + (0x02C62,0x02C62), `Abs (0x0026B); + (0x02C63,0x02C63), `Abs (0x01D7D); + (0x02C64,0x02C64), `Abs (0x0027D); + (0x02C67,0x02C67), `Abs (0x02C68); + (0x02C69,0x02C69), `Abs (0x02C6A); + (0x02C6B,0x02C6B), `Abs (0x02C6C); + (0x02C6D,0x02C6D), `Abs (0x00251); + (0x02C6E,0x02C6E), `Abs (0x00271); + (0x02C6F,0x02C6F), `Abs (0x00250); + (0x02C70,0x02C70), `Abs (0x00252); + (0x02C72,0x02C72), `Abs (0x02C73); + (0x02C75,0x02C75), `Abs (0x02C76); + (0x02C7E,0x02C7F), `Delta (-10815); + (0x02C80,0x02C80), `Abs (0x02C81); + (0x02C82,0x02C82), `Abs (0x02C83); + (0x02C84,0x02C84), `Abs (0x02C85); + (0x02C86,0x02C86), `Abs (0x02C87); + (0x02C88,0x02C88), `Abs (0x02C89); + (0x02C8A,0x02C8A), `Abs (0x02C8B); + (0x02C8C,0x02C8C), `Abs (0x02C8D); + (0x02C8E,0x02C8E), `Abs (0x02C8F); + (0x02C90,0x02C90), `Abs (0x02C91); + (0x02C92,0x02C92), `Abs (0x02C93); + (0x02C94,0x02C94), `Abs (0x02C95); + (0x02C96,0x02C96), `Abs (0x02C97); + (0x02C98,0x02C98), `Abs (0x02C99); + (0x02C9A,0x02C9A), `Abs (0x02C9B); + (0x02C9C,0x02C9C), `Abs (0x02C9D); + (0x02C9E,0x02C9E), `Abs (0x02C9F); + (0x02CA0,0x02CA0), `Abs (0x02CA1); + (0x02CA2,0x02CA2), `Abs (0x02CA3); + (0x02CA4,0x02CA4), `Abs (0x02CA5); + (0x02CA6,0x02CA6), `Abs (0x02CA7); + (0x02CA8,0x02CA8), `Abs (0x02CA9); + (0x02CAA,0x02CAA), `Abs (0x02CAB); + (0x02CAC,0x02CAC), `Abs (0x02CAD); + (0x02CAE,0x02CAE), `Abs (0x02CAF); + (0x02CB0,0x02CB0), `Abs (0x02CB1); + (0x02CB2,0x02CB2), `Abs (0x02CB3); + (0x02CB4,0x02CB4), `Abs (0x02CB5); + (0x02CB6,0x02CB6), `Abs (0x02CB7); + (0x02CB8,0x02CB8), `Abs (0x02CB9); + (0x02CBA,0x02CBA), `Abs (0x02CBB); + (0x02CBC,0x02CBC), `Abs (0x02CBD); + (0x02CBE,0x02CBE), `Abs (0x02CBF); + (0x02CC0,0x02CC0), `Abs (0x02CC1); + (0x02CC2,0x02CC2), `Abs (0x02CC3); + (0x02CC4,0x02CC4), `Abs (0x02CC5); + (0x02CC6,0x02CC6), `Abs (0x02CC7); + (0x02CC8,0x02CC8), `Abs (0x02CC9); + (0x02CCA,0x02CCA), `Abs (0x02CCB); + (0x02CCC,0x02CCC), `Abs (0x02CCD); + (0x02CCE,0x02CCE), `Abs (0x02CCF); + (0x02CD0,0x02CD0), `Abs (0x02CD1); + (0x02CD2,0x02CD2), `Abs (0x02CD3); + (0x02CD4,0x02CD4), `Abs (0x02CD5); + (0x02CD6,0x02CD6), `Abs (0x02CD7); + (0x02CD8,0x02CD8), `Abs (0x02CD9); + (0x02CDA,0x02CDA), `Abs (0x02CDB); + (0x02CDC,0x02CDC), `Abs (0x02CDD); + (0x02CDE,0x02CDE), `Abs (0x02CDF); + (0x02CE0,0x02CE0), `Abs (0x02CE1); + (0x02CE2,0x02CE2), `Abs (0x02CE3); + (0x02CEB,0x02CEB), `Abs (0x02CEC); + (0x02CED,0x02CED), `Abs (0x02CEE); + (0x02CF2,0x02CF2), `Abs (0x02CF3); + (0x0A640,0x0A640), `Abs (0x0A641); + (0x0A642,0x0A642), `Abs (0x0A643); + (0x0A644,0x0A644), `Abs (0x0A645); + (0x0A646,0x0A646), `Abs (0x0A647); + (0x0A648,0x0A648), `Abs (0x0A649); + (0x0A64A,0x0A64A), `Abs (0x0A64B); + (0x0A64C,0x0A64C), `Abs (0x0A64D); + (0x0A64E,0x0A64E), `Abs (0x0A64F); + (0x0A650,0x0A650), `Abs (0x0A651); + (0x0A652,0x0A652), `Abs (0x0A653); + (0x0A654,0x0A654), `Abs (0x0A655); + (0x0A656,0x0A656), `Abs (0x0A657); + (0x0A658,0x0A658), `Abs (0x0A659); + (0x0A65A,0x0A65A), `Abs (0x0A65B); + (0x0A65C,0x0A65C), `Abs (0x0A65D); + (0x0A65E,0x0A65E), `Abs (0x0A65F); + (0x0A660,0x0A660), `Abs (0x0A661); + (0x0A662,0x0A662), `Abs (0x0A663); + (0x0A664,0x0A664), `Abs (0x0A665); + (0x0A666,0x0A666), `Abs (0x0A667); + (0x0A668,0x0A668), `Abs (0x0A669); + (0x0A66A,0x0A66A), `Abs (0x0A66B); + (0x0A66C,0x0A66C), `Abs (0x0A66D); + (0x0A680,0x0A680), `Abs (0x0A681); + (0x0A682,0x0A682), `Abs (0x0A683); + (0x0A684,0x0A684), `Abs (0x0A685); + (0x0A686,0x0A686), `Abs (0x0A687); + (0x0A688,0x0A688), `Abs (0x0A689); + (0x0A68A,0x0A68A), `Abs (0x0A68B); + (0x0A68C,0x0A68C), `Abs (0x0A68D); + (0x0A68E,0x0A68E), `Abs (0x0A68F); + (0x0A690,0x0A690), `Abs (0x0A691); + (0x0A692,0x0A692), `Abs (0x0A693); + (0x0A694,0x0A694), `Abs (0x0A695); + (0x0A696,0x0A696), `Abs (0x0A697); + (0x0A698,0x0A698), `Abs (0x0A699); + (0x0A69A,0x0A69A), `Abs (0x0A69B); + (0x0A722,0x0A722), `Abs (0x0A723); + (0x0A724,0x0A724), `Abs (0x0A725); + (0x0A726,0x0A726), `Abs (0x0A727); + (0x0A728,0x0A728), `Abs (0x0A729); + (0x0A72A,0x0A72A), `Abs (0x0A72B); + (0x0A72C,0x0A72C), `Abs (0x0A72D); + (0x0A72E,0x0A72E), `Abs (0x0A72F); + (0x0A732,0x0A732), `Abs (0x0A733); + (0x0A734,0x0A734), `Abs (0x0A735); + (0x0A736,0x0A736), `Abs (0x0A737); + (0x0A738,0x0A738), `Abs (0x0A739); + (0x0A73A,0x0A73A), `Abs (0x0A73B); + (0x0A73C,0x0A73C), `Abs (0x0A73D); + (0x0A73E,0x0A73E), `Abs (0x0A73F); + (0x0A740,0x0A740), `Abs (0x0A741); + (0x0A742,0x0A742), `Abs (0x0A743); + (0x0A744,0x0A744), `Abs (0x0A745); + (0x0A746,0x0A746), `Abs (0x0A747); + (0x0A748,0x0A748), `Abs (0x0A749); + (0x0A74A,0x0A74A), `Abs (0x0A74B); + (0x0A74C,0x0A74C), `Abs (0x0A74D); + (0x0A74E,0x0A74E), `Abs (0x0A74F); + (0x0A750,0x0A750), `Abs (0x0A751); + (0x0A752,0x0A752), `Abs (0x0A753); + (0x0A754,0x0A754), `Abs (0x0A755); + (0x0A756,0x0A756), `Abs (0x0A757); + (0x0A758,0x0A758), `Abs (0x0A759); + (0x0A75A,0x0A75A), `Abs (0x0A75B); + (0x0A75C,0x0A75C), `Abs (0x0A75D); + (0x0A75E,0x0A75E), `Abs (0x0A75F); + (0x0A760,0x0A760), `Abs (0x0A761); + (0x0A762,0x0A762), `Abs (0x0A763); + (0x0A764,0x0A764), `Abs (0x0A765); + (0x0A766,0x0A766), `Abs (0x0A767); + (0x0A768,0x0A768), `Abs (0x0A769); + (0x0A76A,0x0A76A), `Abs (0x0A76B); + (0x0A76C,0x0A76C), `Abs (0x0A76D); + (0x0A76E,0x0A76E), `Abs (0x0A76F); + (0x0A779,0x0A779), `Abs (0x0A77A); + (0x0A77B,0x0A77B), `Abs (0x0A77C); + (0x0A77D,0x0A77D), `Abs (0x01D79); + (0x0A77E,0x0A77E), `Abs (0x0A77F); + (0x0A780,0x0A780), `Abs (0x0A781); + (0x0A782,0x0A782), `Abs (0x0A783); + (0x0A784,0x0A784), `Abs (0x0A785); + (0x0A786,0x0A786), `Abs (0x0A787); + (0x0A78B,0x0A78B), `Abs (0x0A78C); + (0x0A78D,0x0A78D), `Abs (0x00265); + (0x0A790,0x0A790), `Abs (0x0A791); + (0x0A792,0x0A792), `Abs (0x0A793); + (0x0A796,0x0A796), `Abs (0x0A797); + (0x0A798,0x0A798), `Abs (0x0A799); + (0x0A79A,0x0A79A), `Abs (0x0A79B); + (0x0A79C,0x0A79C), `Abs (0x0A79D); + (0x0A79E,0x0A79E), `Abs (0x0A79F); + (0x0A7A0,0x0A7A0), `Abs (0x0A7A1); + (0x0A7A2,0x0A7A2), `Abs (0x0A7A3); + (0x0A7A4,0x0A7A4), `Abs (0x0A7A5); + (0x0A7A6,0x0A7A6), `Abs (0x0A7A7); + (0x0A7A8,0x0A7A8), `Abs (0x0A7A9); + (0x0A7AA,0x0A7AA), `Abs (0x00266); + (0x0A7AB,0x0A7AB), `Abs (0x0025C); + (0x0A7AC,0x0A7AC), `Abs (0x00261); + (0x0A7AD,0x0A7AD), `Abs (0x0026C); + (0x0A7AE,0x0A7AE), `Abs (0x0026A); + (0x0A7B0,0x0A7B0), `Abs (0x0029E); + (0x0A7B1,0x0A7B1), `Abs (0x00287); + (0x0A7B2,0x0A7B2), `Abs (0x0029D); + (0x0A7B3,0x0A7B3), `Abs (0x0AB53); + (0x0A7B4,0x0A7B4), `Abs (0x0A7B5); + (0x0A7B6,0x0A7B6), `Abs (0x0A7B7); + (0x0FF21,0x0FF3A), `Delta (32); + (0x10400,0x10427), `Delta (40); + (0x104B0,0x104D3), `Delta (40); + (0x10C80,0x10CB2), `Delta (64); + (0x118A0,0x118BF), `Delta (32); + (0x1D400,0x1D419), `Delta (0); + (0x1D434,0x1D44D), `Delta (0); + (0x1D468,0x1D481), `Delta (0); + (0x1D49C,0x1D49C), `Abs (0x1D49C); + (0x1D49E,0x1D49F), `Delta (0); + (0x1D4A2,0x1D4A2), `Abs (0x1D4A2); + (0x1D4A5,0x1D4A6), `Delta (0); + (0x1D4A9,0x1D4AC), `Delta (0); + (0x1D4AE,0x1D4B5), `Delta (0); + (0x1D4D0,0x1D4E9), `Delta (0); + (0x1D504,0x1D505), `Delta (0); + (0x1D507,0x1D50A), `Delta (0); + (0x1D50D,0x1D514), `Delta (0); + (0x1D516,0x1D51C), `Delta (0); + (0x1D538,0x1D539), `Delta (0); + (0x1D53B,0x1D53E), `Delta (0); + (0x1D540,0x1D544), `Delta (0); + (0x1D546,0x1D546), `Abs (0x1D546); + (0x1D54A,0x1D550), `Delta (0); + (0x1D56C,0x1D585), `Delta (0); + (0x1D5A0,0x1D5B9), `Delta (0); + (0x1D5D4,0x1D5ED), `Delta (0); + (0x1D608,0x1D621), `Delta (0); + (0x1D63C,0x1D655), `Delta (0); + (0x1D670,0x1D689), `Delta (0); + (0x1D6A8,0x1D6C0), `Delta (0); + (0x1D6E2,0x1D6FA), `Delta (0); + (0x1D71C,0x1D734), `Delta (0); + (0x1D756,0x1D76E), `Delta (0); + (0x1D790,0x1D7A8), `Delta (0); + (0x1D7CA,0x1D7CA), `Abs (0x1D7CA); + (0x1E900,0x1E921), `Delta (34); + (0x00061,0x0007A), `Delta (0); + (0x000B5,0x000B5), `Abs (0x000B5); + (0x000DF,0x000F6), `Delta (0); + (0x000F8,0x000FF), `Delta (0); + (0x00101,0x00101), `Abs (0x00101); + (0x00103,0x00103), `Abs (0x00103); + (0x00105,0x00105), `Abs (0x00105); + (0x00107,0x00107), `Abs (0x00107); + (0x00109,0x00109), `Abs (0x00109); + (0x0010B,0x0010B), `Abs (0x0010B); + (0x0010D,0x0010D), `Abs (0x0010D); + (0x0010F,0x0010F), `Abs (0x0010F); + (0x00111,0x00111), `Abs (0x00111); + (0x00113,0x00113), `Abs (0x00113); + (0x00115,0x00115), `Abs (0x00115); + (0x00117,0x00117), `Abs (0x00117); + (0x00119,0x00119), `Abs (0x00119); + (0x0011B,0x0011B), `Abs (0x0011B); + (0x0011D,0x0011D), `Abs (0x0011D); + (0x0011F,0x0011F), `Abs (0x0011F); + (0x00121,0x00121), `Abs (0x00121); + (0x00123,0x00123), `Abs (0x00123); + (0x00125,0x00125), `Abs (0x00125); + (0x00127,0x00127), `Abs (0x00127); + (0x00129,0x00129), `Abs (0x00129); + (0x0012B,0x0012B), `Abs (0x0012B); + (0x0012D,0x0012D), `Abs (0x0012D); + (0x0012F,0x0012F), `Abs (0x0012F); + (0x00131,0x00131), `Abs (0x00131); + (0x00133,0x00133), `Abs (0x00133); + (0x00135,0x00135), `Abs (0x00135); + (0x00137,0x00138), `Delta (0); + (0x0013A,0x0013A), `Abs (0x0013A); + (0x0013C,0x0013C), `Abs (0x0013C); + (0x0013E,0x0013E), `Abs (0x0013E); + (0x00140,0x00140), `Abs (0x00140); + (0x00142,0x00142), `Abs (0x00142); + (0x00144,0x00144), `Abs (0x00144); + (0x00146,0x00146), `Abs (0x00146); + (0x00148,0x00149), `Delta (0); + (0x0014B,0x0014B), `Abs (0x0014B); + (0x0014D,0x0014D), `Abs (0x0014D); + (0x0014F,0x0014F), `Abs (0x0014F); + (0x00151,0x00151), `Abs (0x00151); + (0x00153,0x00153), `Abs (0x00153); + (0x00155,0x00155), `Abs (0x00155); + (0x00157,0x00157), `Abs (0x00157); + (0x00159,0x00159), `Abs (0x00159); + (0x0015B,0x0015B), `Abs (0x0015B); + (0x0015D,0x0015D), `Abs (0x0015D); + (0x0015F,0x0015F), `Abs (0x0015F); + (0x00161,0x00161), `Abs (0x00161); + (0x00163,0x00163), `Abs (0x00163); + (0x00165,0x00165), `Abs (0x00165); + (0x00167,0x00167), `Abs (0x00167); + (0x00169,0x00169), `Abs (0x00169); + (0x0016B,0x0016B), `Abs (0x0016B); + (0x0016D,0x0016D), `Abs (0x0016D); + (0x0016F,0x0016F), `Abs (0x0016F); + (0x00171,0x00171), `Abs (0x00171); + (0x00173,0x00173), `Abs (0x00173); + (0x00175,0x00175), `Abs (0x00175); + (0x00177,0x00177), `Abs (0x00177); + (0x0017A,0x0017A), `Abs (0x0017A); + (0x0017C,0x0017C), `Abs (0x0017C); + (0x0017E,0x00180), `Delta (0); + (0x00183,0x00183), `Abs (0x00183); + (0x00185,0x00185), `Abs (0x00185); + (0x00188,0x00188), `Abs (0x00188); + (0x0018C,0x0018D), `Delta (0); + (0x00192,0x00192), `Abs (0x00192); + (0x00195,0x00195), `Abs (0x00195); + (0x00199,0x0019B), `Delta (0); + (0x0019E,0x0019E), `Abs (0x0019E); + (0x001A1,0x001A1), `Abs (0x001A1); + (0x001A3,0x001A3), `Abs (0x001A3); + (0x001A5,0x001A5), `Abs (0x001A5); + (0x001A8,0x001A8), `Abs (0x001A8); + (0x001AA,0x001AB), `Delta (0); + (0x001AD,0x001AD), `Abs (0x001AD); + (0x001B0,0x001B0), `Abs (0x001B0); + (0x001B4,0x001B4), `Abs (0x001B4); + (0x001B6,0x001B6), `Abs (0x001B6); + (0x001B9,0x001BA), `Delta (0); + (0x001BD,0x001BF), `Delta (0); + (0x001C6,0x001C6), `Abs (0x001C6); + (0x001C9,0x001C9), `Abs (0x001C9); + (0x001CC,0x001CC), `Abs (0x001CC); + (0x001CE,0x001CE), `Abs (0x001CE); + (0x001D0,0x001D0), `Abs (0x001D0); + (0x001D2,0x001D2), `Abs (0x001D2); + (0x001D4,0x001D4), `Abs (0x001D4); + (0x001D6,0x001D6), `Abs (0x001D6); + (0x001D8,0x001D8), `Abs (0x001D8); + (0x001DA,0x001DA), `Abs (0x001DA); + (0x001DC,0x001DD), `Delta (0); + (0x001DF,0x001DF), `Abs (0x001DF); + (0x001E1,0x001E1), `Abs (0x001E1); + (0x001E3,0x001E3), `Abs (0x001E3); + (0x001E5,0x001E5), `Abs (0x001E5); + (0x001E7,0x001E7), `Abs (0x001E7); + (0x001E9,0x001E9), `Abs (0x001E9); + (0x001EB,0x001EB), `Abs (0x001EB); + (0x001ED,0x001ED), `Abs (0x001ED); + (0x001EF,0x001F0), `Delta (0); + (0x001F3,0x001F3), `Abs (0x001F3); + (0x001F5,0x001F5), `Abs (0x001F5); + (0x001F9,0x001F9), `Abs (0x001F9); + (0x001FB,0x001FB), `Abs (0x001FB); + (0x001FD,0x001FD), `Abs (0x001FD); + (0x001FF,0x001FF), `Abs (0x001FF); + (0x00201,0x00201), `Abs (0x00201); + (0x00203,0x00203), `Abs (0x00203); + (0x00205,0x00205), `Abs (0x00205); + (0x00207,0x00207), `Abs (0x00207); + (0x00209,0x00209), `Abs (0x00209); + (0x0020B,0x0020B), `Abs (0x0020B); + (0x0020D,0x0020D), `Abs (0x0020D); + (0x0020F,0x0020F), `Abs (0x0020F); + (0x00211,0x00211), `Abs (0x00211); + (0x00213,0x00213), `Abs (0x00213); + (0x00215,0x00215), `Abs (0x00215); + (0x00217,0x00217), `Abs (0x00217); + (0x00219,0x00219), `Abs (0x00219); + (0x0021B,0x0021B), `Abs (0x0021B); + (0x0021D,0x0021D), `Abs (0x0021D); + (0x0021F,0x0021F), `Abs (0x0021F); + (0x00221,0x00221), `Abs (0x00221); + (0x00223,0x00223), `Abs (0x00223); + (0x00225,0x00225), `Abs (0x00225); + (0x00227,0x00227), `Abs (0x00227); + (0x00229,0x00229), `Abs (0x00229); + (0x0022B,0x0022B), `Abs (0x0022B); + (0x0022D,0x0022D), `Abs (0x0022D); + (0x0022F,0x0022F), `Abs (0x0022F); + (0x00231,0x00231), `Abs (0x00231); + (0x00233,0x00239), `Delta (0); + (0x0023C,0x0023C), `Abs (0x0023C); + (0x0023F,0x00240), `Delta (0); + (0x00242,0x00242), `Abs (0x00242); + (0x00247,0x00247), `Abs (0x00247); + (0x00249,0x00249), `Abs (0x00249); + (0x0024B,0x0024B), `Abs (0x0024B); + (0x0024D,0x0024D), `Abs (0x0024D); + (0x0024F,0x00293), `Delta (0); + (0x00295,0x002AF), `Delta (0); + (0x00371,0x00371), `Abs (0x00371); + (0x00373,0x00373), `Abs (0x00373); + (0x00377,0x00377), `Abs (0x00377); + (0x0037B,0x0037D), `Delta (0); + (0x00390,0x00390), `Abs (0x00390); + (0x003AC,0x003CE), `Delta (0); + (0x003D0,0x003D1), `Delta (0); + (0x003D5,0x003D7), `Delta (0); + (0x003D9,0x003D9), `Abs (0x003D9); + (0x003DB,0x003DB), `Abs (0x003DB); + (0x003DD,0x003DD), `Abs (0x003DD); + (0x003DF,0x003DF), `Abs (0x003DF); + (0x003E1,0x003E1), `Abs (0x003E1); + (0x003E3,0x003E3), `Abs (0x003E3); + (0x003E5,0x003E5), `Abs (0x003E5); + (0x003E7,0x003E7), `Abs (0x003E7); + (0x003E9,0x003E9), `Abs (0x003E9); + (0x003EB,0x003EB), `Abs (0x003EB); + (0x003ED,0x003ED), `Abs (0x003ED); + (0x003EF,0x003F3), `Delta (0); + (0x003F5,0x003F5), `Abs (0x003F5); + (0x003F8,0x003F8), `Abs (0x003F8); + (0x003FB,0x003FC), `Delta (0); + (0x00430,0x0045F), `Delta (0); + (0x00461,0x00461), `Abs (0x00461); + (0x00463,0x00463), `Abs (0x00463); + (0x00465,0x00465), `Abs (0x00465); + (0x00467,0x00467), `Abs (0x00467); + (0x00469,0x00469), `Abs (0x00469); + (0x0046B,0x0046B), `Abs (0x0046B); + (0x0046D,0x0046D), `Abs (0x0046D); + (0x0046F,0x0046F), `Abs (0x0046F); + (0x00471,0x00471), `Abs (0x00471); + (0x00473,0x00473), `Abs (0x00473); + (0x00475,0x00475), `Abs (0x00475); + (0x00477,0x00477), `Abs (0x00477); + (0x00479,0x00479), `Abs (0x00479); + (0x0047B,0x0047B), `Abs (0x0047B); + (0x0047D,0x0047D), `Abs (0x0047D); + (0x0047F,0x0047F), `Abs (0x0047F); + (0x00481,0x00481), `Abs (0x00481); + (0x0048B,0x0048B), `Abs (0x0048B); + (0x0048D,0x0048D), `Abs (0x0048D); + (0x0048F,0x0048F), `Abs (0x0048F); + (0x00491,0x00491), `Abs (0x00491); + (0x00493,0x00493), `Abs (0x00493); + (0x00495,0x00495), `Abs (0x00495); + (0x00497,0x00497), `Abs (0x00497); + (0x00499,0x00499), `Abs (0x00499); + (0x0049B,0x0049B), `Abs (0x0049B); + (0x0049D,0x0049D), `Abs (0x0049D); + (0x0049F,0x0049F), `Abs (0x0049F); + (0x004A1,0x004A1), `Abs (0x004A1); + (0x004A3,0x004A3), `Abs (0x004A3); + (0x004A5,0x004A5), `Abs (0x004A5); + (0x004A7,0x004A7), `Abs (0x004A7); + (0x004A9,0x004A9), `Abs (0x004A9); + (0x004AB,0x004AB), `Abs (0x004AB); + (0x004AD,0x004AD), `Abs (0x004AD); + (0x004AF,0x004AF), `Abs (0x004AF); + (0x004B1,0x004B1), `Abs (0x004B1); + (0x004B3,0x004B3), `Abs (0x004B3); + (0x004B5,0x004B5), `Abs (0x004B5); + (0x004B7,0x004B7), `Abs (0x004B7); + (0x004B9,0x004B9), `Abs (0x004B9); + (0x004BB,0x004BB), `Abs (0x004BB); + (0x004BD,0x004BD), `Abs (0x004BD); + (0x004BF,0x004BF), `Abs (0x004BF); + (0x004C2,0x004C2), `Abs (0x004C2); + (0x004C4,0x004C4), `Abs (0x004C4); + (0x004C6,0x004C6), `Abs (0x004C6); + (0x004C8,0x004C8), `Abs (0x004C8); + (0x004CA,0x004CA), `Abs (0x004CA); + (0x004CC,0x004CC), `Abs (0x004CC); + (0x004CE,0x004CF), `Delta (0); + (0x004D1,0x004D1), `Abs (0x004D1); + (0x004D3,0x004D3), `Abs (0x004D3); + (0x004D5,0x004D5), `Abs (0x004D5); + (0x004D7,0x004D7), `Abs (0x004D7); + (0x004D9,0x004D9), `Abs (0x004D9); + (0x004DB,0x004DB), `Abs (0x004DB); + (0x004DD,0x004DD), `Abs (0x004DD); + (0x004DF,0x004DF), `Abs (0x004DF); + (0x004E1,0x004E1), `Abs (0x004E1); + (0x004E3,0x004E3), `Abs (0x004E3); + (0x004E5,0x004E5), `Abs (0x004E5); + (0x004E7,0x004E7), `Abs (0x004E7); + (0x004E9,0x004E9), `Abs (0x004E9); + (0x004EB,0x004EB), `Abs (0x004EB); + (0x004ED,0x004ED), `Abs (0x004ED); + (0x004EF,0x004EF), `Abs (0x004EF); + (0x004F1,0x004F1), `Abs (0x004F1); + (0x004F3,0x004F3), `Abs (0x004F3); + (0x004F5,0x004F5), `Abs (0x004F5); + (0x004F7,0x004F7), `Abs (0x004F7); + (0x004F9,0x004F9), `Abs (0x004F9); + (0x004FB,0x004FB), `Abs (0x004FB); + (0x004FD,0x004FD), `Abs (0x004FD); + (0x004FF,0x004FF), `Abs (0x004FF); + (0x00501,0x00501), `Abs (0x00501); + (0x00503,0x00503), `Abs (0x00503); + (0x00505,0x00505), `Abs (0x00505); + (0x00507,0x00507), `Abs (0x00507); + (0x00509,0x00509), `Abs (0x00509); + (0x0050B,0x0050B), `Abs (0x0050B); + (0x0050D,0x0050D), `Abs (0x0050D); + (0x0050F,0x0050F), `Abs (0x0050F); + (0x00511,0x00511), `Abs (0x00511); + (0x00513,0x00513), `Abs (0x00513); + (0x00515,0x00515), `Abs (0x00515); + (0x00517,0x00517), `Abs (0x00517); + (0x00519,0x00519), `Abs (0x00519); + (0x0051B,0x0051B), `Abs (0x0051B); + (0x0051D,0x0051D), `Abs (0x0051D); + (0x0051F,0x0051F), `Abs (0x0051F); + (0x00521,0x00521), `Abs (0x00521); + (0x00523,0x00523), `Abs (0x00523); + (0x00525,0x00525), `Abs (0x00525); + (0x00527,0x00527), `Abs (0x00527); + (0x00529,0x00529), `Abs (0x00529); + (0x0052B,0x0052B), `Abs (0x0052B); + (0x0052D,0x0052D), `Abs (0x0052D); + (0x0052F,0x0052F), `Abs (0x0052F); + (0x00561,0x00587), `Delta (0); + (0x013F8,0x013FD), `Delta (0); + (0x01C80,0x01C88), `Delta (0); + (0x01D00,0x01D2B), `Delta (0); + (0x01D6B,0x01D77), `Delta (0); + (0x01D79,0x01D9A), `Delta (0); + (0x01E01,0x01E01), `Abs (0x01E01); + (0x01E03,0x01E03), `Abs (0x01E03); + (0x01E05,0x01E05), `Abs (0x01E05); + (0x01E07,0x01E07), `Abs (0x01E07); + (0x01E09,0x01E09), `Abs (0x01E09); + (0x01E0B,0x01E0B), `Abs (0x01E0B); + (0x01E0D,0x01E0D), `Abs (0x01E0D); + (0x01E0F,0x01E0F), `Abs (0x01E0F); + (0x01E11,0x01E11), `Abs (0x01E11); + (0x01E13,0x01E13), `Abs (0x01E13); + (0x01E15,0x01E15), `Abs (0x01E15); + (0x01E17,0x01E17), `Abs (0x01E17); + (0x01E19,0x01E19), `Abs (0x01E19); + (0x01E1B,0x01E1B), `Abs (0x01E1B); + (0x01E1D,0x01E1D), `Abs (0x01E1D); + (0x01E1F,0x01E1F), `Abs (0x01E1F); + (0x01E21,0x01E21), `Abs (0x01E21); + (0x01E23,0x01E23), `Abs (0x01E23); + (0x01E25,0x01E25), `Abs (0x01E25); + (0x01E27,0x01E27), `Abs (0x01E27); + (0x01E29,0x01E29), `Abs (0x01E29); + (0x01E2B,0x01E2B), `Abs (0x01E2B); + (0x01E2D,0x01E2D), `Abs (0x01E2D); + (0x01E2F,0x01E2F), `Abs (0x01E2F); + (0x01E31,0x01E31), `Abs (0x01E31); + (0x01E33,0x01E33), `Abs (0x01E33); + (0x01E35,0x01E35), `Abs (0x01E35); + (0x01E37,0x01E37), `Abs (0x01E37); + (0x01E39,0x01E39), `Abs (0x01E39); + (0x01E3B,0x01E3B), `Abs (0x01E3B); + (0x01E3D,0x01E3D), `Abs (0x01E3D); + (0x01E3F,0x01E3F), `Abs (0x01E3F); + (0x01E41,0x01E41), `Abs (0x01E41); + (0x01E43,0x01E43), `Abs (0x01E43); + (0x01E45,0x01E45), `Abs (0x01E45); + (0x01E47,0x01E47), `Abs (0x01E47); + (0x01E49,0x01E49), `Abs (0x01E49); + (0x01E4B,0x01E4B), `Abs (0x01E4B); + (0x01E4D,0x01E4D), `Abs (0x01E4D); + (0x01E4F,0x01E4F), `Abs (0x01E4F); + (0x01E51,0x01E51), `Abs (0x01E51); + (0x01E53,0x01E53), `Abs (0x01E53); + (0x01E55,0x01E55), `Abs (0x01E55); + (0x01E57,0x01E57), `Abs (0x01E57); + (0x01E59,0x01E59), `Abs (0x01E59); + (0x01E5B,0x01E5B), `Abs (0x01E5B); + (0x01E5D,0x01E5D), `Abs (0x01E5D); + (0x01E5F,0x01E5F), `Abs (0x01E5F); + (0x01E61,0x01E61), `Abs (0x01E61); + (0x01E63,0x01E63), `Abs (0x01E63); + (0x01E65,0x01E65), `Abs (0x01E65); + (0x01E67,0x01E67), `Abs (0x01E67); + (0x01E69,0x01E69), `Abs (0x01E69); + (0x01E6B,0x01E6B), `Abs (0x01E6B); + (0x01E6D,0x01E6D), `Abs (0x01E6D); + (0x01E6F,0x01E6F), `Abs (0x01E6F); + (0x01E71,0x01E71), `Abs (0x01E71); + (0x01E73,0x01E73), `Abs (0x01E73); + (0x01E75,0x01E75), `Abs (0x01E75); + (0x01E77,0x01E77), `Abs (0x01E77); + (0x01E79,0x01E79), `Abs (0x01E79); + (0x01E7B,0x01E7B), `Abs (0x01E7B); + (0x01E7D,0x01E7D), `Abs (0x01E7D); + (0x01E7F,0x01E7F), `Abs (0x01E7F); + (0x01E81,0x01E81), `Abs (0x01E81); + (0x01E83,0x01E83), `Abs (0x01E83); + (0x01E85,0x01E85), `Abs (0x01E85); + (0x01E87,0x01E87), `Abs (0x01E87); + (0x01E89,0x01E89), `Abs (0x01E89); + (0x01E8B,0x01E8B), `Abs (0x01E8B); + (0x01E8D,0x01E8D), `Abs (0x01E8D); + (0x01E8F,0x01E8F), `Abs (0x01E8F); + (0x01E91,0x01E91), `Abs (0x01E91); + (0x01E93,0x01E93), `Abs (0x01E93); + (0x01E95,0x01E9D), `Delta (0); + (0x01E9F,0x01E9F), `Abs (0x01E9F); + (0x01EA1,0x01EA1), `Abs (0x01EA1); + (0x01EA3,0x01EA3), `Abs (0x01EA3); + (0x01EA5,0x01EA5), `Abs (0x01EA5); + (0x01EA7,0x01EA7), `Abs (0x01EA7); + (0x01EA9,0x01EA9), `Abs (0x01EA9); + (0x01EAB,0x01EAB), `Abs (0x01EAB); + (0x01EAD,0x01EAD), `Abs (0x01EAD); + (0x01EAF,0x01EAF), `Abs (0x01EAF); + (0x01EB1,0x01EB1), `Abs (0x01EB1); + (0x01EB3,0x01EB3), `Abs (0x01EB3); + (0x01EB5,0x01EB5), `Abs (0x01EB5); + (0x01EB7,0x01EB7), `Abs (0x01EB7); + (0x01EB9,0x01EB9), `Abs (0x01EB9); + (0x01EBB,0x01EBB), `Abs (0x01EBB); + (0x01EBD,0x01EBD), `Abs (0x01EBD); + (0x01EBF,0x01EBF), `Abs (0x01EBF); + (0x01EC1,0x01EC1), `Abs (0x01EC1); + (0x01EC3,0x01EC3), `Abs (0x01EC3); + (0x01EC5,0x01EC5), `Abs (0x01EC5); + (0x01EC7,0x01EC7), `Abs (0x01EC7); + (0x01EC9,0x01EC9), `Abs (0x01EC9); + (0x01ECB,0x01ECB), `Abs (0x01ECB); + (0x01ECD,0x01ECD), `Abs (0x01ECD); + (0x01ECF,0x01ECF), `Abs (0x01ECF); + (0x01ED1,0x01ED1), `Abs (0x01ED1); + (0x01ED3,0x01ED3), `Abs (0x01ED3); + (0x01ED5,0x01ED5), `Abs (0x01ED5); + (0x01ED7,0x01ED7), `Abs (0x01ED7); + (0x01ED9,0x01ED9), `Abs (0x01ED9); + (0x01EDB,0x01EDB), `Abs (0x01EDB); + (0x01EDD,0x01EDD), `Abs (0x01EDD); + (0x01EDF,0x01EDF), `Abs (0x01EDF); + (0x01EE1,0x01EE1), `Abs (0x01EE1); + (0x01EE3,0x01EE3), `Abs (0x01EE3); + (0x01EE5,0x01EE5), `Abs (0x01EE5); + (0x01EE7,0x01EE7), `Abs (0x01EE7); + (0x01EE9,0x01EE9), `Abs (0x01EE9); + (0x01EEB,0x01EEB), `Abs (0x01EEB); + (0x01EED,0x01EED), `Abs (0x01EED); + (0x01EEF,0x01EEF), `Abs (0x01EEF); + (0x01EF1,0x01EF1), `Abs (0x01EF1); + (0x01EF3,0x01EF3), `Abs (0x01EF3); + (0x01EF5,0x01EF5), `Abs (0x01EF5); + (0x01EF7,0x01EF7), `Abs (0x01EF7); + (0x01EF9,0x01EF9), `Abs (0x01EF9); + (0x01EFB,0x01EFB), `Abs (0x01EFB); + (0x01EFD,0x01EFD), `Abs (0x01EFD); + (0x01EFF,0x01F07), `Delta (0); + (0x01F10,0x01F15), `Delta (0); + (0x01F20,0x01F27), `Delta (0); + (0x01F30,0x01F37), `Delta (0); + (0x01F40,0x01F45), `Delta (0); + (0x01F50,0x01F57), `Delta (0); + (0x01F60,0x01F67), `Delta (0); + (0x01F70,0x01F7D), `Delta (0); + (0x01F80,0x01F87), `Delta (0); + (0x01F90,0x01F97), `Delta (0); + (0x01FA0,0x01FA7), `Delta (0); + (0x01FB0,0x01FB4), `Delta (0); + (0x01FB6,0x01FB7), `Delta (0); + (0x01FBE,0x01FBE), `Abs (0x01FBE); + (0x01FC2,0x01FC4), `Delta (0); + (0x01FC6,0x01FC7), `Delta (0); + (0x01FD0,0x01FD3), `Delta (0); + (0x01FD6,0x01FD7), `Delta (0); + (0x01FE0,0x01FE7), `Delta (0); + (0x01FF2,0x01FF4), `Delta (0); + (0x01FF6,0x01FF7), `Delta (0); + (0x0210A,0x0210A), `Abs (0x0210A); + (0x0210E,0x0210F), `Delta (0); + (0x02113,0x02113), `Abs (0x02113); + (0x0212F,0x0212F), `Abs (0x0212F); + (0x02134,0x02134), `Abs (0x02134); + (0x02139,0x02139), `Abs (0x02139); + (0x0213C,0x0213D), `Delta (0); + (0x02146,0x02149), `Delta (0); + (0x0214E,0x0214E), `Abs (0x0214E); + (0x02184,0x02184), `Abs (0x02184); + (0x02C30,0x02C5E), `Delta (0); + (0x02C61,0x02C61), `Abs (0x02C61); + (0x02C65,0x02C66), `Delta (0); + (0x02C68,0x02C68), `Abs (0x02C68); + (0x02C6A,0x02C6A), `Abs (0x02C6A); + (0x02C6C,0x02C6C), `Abs (0x02C6C); + (0x02C71,0x02C71), `Abs (0x02C71); + (0x02C73,0x02C74), `Delta (0); + (0x02C76,0x02C7B), `Delta (0); + (0x02C81,0x02C81), `Abs (0x02C81); + (0x02C83,0x02C83), `Abs (0x02C83); + (0x02C85,0x02C85), `Abs (0x02C85); + (0x02C87,0x02C87), `Abs (0x02C87); + (0x02C89,0x02C89), `Abs (0x02C89); + (0x02C8B,0x02C8B), `Abs (0x02C8B); + (0x02C8D,0x02C8D), `Abs (0x02C8D); + (0x02C8F,0x02C8F), `Abs (0x02C8F); + (0x02C91,0x02C91), `Abs (0x02C91); + (0x02C93,0x02C93), `Abs (0x02C93); + (0x02C95,0x02C95), `Abs (0x02C95); + (0x02C97,0x02C97), `Abs (0x02C97); + (0x02C99,0x02C99), `Abs (0x02C99); + (0x02C9B,0x02C9B), `Abs (0x02C9B); + (0x02C9D,0x02C9D), `Abs (0x02C9D); + (0x02C9F,0x02C9F), `Abs (0x02C9F); + (0x02CA1,0x02CA1), `Abs (0x02CA1); + (0x02CA3,0x02CA3), `Abs (0x02CA3); + (0x02CA5,0x02CA5), `Abs (0x02CA5); + (0x02CA7,0x02CA7), `Abs (0x02CA7); + (0x02CA9,0x02CA9), `Abs (0x02CA9); + (0x02CAB,0x02CAB), `Abs (0x02CAB); + (0x02CAD,0x02CAD), `Abs (0x02CAD); + (0x02CAF,0x02CAF), `Abs (0x02CAF); + (0x02CB1,0x02CB1), `Abs (0x02CB1); + (0x02CB3,0x02CB3), `Abs (0x02CB3); + (0x02CB5,0x02CB5), `Abs (0x02CB5); + (0x02CB7,0x02CB7), `Abs (0x02CB7); + (0x02CB9,0x02CB9), `Abs (0x02CB9); + (0x02CBB,0x02CBB), `Abs (0x02CBB); + (0x02CBD,0x02CBD), `Abs (0x02CBD); + (0x02CBF,0x02CBF), `Abs (0x02CBF); + (0x02CC1,0x02CC1), `Abs (0x02CC1); + (0x02CC3,0x02CC3), `Abs (0x02CC3); + (0x02CC5,0x02CC5), `Abs (0x02CC5); + (0x02CC7,0x02CC7), `Abs (0x02CC7); + (0x02CC9,0x02CC9), `Abs (0x02CC9); + (0x02CCB,0x02CCB), `Abs (0x02CCB); + (0x02CCD,0x02CCD), `Abs (0x02CCD); + (0x02CCF,0x02CCF), `Abs (0x02CCF); + (0x02CD1,0x02CD1), `Abs (0x02CD1); + (0x02CD3,0x02CD3), `Abs (0x02CD3); + (0x02CD5,0x02CD5), `Abs (0x02CD5); + (0x02CD7,0x02CD7), `Abs (0x02CD7); + (0x02CD9,0x02CD9), `Abs (0x02CD9); + (0x02CDB,0x02CDB), `Abs (0x02CDB); + (0x02CDD,0x02CDD), `Abs (0x02CDD); + (0x02CDF,0x02CDF), `Abs (0x02CDF); + (0x02CE1,0x02CE1), `Abs (0x02CE1); + (0x02CE3,0x02CE4), `Delta (0); + (0x02CEC,0x02CEC), `Abs (0x02CEC); + (0x02CEE,0x02CEE), `Abs (0x02CEE); + (0x02CF3,0x02CF3), `Abs (0x02CF3); + (0x02D00,0x02D25), `Delta (0); + (0x02D27,0x02D27), `Abs (0x02D27); + (0x02D2D,0x02D2D), `Abs (0x02D2D); + (0x0A641,0x0A641), `Abs (0x0A641); + (0x0A643,0x0A643), `Abs (0x0A643); + (0x0A645,0x0A645), `Abs (0x0A645); + (0x0A647,0x0A647), `Abs (0x0A647); + (0x0A649,0x0A649), `Abs (0x0A649); + (0x0A64B,0x0A64B), `Abs (0x0A64B); + (0x0A64D,0x0A64D), `Abs (0x0A64D); + (0x0A64F,0x0A64F), `Abs (0x0A64F); + (0x0A651,0x0A651), `Abs (0x0A651); + (0x0A653,0x0A653), `Abs (0x0A653); + (0x0A655,0x0A655), `Abs (0x0A655); + (0x0A657,0x0A657), `Abs (0x0A657); + (0x0A659,0x0A659), `Abs (0x0A659); + (0x0A65B,0x0A65B), `Abs (0x0A65B); + (0x0A65D,0x0A65D), `Abs (0x0A65D); + (0x0A65F,0x0A65F), `Abs (0x0A65F); + (0x0A661,0x0A661), `Abs (0x0A661); + (0x0A663,0x0A663), `Abs (0x0A663); + (0x0A665,0x0A665), `Abs (0x0A665); + (0x0A667,0x0A667), `Abs (0x0A667); + (0x0A669,0x0A669), `Abs (0x0A669); + (0x0A66B,0x0A66B), `Abs (0x0A66B); + (0x0A66D,0x0A66D), `Abs (0x0A66D); + (0x0A681,0x0A681), `Abs (0x0A681); + (0x0A683,0x0A683), `Abs (0x0A683); + (0x0A685,0x0A685), `Abs (0x0A685); + (0x0A687,0x0A687), `Abs (0x0A687); + (0x0A689,0x0A689), `Abs (0x0A689); + (0x0A68B,0x0A68B), `Abs (0x0A68B); + (0x0A68D,0x0A68D), `Abs (0x0A68D); + (0x0A68F,0x0A68F), `Abs (0x0A68F); + (0x0A691,0x0A691), `Abs (0x0A691); + (0x0A693,0x0A693), `Abs (0x0A693); + (0x0A695,0x0A695), `Abs (0x0A695); + (0x0A697,0x0A697), `Abs (0x0A697); + (0x0A699,0x0A699), `Abs (0x0A699); + (0x0A69B,0x0A69B), `Abs (0x0A69B); + (0x0A723,0x0A723), `Abs (0x0A723); + (0x0A725,0x0A725), `Abs (0x0A725); + (0x0A727,0x0A727), `Abs (0x0A727); + (0x0A729,0x0A729), `Abs (0x0A729); + (0x0A72B,0x0A72B), `Abs (0x0A72B); + (0x0A72D,0x0A72D), `Abs (0x0A72D); + (0x0A72F,0x0A731), `Delta (0); + (0x0A733,0x0A733), `Abs (0x0A733); + (0x0A735,0x0A735), `Abs (0x0A735); + (0x0A737,0x0A737), `Abs (0x0A737); + (0x0A739,0x0A739), `Abs (0x0A739); + (0x0A73B,0x0A73B), `Abs (0x0A73B); + (0x0A73D,0x0A73D), `Abs (0x0A73D); + (0x0A73F,0x0A73F), `Abs (0x0A73F); + (0x0A741,0x0A741), `Abs (0x0A741); + (0x0A743,0x0A743), `Abs (0x0A743); + (0x0A745,0x0A745), `Abs (0x0A745); + (0x0A747,0x0A747), `Abs (0x0A747); + (0x0A749,0x0A749), `Abs (0x0A749); + (0x0A74B,0x0A74B), `Abs (0x0A74B); + (0x0A74D,0x0A74D), `Abs (0x0A74D); + (0x0A74F,0x0A74F), `Abs (0x0A74F); + (0x0A751,0x0A751), `Abs (0x0A751); + (0x0A753,0x0A753), `Abs (0x0A753); + (0x0A755,0x0A755), `Abs (0x0A755); + (0x0A757,0x0A757), `Abs (0x0A757); + (0x0A759,0x0A759), `Abs (0x0A759); + (0x0A75B,0x0A75B), `Abs (0x0A75B); + (0x0A75D,0x0A75D), `Abs (0x0A75D); + (0x0A75F,0x0A75F), `Abs (0x0A75F); + (0x0A761,0x0A761), `Abs (0x0A761); + (0x0A763,0x0A763), `Abs (0x0A763); + (0x0A765,0x0A765), `Abs (0x0A765); + (0x0A767,0x0A767), `Abs (0x0A767); + (0x0A769,0x0A769), `Abs (0x0A769); + (0x0A76B,0x0A76B), `Abs (0x0A76B); + (0x0A76D,0x0A76D), `Abs (0x0A76D); + (0x0A76F,0x0A76F), `Abs (0x0A76F); + (0x0A771,0x0A778), `Delta (0); + (0x0A77A,0x0A77A), `Abs (0x0A77A); + (0x0A77C,0x0A77C), `Abs (0x0A77C); + (0x0A77F,0x0A77F), `Abs (0x0A77F); + (0x0A781,0x0A781), `Abs (0x0A781); + (0x0A783,0x0A783), `Abs (0x0A783); + (0x0A785,0x0A785), `Abs (0x0A785); + (0x0A787,0x0A787), `Abs (0x0A787); + (0x0A78C,0x0A78C), `Abs (0x0A78C); + (0x0A78E,0x0A78E), `Abs (0x0A78E); + (0x0A791,0x0A791), `Abs (0x0A791); + (0x0A793,0x0A795), `Delta (0); + (0x0A797,0x0A797), `Abs (0x0A797); + (0x0A799,0x0A799), `Abs (0x0A799); + (0x0A79B,0x0A79B), `Abs (0x0A79B); + (0x0A79D,0x0A79D), `Abs (0x0A79D); + (0x0A79F,0x0A79F), `Abs (0x0A79F); + (0x0A7A1,0x0A7A1), `Abs (0x0A7A1); + (0x0A7A3,0x0A7A3), `Abs (0x0A7A3); + (0x0A7A5,0x0A7A5), `Abs (0x0A7A5); + (0x0A7A7,0x0A7A7), `Abs (0x0A7A7); + (0x0A7A9,0x0A7A9), `Abs (0x0A7A9); + (0x0A7B5,0x0A7B5), `Abs (0x0A7B5); + (0x0A7B7,0x0A7B7), `Abs (0x0A7B7); + (0x0A7FA,0x0A7FA), `Abs (0x0A7FA); + (0x0AB30,0x0AB5A), `Delta (0); + (0x0AB60,0x0AB65), `Delta (0); + (0x0AB70,0x0ABBF), `Delta (0); + (0x0FB00,0x0FB06), `Delta (0); + (0x0FB13,0x0FB17), `Delta (0); + (0x0FF41,0x0FF5A), `Delta (0); + (0x10428,0x1044F), `Delta (0); + (0x104D8,0x104FB), `Delta (0); + (0x10CC0,0x10CF2), `Delta (0); + (0x118C0,0x118DF), `Delta (0); + (0x1D41A,0x1D433), `Delta (0); + (0x1D44E,0x1D454), `Delta (0); + (0x1D456,0x1D467), `Delta (0); + (0x1D482,0x1D49B), `Delta (0); + (0x1D4B6,0x1D4B9), `Delta (0); + (0x1D4BB,0x1D4BB), `Abs (0x1D4BB); + (0x1D4BD,0x1D4C3), `Delta (0); + (0x1D4C5,0x1D4CF), `Delta (0); + (0x1D4EA,0x1D503), `Delta (0); + (0x1D51E,0x1D537), `Delta (0); + (0x1D552,0x1D56B), `Delta (0); + (0x1D586,0x1D59F), `Delta (0); + (0x1D5BA,0x1D5D3), `Delta (0); + (0x1D5EE,0x1D607), `Delta (0); + (0x1D622,0x1D63B), `Delta (0); + (0x1D656,0x1D66F), `Delta (0); + (0x1D68A,0x1D6A5), `Delta (0); + (0x1D6C2,0x1D6DA), `Delta (0); + (0x1D6DC,0x1D6E1), `Delta (0); + (0x1D6FC,0x1D714), `Delta (0); + (0x1D716,0x1D71B), `Delta (0); + (0x1D736,0x1D74E), `Delta (0); + (0x1D750,0x1D755), `Delta (0); + (0x1D770,0x1D788), `Delta (0); + (0x1D78A,0x1D78F), `Delta (0); + (0x1D7AA,0x1D7C2), `Delta (0); + (0x1D7C4,0x1D7C9), `Delta (0); + (0x1D7CB,0x1D7CB), `Abs (0x1D7CB); + (0x1E922,0x1E943), `Delta (0); + (0x001C5,0x001C5), `Abs (0x001C6); + (0x001C8,0x001C8), `Abs (0x001C9); + (0x001CB,0x001CB), `Abs (0x001CC); + (0x001F2,0x001F2), `Abs (0x001F3); + (0x01F88,0x01F8F), `Delta (-8); + (0x01F98,0x01F9F), `Delta (-8); + (0x01FA8,0x01FAF), `Delta (-8); + (0x01FBC,0x01FBC), `Abs (0x01FB3); + (0x01FCC,0x01FCC), `Abs (0x01FC3); + (0x01FFC,0x01FFC), `Abs (0x01FF3); + (0x00300,0x0036F), `Delta (0); + (0x00483,0x00487), `Delta (0); + (0x00591,0x005BD), `Delta (0); + (0x005BF,0x005BF), `Abs (0x005BF); + (0x005C1,0x005C2), `Delta (0); + (0x005C4,0x005C5), `Delta (0); + (0x005C7,0x005C7), `Abs (0x005C7); + (0x00610,0x0061A), `Delta (0); + (0x0064B,0x0065F), `Delta (0); + (0x00670,0x00670), `Abs (0x00670); + (0x006D6,0x006DC), `Delta (0); + (0x006DF,0x006E4), `Delta (0); + (0x006E7,0x006E8), `Delta (0); + (0x006EA,0x006ED), `Delta (0); + (0x00711,0x00711), `Abs (0x00711); + (0x00730,0x0074A), `Delta (0); + (0x007A6,0x007B0), `Delta (0); + (0x007EB,0x007F3), `Delta (0); + (0x00816,0x00819), `Delta (0); + (0x0081B,0x00823), `Delta (0); + (0x00825,0x00827), `Delta (0); + (0x00829,0x0082D), `Delta (0); + (0x00859,0x0085B), `Delta (0); + (0x008D4,0x008E1), `Delta (0); + (0x008E3,0x00902), `Delta (0); + (0x0093A,0x0093A), `Abs (0x0093A); + (0x0093C,0x0093C), `Abs (0x0093C); + (0x00941,0x00948), `Delta (0); + (0x0094D,0x0094D), `Abs (0x0094D); + (0x00951,0x00957), `Delta (0); + (0x00962,0x00963), `Delta (0); + (0x00981,0x00981), `Abs (0x00981); + (0x009BC,0x009BC), `Abs (0x009BC); + (0x009C1,0x009C4), `Delta (0); + (0x009CD,0x009CD), `Abs (0x009CD); + (0x009E2,0x009E3), `Delta (0); + (0x00A01,0x00A02), `Delta (0); + (0x00A3C,0x00A3C), `Abs (0x00A3C); + (0x00A41,0x00A42), `Delta (0); + (0x00A47,0x00A48), `Delta (0); + (0x00A4B,0x00A4D), `Delta (0); + (0x00A51,0x00A51), `Abs (0x00A51); + (0x00A70,0x00A71), `Delta (0); + (0x00A75,0x00A75), `Abs (0x00A75); + (0x00A81,0x00A82), `Delta (0); + (0x00ABC,0x00ABC), `Abs (0x00ABC); + (0x00AC1,0x00AC5), `Delta (0); + (0x00AC7,0x00AC8), `Delta (0); + (0x00ACD,0x00ACD), `Abs (0x00ACD); + (0x00AE2,0x00AE3), `Delta (0); + (0x00B01,0x00B01), `Abs (0x00B01); + (0x00B3C,0x00B3C), `Abs (0x00B3C); + (0x00B3F,0x00B3F), `Abs (0x00B3F); + (0x00B41,0x00B44), `Delta (0); + (0x00B4D,0x00B4D), `Abs (0x00B4D); + (0x00B56,0x00B56), `Abs (0x00B56); + (0x00B62,0x00B63), `Delta (0); + (0x00B82,0x00B82), `Abs (0x00B82); + (0x00BC0,0x00BC0), `Abs (0x00BC0); + (0x00BCD,0x00BCD), `Abs (0x00BCD); + (0x00C00,0x00C00), `Abs (0x00C00); + (0x00C3E,0x00C40), `Delta (0); + (0x00C46,0x00C48), `Delta (0); + (0x00C4A,0x00C4D), `Delta (0); + (0x00C55,0x00C56), `Delta (0); + (0x00C62,0x00C63), `Delta (0); + (0x00C81,0x00C81), `Abs (0x00C81); + (0x00CBC,0x00CBC), `Abs (0x00CBC); + (0x00CBF,0x00CBF), `Abs (0x00CBF); + (0x00CC6,0x00CC6), `Abs (0x00CC6); + (0x00CCC,0x00CCD), `Delta (0); + (0x00CE2,0x00CE3), `Delta (0); + (0x00D01,0x00D01), `Abs (0x00D01); + (0x00D41,0x00D44), `Delta (0); + (0x00D4D,0x00D4D), `Abs (0x00D4D); + (0x00D62,0x00D63), `Delta (0); + (0x00DCA,0x00DCA), `Abs (0x00DCA); + (0x00DD2,0x00DD4), `Delta (0); + (0x00DD6,0x00DD6), `Abs (0x00DD6); + (0x00E31,0x00E31), `Abs (0x00E31); + (0x00E34,0x00E3A), `Delta (0); + (0x00E47,0x00E4E), `Delta (0); + (0x00EB1,0x00EB1), `Abs (0x00EB1); + (0x00EB4,0x00EB9), `Delta (0); + (0x00EBB,0x00EBC), `Delta (0); + (0x00EC8,0x00ECD), `Delta (0); + (0x00F18,0x00F19), `Delta (0); + (0x00F35,0x00F35), `Abs (0x00F35); + (0x00F37,0x00F37), `Abs (0x00F37); + (0x00F39,0x00F39), `Abs (0x00F39); + (0x00F71,0x00F7E), `Delta (0); + (0x00F80,0x00F84), `Delta (0); + (0x00F86,0x00F87), `Delta (0); + (0x00F8D,0x00F97), `Delta (0); + (0x00F99,0x00FBC), `Delta (0); + (0x00FC6,0x00FC6), `Abs (0x00FC6); + (0x0102D,0x01030), `Delta (0); + (0x01032,0x01037), `Delta (0); + (0x01039,0x0103A), `Delta (0); + (0x0103D,0x0103E), `Delta (0); + (0x01058,0x01059), `Delta (0); + (0x0105E,0x01060), `Delta (0); + (0x01071,0x01074), `Delta (0); + (0x01082,0x01082), `Abs (0x01082); + (0x01085,0x01086), `Delta (0); + (0x0108D,0x0108D), `Abs (0x0108D); + (0x0109D,0x0109D), `Abs (0x0109D); + (0x0135D,0x0135F), `Delta (0); + (0x01712,0x01714), `Delta (0); + (0x01732,0x01734), `Delta (0); + (0x01752,0x01753), `Delta (0); + (0x01772,0x01773), `Delta (0); + (0x017B4,0x017B5), `Delta (0); + (0x017B7,0x017BD), `Delta (0); + (0x017C6,0x017C6), `Abs (0x017C6); + (0x017C9,0x017D3), `Delta (0); + (0x017DD,0x017DD), `Abs (0x017DD); + (0x0180B,0x0180D), `Delta (0); + (0x01885,0x01886), `Delta (0); + (0x018A9,0x018A9), `Abs (0x018A9); + (0x01920,0x01922), `Delta (0); + (0x01927,0x01928), `Delta (0); + (0x01932,0x01932), `Abs (0x01932); + (0x01939,0x0193B), `Delta (0); + (0x01A17,0x01A18), `Delta (0); + (0x01A1B,0x01A1B), `Abs (0x01A1B); + (0x01A56,0x01A56), `Abs (0x01A56); + (0x01A58,0x01A5E), `Delta (0); + (0x01A60,0x01A60), `Abs (0x01A60); + (0x01A62,0x01A62), `Abs (0x01A62); + (0x01A65,0x01A6C), `Delta (0); + (0x01A73,0x01A7C), `Delta (0); + (0x01A7F,0x01A7F), `Abs (0x01A7F); + (0x01AB0,0x01ABD), `Delta (0); + (0x01B00,0x01B03), `Delta (0); + (0x01B34,0x01B34), `Abs (0x01B34); + (0x01B36,0x01B3A), `Delta (0); + (0x01B3C,0x01B3C), `Abs (0x01B3C); + (0x01B42,0x01B42), `Abs (0x01B42); + (0x01B6B,0x01B73), `Delta (0); + (0x01B80,0x01B81), `Delta (0); + (0x01BA2,0x01BA5), `Delta (0); + (0x01BA8,0x01BA9), `Delta (0); + (0x01BAB,0x01BAD), `Delta (0); + (0x01BE6,0x01BE6), `Abs (0x01BE6); + (0x01BE8,0x01BE9), `Delta (0); + (0x01BED,0x01BED), `Abs (0x01BED); + (0x01BEF,0x01BF1), `Delta (0); + (0x01C2C,0x01C33), `Delta (0); + (0x01C36,0x01C37), `Delta (0); + (0x01CD0,0x01CD2), `Delta (0); + (0x01CD4,0x01CE0), `Delta (0); + (0x01CE2,0x01CE8), `Delta (0); + (0x01CED,0x01CED), `Abs (0x01CED); + (0x01CF4,0x01CF4), `Abs (0x01CF4); + (0x01CF8,0x01CF9), `Delta (0); + (0x01DC0,0x01DF5), `Delta (0); + (0x01DFB,0x01DFF), `Delta (0); + (0x020D0,0x020DC), `Delta (0); + (0x020E1,0x020E1), `Abs (0x020E1); + (0x020E5,0x020F0), `Delta (0); + (0x02CEF,0x02CF1), `Delta (0); + (0x02D7F,0x02D7F), `Abs (0x02D7F); + (0x02DE0,0x02DFF), `Delta (0); + (0x0302A,0x0302D), `Delta (0); + (0x03099,0x0309A), `Delta (0); + (0x0A66F,0x0A66F), `Abs (0x0A66F); + (0x0A674,0x0A67D), `Delta (0); + (0x0A69E,0x0A69F), `Delta (0); + (0x0A6F0,0x0A6F1), `Delta (0); + (0x0A802,0x0A802), `Abs (0x0A802); + (0x0A806,0x0A806), `Abs (0x0A806); + (0x0A80B,0x0A80B), `Abs (0x0A80B); + (0x0A825,0x0A826), `Delta (0); + (0x0A8C4,0x0A8C5), `Delta (0); + (0x0A8E0,0x0A8F1), `Delta (0); + (0x0A926,0x0A92D), `Delta (0); + (0x0A947,0x0A951), `Delta (0); + (0x0A980,0x0A982), `Delta (0); + (0x0A9B3,0x0A9B3), `Abs (0x0A9B3); + (0x0A9B6,0x0A9B9), `Delta (0); + (0x0A9BC,0x0A9BC), `Abs (0x0A9BC); + (0x0A9E5,0x0A9E5), `Abs (0x0A9E5); + (0x0AA29,0x0AA2E), `Delta (0); + (0x0AA31,0x0AA32), `Delta (0); + (0x0AA35,0x0AA36), `Delta (0); + (0x0AA43,0x0AA43), `Abs (0x0AA43); + (0x0AA4C,0x0AA4C), `Abs (0x0AA4C); + (0x0AA7C,0x0AA7C), `Abs (0x0AA7C); + (0x0AAB0,0x0AAB0), `Abs (0x0AAB0); + (0x0AAB2,0x0AAB4), `Delta (0); + (0x0AAB7,0x0AAB8), `Delta (0); + (0x0AABE,0x0AABF), `Delta (0); + (0x0AAC1,0x0AAC1), `Abs (0x0AAC1); + (0x0AAEC,0x0AAED), `Delta (0); + (0x0AAF6,0x0AAF6), `Abs (0x0AAF6); + (0x0ABE5,0x0ABE5), `Abs (0x0ABE5); + (0x0ABE8,0x0ABE8), `Abs (0x0ABE8); + (0x0ABED,0x0ABED), `Abs (0x0ABED); + (0x0FB1E,0x0FB1E), `Abs (0x0FB1E); + (0x0FE00,0x0FE0F), `Delta (0); + (0x0FE20,0x0FE2F), `Delta (0); + (0x101FD,0x101FD), `Abs (0x101FD); + (0x102E0,0x102E0), `Abs (0x102E0); + (0x10376,0x1037A), `Delta (0); + (0x10A01,0x10A03), `Delta (0); + (0x10A05,0x10A06), `Delta (0); + (0x10A0C,0x10A0F), `Delta (0); + (0x10A38,0x10A3A), `Delta (0); + (0x10A3F,0x10A3F), `Abs (0x10A3F); + (0x10AE5,0x10AE6), `Delta (0); + (0x11001,0x11001), `Abs (0x11001); + (0x11038,0x11046), `Delta (0); + (0x1107F,0x11081), `Delta (0); + (0x110B3,0x110B6), `Delta (0); + (0x110B9,0x110BA), `Delta (0); + (0x11100,0x11102), `Delta (0); + (0x11127,0x1112B), `Delta (0); + (0x1112D,0x11134), `Delta (0); + (0x11173,0x11173), `Abs (0x11173); + (0x11180,0x11181), `Delta (0); + (0x111B6,0x111BE), `Delta (0); + (0x111CA,0x111CC), `Delta (0); + (0x1122F,0x11231), `Delta (0); + (0x11234,0x11234), `Abs (0x11234); + (0x11236,0x11237), `Delta (0); + (0x1123E,0x1123E), `Abs (0x1123E); + (0x112DF,0x112DF), `Abs (0x112DF); + (0x112E3,0x112EA), `Delta (0); + (0x11300,0x11301), `Delta (0); + (0x1133C,0x1133C), `Abs (0x1133C); + (0x11340,0x11340), `Abs (0x11340); + (0x11366,0x1136C), `Delta (0); + (0x11370,0x11374), `Delta (0); + (0x11438,0x1143F), `Delta (0); + (0x11442,0x11444), `Delta (0); + (0x11446,0x11446), `Abs (0x11446); + (0x114B3,0x114B8), `Delta (0); + (0x114BA,0x114BA), `Abs (0x114BA); + (0x114BF,0x114C0), `Delta (0); + (0x114C2,0x114C3), `Delta (0); + (0x115B2,0x115B5), `Delta (0); + (0x115BC,0x115BD), `Delta (0); + (0x115BF,0x115C0), `Delta (0); + (0x115DC,0x115DD), `Delta (0); + (0x11633,0x1163A), `Delta (0); + (0x1163D,0x1163D), `Abs (0x1163D); + (0x1163F,0x11640), `Delta (0); + (0x116AB,0x116AB), `Abs (0x116AB); + (0x116AD,0x116AD), `Abs (0x116AD); + (0x116B0,0x116B5), `Delta (0); + (0x116B7,0x116B7), `Abs (0x116B7); + (0x1171D,0x1171F), `Delta (0); + (0x11722,0x11725), `Delta (0); + (0x11727,0x1172B), `Delta (0); + (0x11C30,0x11C36), `Delta (0); + (0x11C38,0x11C3D), `Delta (0); + (0x11C3F,0x11C3F), `Abs (0x11C3F); + (0x11C92,0x11CA7), `Delta (0); + (0x11CAA,0x11CB0), `Delta (0); + (0x11CB2,0x11CB3), `Delta (0); + (0x11CB5,0x11CB6), `Delta (0); + (0x16AF0,0x16AF4), `Delta (0); + (0x16B30,0x16B36), `Delta (0); + (0x16F8F,0x16F92), `Delta (0); + (0x1BC9D,0x1BC9E), `Delta (0); + (0x1D167,0x1D169), `Delta (0); + (0x1D17B,0x1D182), `Delta (0); + (0x1D185,0x1D18B), `Delta (0); + (0x1D1AA,0x1D1AD), `Delta (0); + (0x1D242,0x1D244), `Delta (0); + (0x1DA00,0x1DA36), `Delta (0); + (0x1DA3B,0x1DA6C), `Delta (0); + (0x1DA75,0x1DA75), `Abs (0x1DA75); + (0x1DA84,0x1DA84), `Abs (0x1DA84); + (0x1DA9B,0x1DA9F), `Delta (0); + (0x1DAA1,0x1DAAF), `Delta (0); + (0x1E000,0x1E006), `Delta (0); + (0x1E008,0x1E018), `Delta (0); + (0x1E01B,0x1E021), `Delta (0); + (0x1E023,0x1E024), `Delta (0); + (0x1E026,0x1E02A), `Delta (0); + (0x1E8D0,0x1E8D6), `Delta (0); + (0x1E944,0x1E94A), `Delta (0); + (0xE0100,0xE01EF), `Delta (0); + (0x00903,0x00903), `Abs (0x00903); + (0x0093B,0x0093B), `Abs (0x0093B); + (0x0093E,0x00940), `Delta (0); + (0x00949,0x0094C), `Delta (0); + (0x0094E,0x0094F), `Delta (0); + (0x00982,0x00983), `Delta (0); + (0x009BE,0x009C0), `Delta (0); + (0x009C7,0x009C8), `Delta (0); + (0x009CB,0x009CC), `Delta (0); + (0x009D7,0x009D7), `Abs (0x009D7); + (0x00A03,0x00A03), `Abs (0x00A03); + (0x00A3E,0x00A40), `Delta (0); + (0x00A83,0x00A83), `Abs (0x00A83); + (0x00ABE,0x00AC0), `Delta (0); + (0x00AC9,0x00AC9), `Abs (0x00AC9); + (0x00ACB,0x00ACC), `Delta (0); + (0x00B02,0x00B03), `Delta (0); + (0x00B3E,0x00B3E), `Abs (0x00B3E); + (0x00B40,0x00B40), `Abs (0x00B40); + (0x00B47,0x00B48), `Delta (0); + (0x00B4B,0x00B4C), `Delta (0); + (0x00B57,0x00B57), `Abs (0x00B57); + (0x00BBE,0x00BBF), `Delta (0); + (0x00BC1,0x00BC2), `Delta (0); + (0x00BC6,0x00BC8), `Delta (0); + (0x00BCA,0x00BCC), `Delta (0); + (0x00BD7,0x00BD7), `Abs (0x00BD7); + (0x00C01,0x00C03), `Delta (0); + (0x00C41,0x00C44), `Delta (0); + (0x00C82,0x00C83), `Delta (0); + (0x00CBE,0x00CBE), `Abs (0x00CBE); + (0x00CC0,0x00CC4), `Delta (0); + (0x00CC7,0x00CC8), `Delta (0); + (0x00CCA,0x00CCB), `Delta (0); + (0x00CD5,0x00CD6), `Delta (0); + (0x00D02,0x00D03), `Delta (0); + (0x00D3E,0x00D40), `Delta (0); + (0x00D46,0x00D48), `Delta (0); + (0x00D4A,0x00D4C), `Delta (0); + (0x00D57,0x00D57), `Abs (0x00D57); + (0x00D82,0x00D83), `Delta (0); + (0x00DCF,0x00DD1), `Delta (0); + (0x00DD8,0x00DDF), `Delta (0); + (0x00DF2,0x00DF3), `Delta (0); + (0x00F3E,0x00F3F), `Delta (0); + (0x00F7F,0x00F7F), `Abs (0x00F7F); + (0x0102B,0x0102C), `Delta (0); + (0x01031,0x01031), `Abs (0x01031); + (0x01038,0x01038), `Abs (0x01038); + (0x0103B,0x0103C), `Delta (0); + (0x01056,0x01057), `Delta (0); + (0x01062,0x01064), `Delta (0); + (0x01067,0x0106D), `Delta (0); + (0x01083,0x01084), `Delta (0); + (0x01087,0x0108C), `Delta (0); + (0x0108F,0x0108F), `Abs (0x0108F); + (0x0109A,0x0109C), `Delta (0); + (0x017B6,0x017B6), `Abs (0x017B6); + (0x017BE,0x017C5), `Delta (0); + (0x017C7,0x017C8), `Delta (0); + (0x01923,0x01926), `Delta (0); + (0x01929,0x0192B), `Delta (0); + (0x01930,0x01931), `Delta (0); + (0x01933,0x01938), `Delta (0); + (0x01A19,0x01A1A), `Delta (0); + (0x01A55,0x01A55), `Abs (0x01A55); + (0x01A57,0x01A57), `Abs (0x01A57); + (0x01A61,0x01A61), `Abs (0x01A61); + (0x01A63,0x01A64), `Delta (0); + (0x01A6D,0x01A72), `Delta (0); + (0x01B04,0x01B04), `Abs (0x01B04); + (0x01B35,0x01B35), `Abs (0x01B35); + (0x01B3B,0x01B3B), `Abs (0x01B3B); + (0x01B3D,0x01B41), `Delta (0); + (0x01B43,0x01B44), `Delta (0); + (0x01B82,0x01B82), `Abs (0x01B82); + (0x01BA1,0x01BA1), `Abs (0x01BA1); + (0x01BA6,0x01BA7), `Delta (0); + (0x01BAA,0x01BAA), `Abs (0x01BAA); + (0x01BE7,0x01BE7), `Abs (0x01BE7); + (0x01BEA,0x01BEC), `Delta (0); + (0x01BEE,0x01BEE), `Abs (0x01BEE); + (0x01BF2,0x01BF3), `Delta (0); + (0x01C24,0x01C2B), `Delta (0); + (0x01C34,0x01C35), `Delta (0); + (0x01CE1,0x01CE1), `Abs (0x01CE1); + (0x01CF2,0x01CF3), `Delta (0); + (0x0302E,0x0302F), `Delta (0); + (0x0A823,0x0A824), `Delta (0); + (0x0A827,0x0A827), `Abs (0x0A827); + (0x0A880,0x0A881), `Delta (0); + (0x0A8B4,0x0A8C3), `Delta (0); + (0x0A952,0x0A953), `Delta (0); + (0x0A983,0x0A983), `Abs (0x0A983); + (0x0A9B4,0x0A9B5), `Delta (0); + (0x0A9BA,0x0A9BB), `Delta (0); + (0x0A9BD,0x0A9C0), `Delta (0); + (0x0AA2F,0x0AA30), `Delta (0); + (0x0AA33,0x0AA34), `Delta (0); + (0x0AA4D,0x0AA4D), `Abs (0x0AA4D); + (0x0AA7B,0x0AA7B), `Abs (0x0AA7B); + (0x0AA7D,0x0AA7D), `Abs (0x0AA7D); + (0x0AAEB,0x0AAEB), `Abs (0x0AAEB); + (0x0AAEE,0x0AAEF), `Delta (0); + (0x0AAF5,0x0AAF5), `Abs (0x0AAF5); + (0x0ABE3,0x0ABE4), `Delta (0); + (0x0ABE6,0x0ABE7), `Delta (0); + (0x0ABE9,0x0ABEA), `Delta (0); + (0x0ABEC,0x0ABEC), `Abs (0x0ABEC); + (0x11000,0x11000), `Abs (0x11000); + (0x11002,0x11002), `Abs (0x11002); + (0x11082,0x11082), `Abs (0x11082); + (0x110B0,0x110B2), `Delta (0); + (0x110B7,0x110B8), `Delta (0); + (0x1112C,0x1112C), `Abs (0x1112C); + (0x11182,0x11182), `Abs (0x11182); + (0x111B3,0x111B5), `Delta (0); + (0x111BF,0x111C0), `Delta (0); + (0x1122C,0x1122E), `Delta (0); + (0x11232,0x11233), `Delta (0); + (0x11235,0x11235), `Abs (0x11235); + (0x112E0,0x112E2), `Delta (0); + (0x11302,0x11303), `Delta (0); + (0x1133E,0x1133F), `Delta (0); + (0x11341,0x11344), `Delta (0); + (0x11347,0x11348), `Delta (0); + (0x1134B,0x1134D), `Delta (0); + (0x11357,0x11357), `Abs (0x11357); + (0x11362,0x11363), `Delta (0); + (0x11435,0x11437), `Delta (0); + (0x11440,0x11441), `Delta (0); + (0x11445,0x11445), `Abs (0x11445); + (0x114B0,0x114B2), `Delta (0); + (0x114B9,0x114B9), `Abs (0x114B9); + (0x114BB,0x114BE), `Delta (0); + (0x114C1,0x114C1), `Abs (0x114C1); + (0x115AF,0x115B1), `Delta (0); + (0x115B8,0x115BB), `Delta (0); + (0x115BE,0x115BE), `Abs (0x115BE); + (0x11630,0x11632), `Delta (0); + (0x1163B,0x1163C), `Delta (0); + (0x1163E,0x1163E), `Abs (0x1163E); + (0x116AC,0x116AC), `Abs (0x116AC); + (0x116AE,0x116AF), `Delta (0); + (0x116B6,0x116B6), `Abs (0x116B6); + (0x11720,0x11721), `Delta (0); + (0x11726,0x11726), `Abs (0x11726); + (0x11C2F,0x11C2F), `Abs (0x11C2F); + (0x11C3E,0x11C3E), `Abs (0x11C3E); + (0x11CA9,0x11CA9), `Abs (0x11CA9); + (0x11CB1,0x11CB1), `Abs (0x11CB1); + (0x11CB4,0x11CB4), `Abs (0x11CB4); + (0x16F51,0x16F7E), `Delta (0); + (0x1D165,0x1D166), `Delta (0); + (0x1D16D,0x1D172), `Delta (0); + (0x00488,0x00489), `Delta (0); + (0x01ABE,0x01ABE), `Abs (0x01ABE); + (0x020DD,0x020E0), `Delta (0); + (0x020E2,0x020E4), `Delta (0); + (0x0A670,0x0A672), `Delta (0); + (0x00030,0x00039), `Delta (0); + (0x00660,0x00669), `Delta (0); + (0x006F0,0x006F9), `Delta (0); + (0x007C0,0x007C9), `Delta (0); + (0x00966,0x0096F), `Delta (0); + (0x009E6,0x009EF), `Delta (0); + (0x00A66,0x00A6F), `Delta (0); + (0x00AE6,0x00AEF), `Delta (0); + (0x00B66,0x00B6F), `Delta (0); + (0x00BE6,0x00BEF), `Delta (0); + (0x00C66,0x00C6F), `Delta (0); + (0x00CE6,0x00CEF), `Delta (0); + (0x00D66,0x00D6F), `Delta (0); + (0x00DE6,0x00DEF), `Delta (0); + (0x00E50,0x00E59), `Delta (0); + (0x00ED0,0x00ED9), `Delta (0); + (0x00F20,0x00F29), `Delta (0); + (0x01040,0x01049), `Delta (0); + (0x01090,0x01099), `Delta (0); + (0x017E0,0x017E9), `Delta (0); + (0x01810,0x01819), `Delta (0); + (0x01946,0x0194F), `Delta (0); + (0x019D0,0x019D9), `Delta (0); + (0x01A80,0x01A89), `Delta (0); + (0x01A90,0x01A99), `Delta (0); + (0x01B50,0x01B59), `Delta (0); + (0x01BB0,0x01BB9), `Delta (0); + (0x01C40,0x01C49), `Delta (0); + (0x01C50,0x01C59), `Delta (0); + (0x0A620,0x0A629), `Delta (0); + (0x0A8D0,0x0A8D9), `Delta (0); + (0x0A900,0x0A909), `Delta (0); + (0x0A9D0,0x0A9D9), `Delta (0); + (0x0A9F0,0x0A9F9), `Delta (0); + (0x0AA50,0x0AA59), `Delta (0); + (0x0ABF0,0x0ABF9), `Delta (0); + (0x0FF10,0x0FF19), `Delta (0); + (0x104A0,0x104A9), `Delta (0); + (0x11066,0x1106F), `Delta (0); + (0x110F0,0x110F9), `Delta (0); + (0x11136,0x1113F), `Delta (0); + (0x111D0,0x111D9), `Delta (0); + (0x112F0,0x112F9), `Delta (0); + (0x11450,0x11459), `Delta (0); + (0x114D0,0x114D9), `Delta (0); + (0x11650,0x11659), `Delta (0); + (0x116C0,0x116C9), `Delta (0); + (0x11730,0x11739), `Delta (0); + (0x118E0,0x118E9), `Delta (0); + (0x11C50,0x11C59), `Delta (0); + (0x16A60,0x16A69), `Delta (0); + (0x16B50,0x16B59), `Delta (0); + (0x1D7CE,0x1D7FF), `Delta (0); + (0x1E950,0x1E959), `Delta (0); + (0x016EE,0x016F0), `Delta (0); + (0x02160,0x0216F), `Delta (16); + (0x02170,0x02182), `Delta (0); + (0x02185,0x02188), `Delta (0); + (0x03007,0x03007), `Abs (0x03007); + (0x03021,0x03029), `Delta (0); + (0x03038,0x0303A), `Delta (0); + (0x0A6E6,0x0A6EF), `Delta (0); + (0x10140,0x10174), `Delta (0); + (0x10341,0x10341), `Abs (0x10341); + (0x1034A,0x1034A), `Abs (0x1034A); + (0x103D1,0x103D5), `Delta (0); + (0x12400,0x1246E), `Delta (0); + (0x000B2,0x000B3), `Delta (0); + (0x000B9,0x000B9), `Abs (0x000B9); + (0x000BC,0x000BE), `Delta (0); + (0x009F4,0x009F9), `Delta (0); + (0x00B72,0x00B77), `Delta (0); + (0x00BF0,0x00BF2), `Delta (0); + (0x00C78,0x00C7E), `Delta (0); + (0x00D58,0x00D5E), `Delta (0); + (0x00D70,0x00D78), `Delta (0); + (0x00F2A,0x00F33), `Delta (0); + (0x01369,0x0137C), `Delta (0); + (0x017F0,0x017F9), `Delta (0); + (0x019DA,0x019DA), `Abs (0x019DA); + (0x02070,0x02070), `Abs (0x02070); + (0x02074,0x02079), `Delta (0); + (0x02080,0x02089), `Delta (0); + (0x02150,0x0215F), `Delta (0); + (0x02189,0x02189), `Abs (0x02189); + (0x02460,0x0249B), `Delta (0); + (0x024EA,0x024FF), `Delta (0); + (0x02776,0x02793), `Delta (0); + (0x02CFD,0x02CFD), `Abs (0x02CFD); + (0x03192,0x03195), `Delta (0); + (0x03220,0x03229), `Delta (0); + (0x03248,0x0324F), `Delta (0); + (0x03251,0x0325F), `Delta (0); + (0x03280,0x03289), `Delta (0); + (0x032B1,0x032BF), `Delta (0); + (0x0A830,0x0A835), `Delta (0); + (0x10107,0x10133), `Delta (0); + (0x10175,0x10178), `Delta (0); + (0x1018A,0x1018B), `Delta (0); + (0x102E1,0x102FB), `Delta (0); + (0x10320,0x10323), `Delta (0); + (0x10858,0x1085F), `Delta (0); + (0x10879,0x1087F), `Delta (0); + (0x108A7,0x108AF), `Delta (0); + (0x108FB,0x108FF), `Delta (0); + (0x10916,0x1091B), `Delta (0); + (0x109BC,0x109BD), `Delta (0); + (0x109C0,0x109CF), `Delta (0); + (0x109D2,0x109FF), `Delta (0); + (0x10A40,0x10A47), `Delta (0); + (0x10A7D,0x10A7E), `Delta (0); + (0x10A9D,0x10A9F), `Delta (0); + (0x10AEB,0x10AEF), `Delta (0); + (0x10B58,0x10B5F), `Delta (0); + (0x10B78,0x10B7F), `Delta (0); + (0x10BA9,0x10BAF), `Delta (0); + (0x10CFA,0x10CFF), `Delta (0); + (0x10E60,0x10E7E), `Delta (0); + (0x11052,0x11065), `Delta (0); + (0x111E1,0x111F4), `Delta (0); + (0x1173A,0x1173B), `Delta (0); + (0x118EA,0x118F2), `Delta (0); + (0x11C5A,0x11C6C), `Delta (0); + (0x16B5B,0x16B61), `Delta (0); + (0x1D360,0x1D371), `Delta (0); + (0x1E8C7,0x1E8CF), `Delta (0); + (0x1F100,0x1F10C), `Delta (0); + (0x00020,0x00020), `Abs (0x00020); + (0x000A0,0x000A0), `Abs (0x000A0); + (0x01680,0x01680), `Abs (0x01680); + (0x02000,0x0200A), `Delta (0); + (0x0202F,0x0202F), `Abs (0x0202F); + (0x0205F,0x0205F), `Abs (0x0205F); + (0x03000,0x03000), `Abs (0x03000); + (0x02028,0x02029), `Delta (0); + (0x00001,0x0001F), `Delta (0); + (0x0007F,0x0009F), `Delta (0); + (0x000AD,0x000AD), `Abs (0x000AD); + (0x00600,0x00605), `Delta (0); + (0x0061C,0x0061C), `Abs (0x0061C); + (0x006DD,0x006DD), `Abs (0x006DD); + (0x0070F,0x0070F), `Abs (0x0070F); + (0x008E2,0x008E2), `Abs (0x008E2); + (0x0180E,0x0180E), `Abs (0x0180E); + (0x0200B,0x0200F), `Delta (0); + (0x0202A,0x0202E), `Delta (0); + (0x02060,0x02064), `Delta (0); + (0x02066,0x0206F), `Delta (0); + (0x0FEFF,0x0FEFF), `Abs (0x0FEFF); + (0x0FFF9,0x0FFFB), `Delta (0); + (0x110BD,0x110BD), `Abs (0x110BD); + (0x1BCA0,0x1BCA3), `Delta (0); + (0x1D173,0x1D17A), `Delta (0); + (0xE0001,0xE0001), `Abs (0xE0001); + (0xE0020,0xE007F), `Delta (0); + (0x0D800,0x0F8FF), `Delta (0); + (0xF0000,0xFFFFD), `Delta (0); + (0x100000,0x10FFFD), `Delta (0); + (0x00378,0x00379), `Delta (0); + (0x00380,0x00383), `Delta (0); + (0x0038B,0x0038B), `Abs (0x0038B); + (0x0038D,0x0038D), `Abs (0x0038D); + (0x003A2,0x003A2), `Abs (0x003A2); + (0x00530,0x00530), `Abs (0x00530); + (0x00557,0x00558), `Delta (0); + (0x00560,0x00560), `Abs (0x00560); + (0x00588,0x00588), `Abs (0x00588); + (0x0058B,0x0058C), `Delta (0); + (0x00590,0x00590), `Abs (0x00590); + (0x005C8,0x005CF), `Delta (0); + (0x005EB,0x005EF), `Delta (0); + (0x005F5,0x005FF), `Delta (0); + (0x0061D,0x0061D), `Abs (0x0061D); + (0x0070E,0x0070E), `Abs (0x0070E); + (0x0074B,0x0074C), `Delta (0); + (0x007B2,0x007BF), `Delta (0); + (0x007FB,0x007FF), `Delta (0); + (0x0082E,0x0082F), `Delta (0); + (0x0083F,0x0083F), `Abs (0x0083F); + (0x0085C,0x0085D), `Delta (0); + (0x0085F,0x0089F), `Delta (0); + (0x008B5,0x008B5), `Abs (0x008B5); + (0x008BE,0x008D3), `Delta (0); + (0x00984,0x00984), `Abs (0x00984); + (0x0098D,0x0098E), `Delta (0); + (0x00991,0x00992), `Delta (0); + (0x009A9,0x009A9), `Abs (0x009A9); + (0x009B1,0x009B1), `Abs (0x009B1); + (0x009B3,0x009B5), `Delta (0); + (0x009BA,0x009BB), `Delta (0); + (0x009C5,0x009C6), `Delta (0); + (0x009C9,0x009CA), `Delta (0); + (0x009CF,0x009D6), `Delta (0); + (0x009D8,0x009DB), `Delta (0); + (0x009DE,0x009DE), `Abs (0x009DE); + (0x009E4,0x009E5), `Delta (0); + (0x009FC,0x00A00), `Delta (0); + (0x00A04,0x00A04), `Abs (0x00A04); + (0x00A0B,0x00A0E), `Delta (0); + (0x00A11,0x00A12), `Delta (0); + (0x00A29,0x00A29), `Abs (0x00A29); + (0x00A31,0x00A31), `Abs (0x00A31); + (0x00A34,0x00A34), `Abs (0x00A34); + (0x00A37,0x00A37), `Abs (0x00A37); + (0x00A3A,0x00A3B), `Delta (0); + (0x00A3D,0x00A3D), `Abs (0x00A3D); + (0x00A43,0x00A46), `Delta (0); + (0x00A49,0x00A4A), `Delta (0); + (0x00A4E,0x00A50), `Delta (0); + (0x00A52,0x00A58), `Delta (0); + (0x00A5D,0x00A5D), `Abs (0x00A5D); + (0x00A5F,0x00A65), `Delta (0); + (0x00A76,0x00A80), `Delta (0); + (0x00A84,0x00A84), `Abs (0x00A84); + (0x00A8E,0x00A8E), `Abs (0x00A8E); + (0x00A92,0x00A92), `Abs (0x00A92); + (0x00AA9,0x00AA9), `Abs (0x00AA9); + (0x00AB1,0x00AB1), `Abs (0x00AB1); + (0x00AB4,0x00AB4), `Abs (0x00AB4); + (0x00ABA,0x00ABB), `Delta (0); + (0x00AC6,0x00AC6), `Abs (0x00AC6); + (0x00ACA,0x00ACA), `Abs (0x00ACA); + (0x00ACE,0x00ACF), `Delta (0); + (0x00AD1,0x00ADF), `Delta (0); + (0x00AE4,0x00AE5), `Delta (0); + (0x00AF2,0x00AF8), `Delta (0); + (0x00AFA,0x00B00), `Delta (0); + (0x00B04,0x00B04), `Abs (0x00B04); + (0x00B0D,0x00B0E), `Delta (0); + (0x00B11,0x00B12), `Delta (0); + (0x00B29,0x00B29), `Abs (0x00B29); + (0x00B31,0x00B31), `Abs (0x00B31); + (0x00B34,0x00B34), `Abs (0x00B34); + (0x00B3A,0x00B3B), `Delta (0); + (0x00B45,0x00B46), `Delta (0); + (0x00B49,0x00B4A), `Delta (0); + (0x00B4E,0x00B55), `Delta (0); + (0x00B58,0x00B5B), `Delta (0); + (0x00B5E,0x00B5E), `Abs (0x00B5E); + (0x00B64,0x00B65), `Delta (0); + (0x00B78,0x00B81), `Delta (0); + (0x00B84,0x00B84), `Abs (0x00B84); + (0x00B8B,0x00B8D), `Delta (0); + (0x00B91,0x00B91), `Abs (0x00B91); + (0x00B96,0x00B98), `Delta (0); + (0x00B9B,0x00B9B), `Abs (0x00B9B); + (0x00B9D,0x00B9D), `Abs (0x00B9D); + (0x00BA0,0x00BA2), `Delta (0); + (0x00BA5,0x00BA7), `Delta (0); + (0x00BAB,0x00BAD), `Delta (0); + (0x00BBA,0x00BBD), `Delta (0); + (0x00BC3,0x00BC5), `Delta (0); + (0x00BC9,0x00BC9), `Abs (0x00BC9); + (0x00BCE,0x00BCF), `Delta (0); + (0x00BD1,0x00BD6), `Delta (0); + (0x00BD8,0x00BE5), `Delta (0); + (0x00BFB,0x00BFF), `Delta (0); + (0x00C04,0x00C04), `Abs (0x00C04); + (0x00C0D,0x00C0D), `Abs (0x00C0D); + (0x00C11,0x00C11), `Abs (0x00C11); + (0x00C29,0x00C29), `Abs (0x00C29); + (0x00C3A,0x00C3C), `Delta (0); + (0x00C45,0x00C45), `Abs (0x00C45); + (0x00C49,0x00C49), `Abs (0x00C49); + (0x00C4E,0x00C54), `Delta (0); + (0x00C57,0x00C57), `Abs (0x00C57); + (0x00C5B,0x00C5F), `Delta (0); + (0x00C64,0x00C65), `Delta (0); + (0x00C70,0x00C77), `Delta (0); + (0x00C84,0x00C84), `Abs (0x00C84); + (0x00C8D,0x00C8D), `Abs (0x00C8D); + (0x00C91,0x00C91), `Abs (0x00C91); + (0x00CA9,0x00CA9), `Abs (0x00CA9); + (0x00CB4,0x00CB4), `Abs (0x00CB4); + (0x00CBA,0x00CBB), `Delta (0); + (0x00CC5,0x00CC5), `Abs (0x00CC5); + (0x00CC9,0x00CC9), `Abs (0x00CC9); + (0x00CCE,0x00CD4), `Delta (0); + (0x00CD7,0x00CDD), `Delta (0); + (0x00CDF,0x00CDF), `Abs (0x00CDF); + (0x00CE4,0x00CE5), `Delta (0); + (0x00CF0,0x00CF0), `Abs (0x00CF0); + (0x00CF3,0x00D00), `Delta (0); + (0x00D04,0x00D04), `Abs (0x00D04); + (0x00D0D,0x00D0D), `Abs (0x00D0D); + (0x00D11,0x00D11), `Abs (0x00D11); + (0x00D3B,0x00D3C), `Delta (0); + (0x00D45,0x00D45), `Abs (0x00D45); + (0x00D49,0x00D49), `Abs (0x00D49); + (0x00D50,0x00D53), `Delta (0); + (0x00D64,0x00D65), `Delta (0); + (0x00D80,0x00D81), `Delta (0); + (0x00D84,0x00D84), `Abs (0x00D84); + (0x00D97,0x00D99), `Delta (0); + (0x00DB2,0x00DB2), `Abs (0x00DB2); + (0x00DBC,0x00DBC), `Abs (0x00DBC); + (0x00DBE,0x00DBF), `Delta (0); + (0x00DC7,0x00DC9), `Delta (0); + (0x00DCB,0x00DCE), `Delta (0); + (0x00DD5,0x00DD5), `Abs (0x00DD5); + (0x00DD7,0x00DD7), `Abs (0x00DD7); + (0x00DE0,0x00DE5), `Delta (0); + (0x00DF0,0x00DF1), `Delta (0); + (0x00DF5,0x00E00), `Delta (0); + (0x00E3B,0x00E3E), `Delta (0); + (0x00E5C,0x00E80), `Delta (0); + (0x00E83,0x00E83), `Abs (0x00E83); + (0x00E85,0x00E86), `Delta (0); + (0x00E89,0x00E89), `Abs (0x00E89); + (0x00E8B,0x00E8C), `Delta (0); + (0x00E8E,0x00E93), `Delta (0); + (0x00E98,0x00E98), `Abs (0x00E98); + (0x00EA0,0x00EA0), `Abs (0x00EA0); + (0x00EA4,0x00EA4), `Abs (0x00EA4); + (0x00EA6,0x00EA6), `Abs (0x00EA6); + (0x00EA8,0x00EA9), `Delta (0); + (0x00EAC,0x00EAC), `Abs (0x00EAC); + (0x00EBA,0x00EBA), `Abs (0x00EBA); + (0x00EBE,0x00EBF), `Delta (0); + (0x00EC5,0x00EC5), `Abs (0x00EC5); + (0x00EC7,0x00EC7), `Abs (0x00EC7); + (0x00ECE,0x00ECF), `Delta (0); + (0x00EDA,0x00EDB), `Delta (0); + (0x00EE0,0x00EFF), `Delta (0); + (0x00F48,0x00F48), `Abs (0x00F48); + (0x00F6D,0x00F70), `Delta (0); + (0x00F98,0x00F98), `Abs (0x00F98); + (0x00FBD,0x00FBD), `Abs (0x00FBD); + (0x00FCD,0x00FCD), `Abs (0x00FCD); + (0x00FDB,0x00FFF), `Delta (0); + (0x010C6,0x010C6), `Abs (0x010C6); + (0x010C8,0x010CC), `Delta (0); + (0x010CE,0x010CF), `Delta (0); + (0x01249,0x01249), `Abs (0x01249); + (0x0124E,0x0124F), `Delta (0); + (0x01257,0x01257), `Abs (0x01257); + (0x01259,0x01259), `Abs (0x01259); + (0x0125E,0x0125F), `Delta (0); + (0x01289,0x01289), `Abs (0x01289); + (0x0128E,0x0128F), `Delta (0); + (0x012B1,0x012B1), `Abs (0x012B1); + (0x012B6,0x012B7), `Delta (0); + (0x012BF,0x012BF), `Abs (0x012BF); + (0x012C1,0x012C1), `Abs (0x012C1); + (0x012C6,0x012C7), `Delta (0); + (0x012D7,0x012D7), `Abs (0x012D7); + (0x01311,0x01311), `Abs (0x01311); + (0x01316,0x01317), `Delta (0); + (0x0135B,0x0135C), `Delta (0); + (0x0137D,0x0137F), `Delta (0); + (0x0139A,0x0139F), `Delta (0); + (0x013F6,0x013F7), `Delta (0); + (0x013FE,0x013FF), `Delta (0); + (0x0169D,0x0169F), `Delta (0); + (0x016F9,0x016FF), `Delta (0); + (0x0170D,0x0170D), `Abs (0x0170D); + (0x01715,0x0171F), `Delta (0); + (0x01737,0x0173F), `Delta (0); + (0x01754,0x0175F), `Delta (0); + (0x0176D,0x0176D), `Abs (0x0176D); + (0x01771,0x01771), `Abs (0x01771); + (0x01774,0x0177F), `Delta (0); + (0x017DE,0x017DF), `Delta (0); + (0x017EA,0x017EF), `Delta (0); + (0x017FA,0x017FF), `Delta (0); + (0x0180F,0x0180F), `Abs (0x0180F); + (0x0181A,0x0181F), `Delta (0); + (0x01878,0x0187F), `Delta (0); + (0x018AB,0x018AF), `Delta (0); + (0x018F6,0x018FF), `Delta (0); + (0x0191F,0x0191F), `Abs (0x0191F); + (0x0192C,0x0192F), `Delta (0); + (0x0193C,0x0193F), `Delta (0); + (0x01941,0x01943), `Delta (0); + (0x0196E,0x0196F), `Delta (0); + (0x01975,0x0197F), `Delta (0); + (0x019AC,0x019AF), `Delta (0); + (0x019CA,0x019CF), `Delta (0); + (0x019DB,0x019DD), `Delta (0); + (0x01A1C,0x01A1D), `Delta (0); + (0x01A5F,0x01A5F), `Abs (0x01A5F); + (0x01A7D,0x01A7E), `Delta (0); + (0x01A8A,0x01A8F), `Delta (0); + (0x01A9A,0x01A9F), `Delta (0); + (0x01AAE,0x01AAF), `Delta (0); + (0x01ABF,0x01AFF), `Delta (0); + (0x01B4C,0x01B4F), `Delta (0); + (0x01B7D,0x01B7F), `Delta (0); + (0x01BF4,0x01BFB), `Delta (0); + (0x01C38,0x01C3A), `Delta (0); + (0x01C4A,0x01C4C), `Delta (0); + (0x01C89,0x01CBF), `Delta (0); + (0x01CC8,0x01CCF), `Delta (0); + (0x01CF7,0x01CF7), `Abs (0x01CF7); + (0x01CFA,0x01CFF), `Delta (0); + (0x01DF6,0x01DFA), `Delta (0); + (0x01F16,0x01F17), `Delta (0); + (0x01F1E,0x01F1F), `Delta (0); + (0x01F46,0x01F47), `Delta (0); + (0x01F4E,0x01F4F), `Delta (0); + (0x01F58,0x01F58), `Abs (0x01F58); + (0x01F5A,0x01F5A), `Abs (0x01F5A); + (0x01F5C,0x01F5C), `Abs (0x01F5C); + (0x01F5E,0x01F5E), `Abs (0x01F5E); + (0x01F7E,0x01F7F), `Delta (0); + (0x01FB5,0x01FB5), `Abs (0x01FB5); + (0x01FC5,0x01FC5), `Abs (0x01FC5); + (0x01FD4,0x01FD5), `Delta (0); + (0x01FDC,0x01FDC), `Abs (0x01FDC); + (0x01FF0,0x01FF1), `Delta (0); + (0x01FF5,0x01FF5), `Abs (0x01FF5); + (0x01FFF,0x01FFF), `Abs (0x01FFF); + (0x02065,0x02065), `Abs (0x02065); + (0x02072,0x02073), `Delta (0); + (0x0208F,0x0208F), `Abs (0x0208F); + (0x0209D,0x0209F), `Delta (0); + (0x020BF,0x020CF), `Delta (0); + (0x020F1,0x020FF), `Delta (0); + (0x0218C,0x0218F), `Delta (0); + (0x023FF,0x023FF), `Abs (0x023FF); + (0x02427,0x0243F), `Delta (0); + (0x0244B,0x0245F), `Delta (0); + (0x02B74,0x02B75), `Delta (0); + (0x02B96,0x02B97), `Delta (0); + (0x02BBA,0x02BBC), `Delta (0); + (0x02BC9,0x02BC9), `Abs (0x02BC9); + (0x02BD2,0x02BEB), `Delta (0); + (0x02BF0,0x02BFF), `Delta (0); + (0x02C2F,0x02C2F), `Abs (0x02C2F); + (0x02C5F,0x02C5F), `Abs (0x02C5F); + (0x02CF4,0x02CF8), `Delta (0); + (0x02D26,0x02D26), `Abs (0x02D26); + (0x02D28,0x02D2C), `Delta (0); + (0x02D2E,0x02D2F), `Delta (0); + (0x02D68,0x02D6E), `Delta (0); + (0x02D71,0x02D7E), `Delta (0); + (0x02D97,0x02D9F), `Delta (0); + (0x02DA7,0x02DA7), `Abs (0x02DA7); + (0x02DAF,0x02DAF), `Abs (0x02DAF); + (0x02DB7,0x02DB7), `Abs (0x02DB7); + (0x02DBF,0x02DBF), `Abs (0x02DBF); + (0x02DC7,0x02DC7), `Abs (0x02DC7); + (0x02DCF,0x02DCF), `Abs (0x02DCF); + (0x02DD7,0x02DD7), `Abs (0x02DD7); + (0x02DDF,0x02DDF), `Abs (0x02DDF); + (0x02E45,0x02E7F), `Delta (0); + (0x02E9A,0x02E9A), `Abs (0x02E9A); + (0x02EF4,0x02EFF), `Delta (0); + (0x02FD6,0x02FEF), `Delta (0); + (0x02FFC,0x02FFF), `Delta (0); + (0x03040,0x03040), `Abs (0x03040); + (0x03097,0x03098), `Delta (0); + (0x03100,0x03104), `Delta (0); + (0x0312E,0x03130), `Delta (0); + (0x0318F,0x0318F), `Abs (0x0318F); + (0x031BB,0x031BF), `Delta (0); + (0x031E4,0x031EF), `Delta (0); + (0x0321F,0x0321F), `Abs (0x0321F); + (0x032FF,0x032FF), `Abs (0x032FF); + (0x04DB6,0x04DBF), `Delta (0); + (0x09FD6,0x09FFF), `Delta (0); + (0x0A48D,0x0A48F), `Delta (0); + (0x0A4C7,0x0A4CF), `Delta (0); + (0x0A62C,0x0A63F), `Delta (0); + (0x0A6F8,0x0A6FF), `Delta (0); + (0x0A7AF,0x0A7AF), `Abs (0x0A7AF); + (0x0A7B8,0x0A7F6), `Delta (0); + (0x0A82C,0x0A82F), `Delta (0); + (0x0A83A,0x0A83F), `Delta (0); + (0x0A878,0x0A87F), `Delta (0); + (0x0A8C6,0x0A8CD), `Delta (0); + (0x0A8DA,0x0A8DF), `Delta (0); + (0x0A8FE,0x0A8FF), `Delta (0); + (0x0A954,0x0A95E), `Delta (0); + (0x0A97D,0x0A97F), `Delta (0); + (0x0A9CE,0x0A9CE), `Abs (0x0A9CE); + (0x0A9DA,0x0A9DD), `Delta (0); + (0x0A9FF,0x0A9FF), `Abs (0x0A9FF); + (0x0AA37,0x0AA3F), `Delta (0); + (0x0AA4E,0x0AA4F), `Delta (0); + (0x0AA5A,0x0AA5B), `Delta (0); + (0x0AAC3,0x0AADA), `Delta (0); + (0x0AAF7,0x0AB00), `Delta (0); + (0x0AB07,0x0AB08), `Delta (0); + (0x0AB0F,0x0AB10), `Delta (0); + (0x0AB17,0x0AB1F), `Delta (0); + (0x0AB27,0x0AB27), `Abs (0x0AB27); + (0x0AB2F,0x0AB2F), `Abs (0x0AB2F); + (0x0AB66,0x0AB6F), `Delta (0); + (0x0ABEE,0x0ABEF), `Delta (0); + (0x0ABFA,0x0ABFF), `Delta (0); + (0x0D7A4,0x0D7AF), `Delta (0); + (0x0D7C7,0x0D7CA), `Delta (0); + (0x0D7FC,0x0D7FF), `Delta (0); + (0x0FA6E,0x0FA6F), `Delta (0); + (0x0FADA,0x0FAFF), `Delta (0); + (0x0FB07,0x0FB12), `Delta (0); + (0x0FB18,0x0FB1C), `Delta (0); + (0x0FB37,0x0FB37), `Abs (0x0FB37); + (0x0FB3D,0x0FB3D), `Abs (0x0FB3D); + (0x0FB3F,0x0FB3F), `Abs (0x0FB3F); + (0x0FB42,0x0FB42), `Abs (0x0FB42); + (0x0FB45,0x0FB45), `Abs (0x0FB45); + (0x0FBC2,0x0FBD2), `Delta (0); + (0x0FD40,0x0FD4F), `Delta (0); + (0x0FD90,0x0FD91), `Delta (0); + (0x0FDC8,0x0FDEF), `Delta (0); + (0x0FDFE,0x0FDFF), `Delta (0); + (0x0FE1A,0x0FE1F), `Delta (0); + (0x0FE53,0x0FE53), `Abs (0x0FE53); + (0x0FE67,0x0FE67), `Abs (0x0FE67); + (0x0FE6C,0x0FE6F), `Delta (0); + (0x0FE75,0x0FE75), `Abs (0x0FE75); + (0x0FEFD,0x0FEFE), `Delta (0); + (0x0FF00,0x0FF00), `Abs (0x0FF00); + (0x0FFBF,0x0FFC1), `Delta (0); + (0x0FFC8,0x0FFC9), `Delta (0); + (0x0FFD0,0x0FFD1), `Delta (0); + (0x0FFD8,0x0FFD9), `Delta (0); + (0x0FFDD,0x0FFDF), `Delta (0); + (0x0FFE7,0x0FFE7), `Abs (0x0FFE7); + (0x0FFEF,0x0FFF8), `Delta (0); + (0x0FFFE,0x0FFFF), `Delta (0); + (0x1000C,0x1000C), `Abs (0x1000C); + (0x10027,0x10027), `Abs (0x10027); + (0x1003B,0x1003B), `Abs (0x1003B); + (0x1003E,0x1003E), `Abs (0x1003E); + (0x1004E,0x1004F), `Delta (0); + (0x1005E,0x1007F), `Delta (0); + (0x100FB,0x100FF), `Delta (0); + (0x10103,0x10106), `Delta (0); + (0x10134,0x10136), `Delta (0); + (0x1018F,0x1018F), `Abs (0x1018F); + (0x1019C,0x1019F), `Delta (0); + (0x101A1,0x101CF), `Delta (0); + (0x101FE,0x1027F), `Delta (0); + (0x1029D,0x1029F), `Delta (0); + (0x102D1,0x102DF), `Delta (0); + (0x102FC,0x102FF), `Delta (0); + (0x10324,0x1032F), `Delta (0); + (0x1034B,0x1034F), `Delta (0); + (0x1037B,0x1037F), `Delta (0); + (0x1039E,0x1039E), `Abs (0x1039E); + (0x103C4,0x103C7), `Delta (0); + (0x103D6,0x103FF), `Delta (0); + (0x1049E,0x1049F), `Delta (0); + (0x104AA,0x104AF), `Delta (0); + (0x104D4,0x104D7), `Delta (0); + (0x104FC,0x104FF), `Delta (0); + (0x10528,0x1052F), `Delta (0); + (0x10564,0x1056E), `Delta (0); + (0x10570,0x105FF), `Delta (0); + (0x10737,0x1073F), `Delta (0); + (0x10756,0x1075F), `Delta (0); + (0x10768,0x107FF), `Delta (0); + (0x10806,0x10807), `Delta (0); + (0x10809,0x10809), `Abs (0x10809); + (0x10836,0x10836), `Abs (0x10836); + (0x10839,0x1083B), `Delta (0); + (0x1083D,0x1083E), `Delta (0); + (0x10856,0x10856), `Abs (0x10856); + (0x1089F,0x108A6), `Delta (0); + (0x108B0,0x108DF), `Delta (0); + (0x108F3,0x108F3), `Abs (0x108F3); + (0x108F6,0x108FA), `Delta (0); + (0x1091C,0x1091E), `Delta (0); + (0x1093A,0x1093E), `Delta (0); + (0x10940,0x1097F), `Delta (0); + (0x109B8,0x109BB), `Delta (0); + (0x109D0,0x109D1), `Delta (0); + (0x10A04,0x10A04), `Abs (0x10A04); + (0x10A07,0x10A0B), `Delta (0); + (0x10A14,0x10A14), `Abs (0x10A14); + (0x10A18,0x10A18), `Abs (0x10A18); + (0x10A34,0x10A37), `Delta (0); + (0x10A3B,0x10A3E), `Delta (0); + (0x10A48,0x10A4F), `Delta (0); + (0x10A59,0x10A5F), `Delta (0); + (0x10AA0,0x10ABF), `Delta (0); + (0x10AE7,0x10AEA), `Delta (0); + (0x10AF7,0x10AFF), `Delta (0); + (0x10B36,0x10B38), `Delta (0); + (0x10B56,0x10B57), `Delta (0); + (0x10B73,0x10B77), `Delta (0); + (0x10B92,0x10B98), `Delta (0); + (0x10B9D,0x10BA8), `Delta (0); + (0x10BB0,0x10BFF), `Delta (0); + (0x10C49,0x10C7F), `Delta (0); + (0x10CB3,0x10CBF), `Delta (0); + (0x10CF3,0x10CF9), `Delta (0); + (0x10D00,0x10E5F), `Delta (0); + (0x10E7F,0x10FFF), `Delta (0); + (0x1104E,0x11051), `Delta (0); + (0x11070,0x1107E), `Delta (0); + (0x110C2,0x110CF), `Delta (0); + (0x110E9,0x110EF), `Delta (0); + (0x110FA,0x110FF), `Delta (0); + (0x11135,0x11135), `Abs (0x11135); + (0x11144,0x1114F), `Delta (0); + (0x11177,0x1117F), `Delta (0); + (0x111CE,0x111CF), `Delta (0); + (0x111E0,0x111E0), `Abs (0x111E0); + (0x111F5,0x111FF), `Delta (0); + (0x11212,0x11212), `Abs (0x11212); + (0x1123F,0x1127F), `Delta (0); + (0x11287,0x11287), `Abs (0x11287); + (0x11289,0x11289), `Abs (0x11289); + (0x1128E,0x1128E), `Abs (0x1128E); + (0x1129E,0x1129E), `Abs (0x1129E); + (0x112AA,0x112AF), `Delta (0); + (0x112EB,0x112EF), `Delta (0); + (0x112FA,0x112FF), `Delta (0); + (0x11304,0x11304), `Abs (0x11304); + (0x1130D,0x1130E), `Delta (0); + (0x11311,0x11312), `Delta (0); + (0x11329,0x11329), `Abs (0x11329); + (0x11331,0x11331), `Abs (0x11331); + (0x11334,0x11334), `Abs (0x11334); + (0x1133A,0x1133B), `Delta (0); + (0x11345,0x11346), `Delta (0); + (0x11349,0x1134A), `Delta (0); + (0x1134E,0x1134F), `Delta (0); + (0x11351,0x11356), `Delta (0); + (0x11358,0x1135C), `Delta (0); + (0x11364,0x11365), `Delta (0); + (0x1136D,0x1136F), `Delta (0); + (0x11375,0x113FF), `Delta (0); + (0x1145A,0x1145A), `Abs (0x1145A); + (0x1145C,0x1145C), `Abs (0x1145C); + (0x1145E,0x1147F), `Delta (0); + (0x114C8,0x114CF), `Delta (0); + (0x114DA,0x1157F), `Delta (0); + (0x115B6,0x115B7), `Delta (0); + (0x115DE,0x115FF), `Delta (0); + (0x11645,0x1164F), `Delta (0); + (0x1165A,0x1165F), `Delta (0); + (0x1166D,0x1167F), `Delta (0); + (0x116B8,0x116BF), `Delta (0); + (0x116CA,0x116FF), `Delta (0); + (0x1171A,0x1171C), `Delta (0); + (0x1172C,0x1172F), `Delta (0); + (0x11740,0x1189F), `Delta (0); + (0x118F3,0x118FE), `Delta (0); + (0x11900,0x11ABF), `Delta (0); + (0x11AF9,0x11BFF), `Delta (0); + (0x11C09,0x11C09), `Abs (0x11C09); + (0x11C37,0x11C37), `Abs (0x11C37); + (0x11C46,0x11C4F), `Delta (0); + (0x11C6D,0x11C6F), `Delta (0); + (0x11C90,0x11C91), `Delta (0); + (0x11CA8,0x11CA8), `Abs (0x11CA8); + (0x11CB7,0x11FFF), `Delta (0); + (0x1239A,0x123FF), `Delta (0); + (0x1246F,0x1246F), `Abs (0x1246F); + (0x12475,0x1247F), `Delta (0); + (0x12544,0x12FFF), `Delta (0); + (0x1342F,0x143FF), `Delta (0); + (0x14647,0x167FF), `Delta (0); + (0x16A39,0x16A3F), `Delta (0); + (0x16A5F,0x16A5F), `Abs (0x16A5F); + (0x16A6A,0x16A6D), `Delta (0); + (0x16A70,0x16ACF), `Delta (0); + (0x16AEE,0x16AEF), `Delta (0); + (0x16AF6,0x16AFF), `Delta (0); + (0x16B46,0x16B4F), `Delta (0); + (0x16B5A,0x16B5A), `Abs (0x16B5A); + (0x16B62,0x16B62), `Abs (0x16B62); + (0x16B78,0x16B7C), `Delta (0); + (0x16B90,0x16EFF), `Delta (0); + (0x16F45,0x16F4F), `Delta (0); + (0x16F7F,0x16F8E), `Delta (0); + (0x16FA0,0x16FDF), `Delta (0); + (0x16FE1,0x16FFF), `Delta (0); + (0x187ED,0x187FF), `Delta (0); + (0x18AF3,0x1AFFF), `Delta (0); + (0x1B002,0x1BBFF), `Delta (0); + (0x1BC6B,0x1BC6F), `Delta (0); + (0x1BC7D,0x1BC7F), `Delta (0); + (0x1BC89,0x1BC8F), `Delta (0); + (0x1BC9A,0x1BC9B), `Delta (0); + (0x1BCA4,0x1CFFF), `Delta (0); + (0x1D0F6,0x1D0FF), `Delta (0); + (0x1D127,0x1D128), `Delta (0); + (0x1D1E9,0x1D1FF), `Delta (0); + (0x1D246,0x1D2FF), `Delta (0); + (0x1D357,0x1D35F), `Delta (0); + (0x1D372,0x1D3FF), `Delta (0); + (0x1D455,0x1D455), `Abs (0x1D455); + (0x1D49D,0x1D49D), `Abs (0x1D49D); + (0x1D4A0,0x1D4A1), `Delta (0); + (0x1D4A3,0x1D4A4), `Delta (0); + (0x1D4A7,0x1D4A8), `Delta (0); + (0x1D4AD,0x1D4AD), `Abs (0x1D4AD); + (0x1D4BA,0x1D4BA), `Abs (0x1D4BA); + (0x1D4BC,0x1D4BC), `Abs (0x1D4BC); + (0x1D4C4,0x1D4C4), `Abs (0x1D4C4); + (0x1D506,0x1D506), `Abs (0x1D506); + (0x1D50B,0x1D50C), `Delta (0); + (0x1D515,0x1D515), `Abs (0x1D515); + (0x1D51D,0x1D51D), `Abs (0x1D51D); + (0x1D53A,0x1D53A), `Abs (0x1D53A); + (0x1D53F,0x1D53F), `Abs (0x1D53F); + (0x1D545,0x1D545), `Abs (0x1D545); + (0x1D547,0x1D549), `Delta (0); + (0x1D551,0x1D551), `Abs (0x1D551); + (0x1D6A6,0x1D6A7), `Delta (0); + (0x1D7CC,0x1D7CD), `Delta (0); + (0x1DA8C,0x1DA9A), `Delta (0); + (0x1DAA0,0x1DAA0), `Abs (0x1DAA0); + (0x1DAB0,0x1DFFF), `Delta (0); + (0x1E007,0x1E007), `Abs (0x1E007); + (0x1E019,0x1E01A), `Delta (0); + (0x1E022,0x1E022), `Abs (0x1E022); + (0x1E025,0x1E025), `Abs (0x1E025); + (0x1E02B,0x1E7FF), `Delta (0); + (0x1E8C5,0x1E8C6), `Delta (0); + (0x1E8D7,0x1E8FF), `Delta (0); + (0x1E94B,0x1E94F), `Delta (0); + (0x1E95A,0x1E95D), `Delta (0); + (0x1E960,0x1EDFF), `Delta (0); + (0x1EE04,0x1EE04), `Abs (0x1EE04); + (0x1EE20,0x1EE20), `Abs (0x1EE20); + (0x1EE23,0x1EE23), `Abs (0x1EE23); + (0x1EE25,0x1EE26), `Delta (0); + (0x1EE28,0x1EE28), `Abs (0x1EE28); + (0x1EE33,0x1EE33), `Abs (0x1EE33); + (0x1EE38,0x1EE38), `Abs (0x1EE38); + (0x1EE3A,0x1EE3A), `Abs (0x1EE3A); + (0x1EE3C,0x1EE41), `Delta (0); + (0x1EE43,0x1EE46), `Delta (0); + (0x1EE48,0x1EE48), `Abs (0x1EE48); + (0x1EE4A,0x1EE4A), `Abs (0x1EE4A); + (0x1EE4C,0x1EE4C), `Abs (0x1EE4C); + (0x1EE50,0x1EE50), `Abs (0x1EE50); + (0x1EE53,0x1EE53), `Abs (0x1EE53); + (0x1EE55,0x1EE56), `Delta (0); + (0x1EE58,0x1EE58), `Abs (0x1EE58); + (0x1EE5A,0x1EE5A), `Abs (0x1EE5A); + (0x1EE5C,0x1EE5C), `Abs (0x1EE5C); + (0x1EE5E,0x1EE5E), `Abs (0x1EE5E); + (0x1EE60,0x1EE60), `Abs (0x1EE60); + (0x1EE63,0x1EE63), `Abs (0x1EE63); + (0x1EE65,0x1EE66), `Delta (0); + (0x1EE6B,0x1EE6B), `Abs (0x1EE6B); + (0x1EE73,0x1EE73), `Abs (0x1EE73); + (0x1EE78,0x1EE78), `Abs (0x1EE78); + (0x1EE7D,0x1EE7D), `Abs (0x1EE7D); + (0x1EE7F,0x1EE7F), `Abs (0x1EE7F); + (0x1EE8A,0x1EE8A), `Abs (0x1EE8A); + (0x1EE9C,0x1EEA0), `Delta (0); + (0x1EEA4,0x1EEA4), `Abs (0x1EEA4); + (0x1EEAA,0x1EEAA), `Abs (0x1EEAA); + (0x1EEBC,0x1EEEF), `Delta (0); + (0x1EEF2,0x1EFFF), `Delta (0); + (0x1F02C,0x1F02F), `Delta (0); + (0x1F094,0x1F09F), `Delta (0); + (0x1F0AF,0x1F0B0), `Delta (0); + (0x1F0C0,0x1F0C0), `Abs (0x1F0C0); + (0x1F0D0,0x1F0D0), `Abs (0x1F0D0); + (0x1F0F6,0x1F0FF), `Delta (0); + (0x1F10D,0x1F10F), `Delta (0); + (0x1F12F,0x1F12F), `Abs (0x1F12F); + (0x1F16C,0x1F16F), `Delta (0); + (0x1F1AD,0x1F1E5), `Delta (0); + (0x1F203,0x1F20F), `Delta (0); + (0x1F23C,0x1F23F), `Delta (0); + (0x1F249,0x1F24F), `Delta (0); + (0x1F252,0x1F2FF), `Delta (0); + (0x1F6D3,0x1F6DF), `Delta (0); + (0x1F6ED,0x1F6EF), `Delta (0); + (0x1F6F7,0x1F6FF), `Delta (0); + (0x1F774,0x1F77F), `Delta (0); + (0x1F7D5,0x1F7FF), `Delta (0); + (0x1F80C,0x1F80F), `Delta (0); + (0x1F848,0x1F84F), `Delta (0); + (0x1F85A,0x1F85F), `Delta (0); + (0x1F888,0x1F88F), `Delta (0); + (0x1F8AE,0x1F90F), `Delta (0); + (0x1F91F,0x1F91F), `Abs (0x1F91F); + (0x1F928,0x1F92F), `Delta (0); + (0x1F931,0x1F932), `Delta (0); + (0x1F93F,0x1F93F), `Abs (0x1F93F); + (0x1F94C,0x1F94F), `Delta (0); + (0x1F95F,0x1F97F), `Delta (0); + (0x1F992,0x1F9BF), `Delta (0); + (0x1F9C1,0x1FFFF), `Delta (0); + (0x2A6D7,0x2A6FF), `Delta (0); + (0x2B735,0x2B73F), `Delta (0); + (0x2B81E,0x2B81F), `Delta (0); + (0x2CEA2,0x2F7FF), `Delta (0); + (0x2FA1E,0xE0000), `Delta (0); + (0xE0002,0xE001F), `Delta (0); + (0xE0080,0xE00FF), `Delta (0); + (0xE01F0,0xEFFFF), `Delta (0); + (0xFFFFE,0xFFFFF), `Delta (0); + (0x10FFFE,0x10FFFF), `Delta (0); + (0x002B0,0x002C1), `Delta (0); + (0x002C6,0x002D1), `Delta (0); + (0x002E0,0x002E4), `Delta (0); + (0x002EC,0x002EC), `Abs (0x002EC); + (0x002EE,0x002EE), `Abs (0x002EE); + (0x00374,0x00374), `Abs (0x00374); + (0x0037A,0x0037A), `Abs (0x0037A); + (0x00559,0x00559), `Abs (0x00559); + (0x00640,0x00640), `Abs (0x00640); + (0x006E5,0x006E6), `Delta (0); + (0x007F4,0x007F5), `Delta (0); + (0x007FA,0x007FA), `Abs (0x007FA); + (0x0081A,0x0081A), `Abs (0x0081A); + (0x00824,0x00824), `Abs (0x00824); + (0x00828,0x00828), `Abs (0x00828); + (0x00971,0x00971), `Abs (0x00971); + (0x00E46,0x00E46), `Abs (0x00E46); + (0x00EC6,0x00EC6), `Abs (0x00EC6); + (0x010FC,0x010FC), `Abs (0x010FC); + (0x017D7,0x017D7), `Abs (0x017D7); + (0x01843,0x01843), `Abs (0x01843); + (0x01AA7,0x01AA7), `Abs (0x01AA7); + (0x01C78,0x01C7D), `Delta (0); + (0x01D2C,0x01D6A), `Delta (0); + (0x01D78,0x01D78), `Abs (0x01D78); + (0x01D9B,0x01DBF), `Delta (0); + (0x02071,0x02071), `Abs (0x02071); + (0x0207F,0x0207F), `Abs (0x0207F); + (0x02090,0x0209C), `Delta (0); + (0x02C7C,0x02C7D), `Delta (0); + (0x02D6F,0x02D6F), `Abs (0x02D6F); + (0x02E2F,0x02E2F), `Abs (0x02E2F); + (0x03005,0x03005), `Abs (0x03005); + (0x03031,0x03035), `Delta (0); + (0x0303B,0x0303B), `Abs (0x0303B); + (0x0309D,0x0309E), `Delta (0); + (0x030FC,0x030FE), `Delta (0); + (0x0A015,0x0A015), `Abs (0x0A015); + (0x0A4F8,0x0A4FD), `Delta (0); + (0x0A60C,0x0A60C), `Abs (0x0A60C); + (0x0A67F,0x0A67F), `Abs (0x0A67F); + (0x0A69C,0x0A69D), `Delta (0); + (0x0A717,0x0A71F), `Delta (0); + (0x0A770,0x0A770), `Abs (0x0A770); + (0x0A788,0x0A788), `Abs (0x0A788); + (0x0A7F8,0x0A7F9), `Delta (0); + (0x0A9CF,0x0A9CF), `Abs (0x0A9CF); + (0x0A9E6,0x0A9E6), `Abs (0x0A9E6); + (0x0AA70,0x0AA70), `Abs (0x0AA70); + (0x0AADD,0x0AADD), `Abs (0x0AADD); + (0x0AAF3,0x0AAF4), `Delta (0); + (0x0AB5C,0x0AB5F), `Delta (0); + (0x0FF70,0x0FF70), `Abs (0x0FF70); + (0x0FF9E,0x0FF9F), `Delta (0); + (0x16B40,0x16B43), `Delta (0); + (0x16F93,0x16F9F), `Delta (0); + (0x16FE0,0x16FE0), `Abs (0x16FE0); + (0x000AA,0x000AA), `Abs (0x000AA); + (0x000BA,0x000BA), `Abs (0x000BA); + (0x001BB,0x001BB), `Abs (0x001BB); + (0x001C0,0x001C3), `Delta (0); + (0x00294,0x00294), `Abs (0x00294); + (0x005D0,0x005EA), `Delta (0); + (0x005F0,0x005F2), `Delta (0); + (0x00620,0x0063F), `Delta (0); + (0x00641,0x0064A), `Delta (0); + (0x0066E,0x0066F), `Delta (0); + (0x00671,0x006D3), `Delta (0); + (0x006D5,0x006D5), `Abs (0x006D5); + (0x006EE,0x006EF), `Delta (0); + (0x006FA,0x006FC), `Delta (0); + (0x006FF,0x006FF), `Abs (0x006FF); + (0x00710,0x00710), `Abs (0x00710); + (0x00712,0x0072F), `Delta (0); + (0x0074D,0x007A5), `Delta (0); + (0x007B1,0x007B1), `Abs (0x007B1); + (0x007CA,0x007EA), `Delta (0); + (0x00800,0x00815), `Delta (0); + (0x00840,0x00858), `Delta (0); + (0x008A0,0x008B4), `Delta (0); + (0x008B6,0x008BD), `Delta (0); + (0x00904,0x00939), `Delta (0); + (0x0093D,0x0093D), `Abs (0x0093D); + (0x00950,0x00950), `Abs (0x00950); + (0x00958,0x00961), `Delta (0); + (0x00972,0x00980), `Delta (0); + (0x00985,0x0098C), `Delta (0); + (0x0098F,0x00990), `Delta (0); + (0x00993,0x009A8), `Delta (0); + (0x009AA,0x009B0), `Delta (0); + (0x009B2,0x009B2), `Abs (0x009B2); + (0x009B6,0x009B9), `Delta (0); + (0x009BD,0x009BD), `Abs (0x009BD); + (0x009CE,0x009CE), `Abs (0x009CE); + (0x009DC,0x009DD), `Delta (0); + (0x009DF,0x009E1), `Delta (0); + (0x009F0,0x009F1), `Delta (0); + (0x00A05,0x00A0A), `Delta (0); + (0x00A0F,0x00A10), `Delta (0); + (0x00A13,0x00A28), `Delta (0); + (0x00A2A,0x00A30), `Delta (0); + (0x00A32,0x00A33), `Delta (0); + (0x00A35,0x00A36), `Delta (0); + (0x00A38,0x00A39), `Delta (0); + (0x00A59,0x00A5C), `Delta (0); + (0x00A5E,0x00A5E), `Abs (0x00A5E); + (0x00A72,0x00A74), `Delta (0); + (0x00A85,0x00A8D), `Delta (0); + (0x00A8F,0x00A91), `Delta (0); + (0x00A93,0x00AA8), `Delta (0); + (0x00AAA,0x00AB0), `Delta (0); + (0x00AB2,0x00AB3), `Delta (0); + (0x00AB5,0x00AB9), `Delta (0); + (0x00ABD,0x00ABD), `Abs (0x00ABD); + (0x00AD0,0x00AD0), `Abs (0x00AD0); + (0x00AE0,0x00AE1), `Delta (0); + (0x00AF9,0x00AF9), `Abs (0x00AF9); + (0x00B05,0x00B0C), `Delta (0); + (0x00B0F,0x00B10), `Delta (0); + (0x00B13,0x00B28), `Delta (0); + (0x00B2A,0x00B30), `Delta (0); + (0x00B32,0x00B33), `Delta (0); + (0x00B35,0x00B39), `Delta (0); + (0x00B3D,0x00B3D), `Abs (0x00B3D); + (0x00B5C,0x00B5D), `Delta (0); + (0x00B5F,0x00B61), `Delta (0); + (0x00B71,0x00B71), `Abs (0x00B71); + (0x00B83,0x00B83), `Abs (0x00B83); + (0x00B85,0x00B8A), `Delta (0); + (0x00B8E,0x00B90), `Delta (0); + (0x00B92,0x00B95), `Delta (0); + (0x00B99,0x00B9A), `Delta (0); + (0x00B9C,0x00B9C), `Abs (0x00B9C); + (0x00B9E,0x00B9F), `Delta (0); + (0x00BA3,0x00BA4), `Delta (0); + (0x00BA8,0x00BAA), `Delta (0); + (0x00BAE,0x00BB9), `Delta (0); + (0x00BD0,0x00BD0), `Abs (0x00BD0); + (0x00C05,0x00C0C), `Delta (0); + (0x00C0E,0x00C10), `Delta (0); + (0x00C12,0x00C28), `Delta (0); + (0x00C2A,0x00C39), `Delta (0); + (0x00C3D,0x00C3D), `Abs (0x00C3D); + (0x00C58,0x00C5A), `Delta (0); + (0x00C60,0x00C61), `Delta (0); + (0x00C80,0x00C80), `Abs (0x00C80); + (0x00C85,0x00C8C), `Delta (0); + (0x00C8E,0x00C90), `Delta (0); + (0x00C92,0x00CA8), `Delta (0); + (0x00CAA,0x00CB3), `Delta (0); + (0x00CB5,0x00CB9), `Delta (0); + (0x00CBD,0x00CBD), `Abs (0x00CBD); + (0x00CDE,0x00CDE), `Abs (0x00CDE); + (0x00CE0,0x00CE1), `Delta (0); + (0x00CF1,0x00CF2), `Delta (0); + (0x00D05,0x00D0C), `Delta (0); + (0x00D0E,0x00D10), `Delta (0); + (0x00D12,0x00D3A), `Delta (0); + (0x00D3D,0x00D3D), `Abs (0x00D3D); + (0x00D4E,0x00D4E), `Abs (0x00D4E); + (0x00D54,0x00D56), `Delta (0); + (0x00D5F,0x00D61), `Delta (0); + (0x00D7A,0x00D7F), `Delta (0); + (0x00D85,0x00D96), `Delta (0); + (0x00D9A,0x00DB1), `Delta (0); + (0x00DB3,0x00DBB), `Delta (0); + (0x00DBD,0x00DBD), `Abs (0x00DBD); + (0x00DC0,0x00DC6), `Delta (0); + (0x00E01,0x00E30), `Delta (0); + (0x00E32,0x00E33), `Delta (0); + (0x00E40,0x00E45), `Delta (0); + (0x00E81,0x00E82), `Delta (0); + (0x00E84,0x00E84), `Abs (0x00E84); + (0x00E87,0x00E88), `Delta (0); + (0x00E8A,0x00E8A), `Abs (0x00E8A); + (0x00E8D,0x00E8D), `Abs (0x00E8D); + (0x00E94,0x00E97), `Delta (0); + (0x00E99,0x00E9F), `Delta (0); + (0x00EA1,0x00EA3), `Delta (0); + (0x00EA5,0x00EA5), `Abs (0x00EA5); + (0x00EA7,0x00EA7), `Abs (0x00EA7); + (0x00EAA,0x00EAB), `Delta (0); + (0x00EAD,0x00EB0), `Delta (0); + (0x00EB2,0x00EB3), `Delta (0); + (0x00EBD,0x00EBD), `Abs (0x00EBD); + (0x00EC0,0x00EC4), `Delta (0); + (0x00EDC,0x00EDF), `Delta (0); + (0x00F00,0x00F00), `Abs (0x00F00); + (0x00F40,0x00F47), `Delta (0); + (0x00F49,0x00F6C), `Delta (0); + (0x00F88,0x00F8C), `Delta (0); + (0x01000,0x0102A), `Delta (0); + (0x0103F,0x0103F), `Abs (0x0103F); + (0x01050,0x01055), `Delta (0); + (0x0105A,0x0105D), `Delta (0); + (0x01061,0x01061), `Abs (0x01061); + (0x01065,0x01066), `Delta (0); + (0x0106E,0x01070), `Delta (0); + (0x01075,0x01081), `Delta (0); + (0x0108E,0x0108E), `Abs (0x0108E); + (0x010D0,0x010FA), `Delta (0); + (0x010FD,0x01248), `Delta (0); + (0x0124A,0x0124D), `Delta (0); + (0x01250,0x01256), `Delta (0); + (0x01258,0x01258), `Abs (0x01258); + (0x0125A,0x0125D), `Delta (0); + (0x01260,0x01288), `Delta (0); + (0x0128A,0x0128D), `Delta (0); + (0x01290,0x012B0), `Delta (0); + (0x012B2,0x012B5), `Delta (0); + (0x012B8,0x012BE), `Delta (0); + (0x012C0,0x012C0), `Abs (0x012C0); + (0x012C2,0x012C5), `Delta (0); + (0x012C8,0x012D6), `Delta (0); + (0x012D8,0x01310), `Delta (0); + (0x01312,0x01315), `Delta (0); + (0x01318,0x0135A), `Delta (0); + (0x01380,0x0138F), `Delta (0); + (0x01401,0x0166C), `Delta (0); + (0x0166F,0x0167F), `Delta (0); + (0x01681,0x0169A), `Delta (0); + (0x016A0,0x016EA), `Delta (0); + (0x016F1,0x016F8), `Delta (0); + (0x01700,0x0170C), `Delta (0); + (0x0170E,0x01711), `Delta (0); + (0x01720,0x01731), `Delta (0); + (0x01740,0x01751), `Delta (0); + (0x01760,0x0176C), `Delta (0); + (0x0176E,0x01770), `Delta (0); + (0x01780,0x017B3), `Delta (0); + (0x017DC,0x017DC), `Abs (0x017DC); + (0x01820,0x01842), `Delta (0); + (0x01844,0x01877), `Delta (0); + (0x01880,0x01884), `Delta (0); + (0x01887,0x018A8), `Delta (0); + (0x018AA,0x018AA), `Abs (0x018AA); + (0x018B0,0x018F5), `Delta (0); + (0x01900,0x0191E), `Delta (0); + (0x01950,0x0196D), `Delta (0); + (0x01970,0x01974), `Delta (0); + (0x01980,0x019AB), `Delta (0); + (0x019B0,0x019C9), `Delta (0); + (0x01A00,0x01A16), `Delta (0); + (0x01A20,0x01A54), `Delta (0); + (0x01B05,0x01B33), `Delta (0); + (0x01B45,0x01B4B), `Delta (0); + (0x01B83,0x01BA0), `Delta (0); + (0x01BAE,0x01BAF), `Delta (0); + (0x01BBA,0x01BE5), `Delta (0); + (0x01C00,0x01C23), `Delta (0); + (0x01C4D,0x01C4F), `Delta (0); + (0x01C5A,0x01C77), `Delta (0); + (0x01CE9,0x01CEC), `Delta (0); + (0x01CEE,0x01CF1), `Delta (0); + (0x01CF5,0x01CF6), `Delta (0); + (0x02135,0x02138), `Delta (0); + (0x02D30,0x02D67), `Delta (0); + (0x02D80,0x02D96), `Delta (0); + (0x02DA0,0x02DA6), `Delta (0); + (0x02DA8,0x02DAE), `Delta (0); + (0x02DB0,0x02DB6), `Delta (0); + (0x02DB8,0x02DBE), `Delta (0); + (0x02DC0,0x02DC6), `Delta (0); + (0x02DC8,0x02DCE), `Delta (0); + (0x02DD0,0x02DD6), `Delta (0); + (0x02DD8,0x02DDE), `Delta (0); + (0x03006,0x03006), `Abs (0x03006); + (0x0303C,0x0303C), `Abs (0x0303C); + (0x03041,0x03096), `Delta (0); + (0x0309F,0x0309F), `Abs (0x0309F); + (0x030A1,0x030FA), `Delta (0); + (0x030FF,0x030FF), `Abs (0x030FF); + (0x03105,0x0312D), `Delta (0); + (0x03131,0x0318E), `Delta (0); + (0x031A0,0x031BA), `Delta (0); + (0x031F0,0x031FF), `Delta (0); + (0x03400,0x04DB5), `Delta (0); + (0x04E00,0x09FD5), `Delta (0); + (0x0A000,0x0A014), `Delta (0); + (0x0A016,0x0A48C), `Delta (0); + (0x0A4D0,0x0A4F7), `Delta (0); + (0x0A500,0x0A60B), `Delta (0); + (0x0A610,0x0A61F), `Delta (0); + (0x0A62A,0x0A62B), `Delta (0); + (0x0A66E,0x0A66E), `Abs (0x0A66E); + (0x0A6A0,0x0A6E5), `Delta (0); + (0x0A78F,0x0A78F), `Abs (0x0A78F); + (0x0A7F7,0x0A7F7), `Abs (0x0A7F7); + (0x0A7FB,0x0A801), `Delta (0); + (0x0A803,0x0A805), `Delta (0); + (0x0A807,0x0A80A), `Delta (0); + (0x0A80C,0x0A822), `Delta (0); + (0x0A840,0x0A873), `Delta (0); + (0x0A882,0x0A8B3), `Delta (0); + (0x0A8F2,0x0A8F7), `Delta (0); + (0x0A8FB,0x0A8FB), `Abs (0x0A8FB); + (0x0A8FD,0x0A8FD), `Abs (0x0A8FD); + (0x0A90A,0x0A925), `Delta (0); + (0x0A930,0x0A946), `Delta (0); + (0x0A960,0x0A97C), `Delta (0); + (0x0A984,0x0A9B2), `Delta (0); + (0x0A9E0,0x0A9E4), `Delta (0); + (0x0A9E7,0x0A9EF), `Delta (0); + (0x0A9FA,0x0A9FE), `Delta (0); + (0x0AA00,0x0AA28), `Delta (0); + (0x0AA40,0x0AA42), `Delta (0); + (0x0AA44,0x0AA4B), `Delta (0); + (0x0AA60,0x0AA6F), `Delta (0); + (0x0AA71,0x0AA76), `Delta (0); + (0x0AA7A,0x0AA7A), `Abs (0x0AA7A); + (0x0AA7E,0x0AAAF), `Delta (0); + (0x0AAB1,0x0AAB1), `Abs (0x0AAB1); + (0x0AAB5,0x0AAB6), `Delta (0); + (0x0AAB9,0x0AABD), `Delta (0); + (0x0AAC0,0x0AAC0), `Abs (0x0AAC0); + (0x0AAC2,0x0AAC2), `Abs (0x0AAC2); + (0x0AADB,0x0AADC), `Delta (0); + (0x0AAE0,0x0AAEA), `Delta (0); + (0x0AAF2,0x0AAF2), `Abs (0x0AAF2); + (0x0AB01,0x0AB06), `Delta (0); + (0x0AB09,0x0AB0E), `Delta (0); + (0x0AB11,0x0AB16), `Delta (0); + (0x0AB20,0x0AB26), `Delta (0); + (0x0AB28,0x0AB2E), `Delta (0); + (0x0ABC0,0x0ABE2), `Delta (0); + (0x0AC00,0x0D7A3), `Delta (0); + (0x0D7B0,0x0D7C6), `Delta (0); + (0x0D7CB,0x0D7FB), `Delta (0); + (0x0F900,0x0FA6D), `Delta (0); + (0x0FA70,0x0FAD9), `Delta (0); + (0x0FB1D,0x0FB1D), `Abs (0x0FB1D); + (0x0FB1F,0x0FB28), `Delta (0); + (0x0FB2A,0x0FB36), `Delta (0); + (0x0FB38,0x0FB3C), `Delta (0); + (0x0FB3E,0x0FB3E), `Abs (0x0FB3E); + (0x0FB40,0x0FB41), `Delta (0); + (0x0FB43,0x0FB44), `Delta (0); + (0x0FB46,0x0FBB1), `Delta (0); + (0x0FBD3,0x0FD3D), `Delta (0); + (0x0FD50,0x0FD8F), `Delta (0); + (0x0FD92,0x0FDC7), `Delta (0); + (0x0FDF0,0x0FDFB), `Delta (0); + (0x0FE70,0x0FE74), `Delta (0); + (0x0FE76,0x0FEFC), `Delta (0); + (0x0FF66,0x0FF6F), `Delta (0); + (0x0FF71,0x0FF9D), `Delta (0); + (0x0FFA0,0x0FFBE), `Delta (0); + (0x0FFC2,0x0FFC7), `Delta (0); + (0x0FFCA,0x0FFCF), `Delta (0); + (0x0FFD2,0x0FFD7), `Delta (0); + (0x0FFDA,0x0FFDC), `Delta (0); + (0x10000,0x1000B), `Delta (0); + (0x1000D,0x10026), `Delta (0); + (0x10028,0x1003A), `Delta (0); + (0x1003C,0x1003D), `Delta (0); + (0x1003F,0x1004D), `Delta (0); + (0x10050,0x1005D), `Delta (0); + (0x10080,0x100FA), `Delta (0); + (0x10280,0x1029C), `Delta (0); + (0x102A0,0x102D0), `Delta (0); + (0x10300,0x1031F), `Delta (0); + (0x10330,0x10340), `Delta (0); + (0x10342,0x10349), `Delta (0); + (0x10350,0x10375), `Delta (0); + (0x10380,0x1039D), `Delta (0); + (0x103A0,0x103C3), `Delta (0); + (0x103C8,0x103CF), `Delta (0); + (0x10450,0x1049D), `Delta (0); + (0x10500,0x10527), `Delta (0); + (0x10530,0x10563), `Delta (0); + (0x10600,0x10736), `Delta (0); + (0x10740,0x10755), `Delta (0); + (0x10760,0x10767), `Delta (0); + (0x10800,0x10805), `Delta (0); + (0x10808,0x10808), `Abs (0x10808); + (0x1080A,0x10835), `Delta (0); + (0x10837,0x10838), `Delta (0); + (0x1083C,0x1083C), `Abs (0x1083C); + (0x1083F,0x10855), `Delta (0); + (0x10860,0x10876), `Delta (0); + (0x10880,0x1089E), `Delta (0); + (0x108E0,0x108F2), `Delta (0); + (0x108F4,0x108F5), `Delta (0); + (0x10900,0x10915), `Delta (0); + (0x10920,0x10939), `Delta (0); + (0x10980,0x109B7), `Delta (0); + (0x109BE,0x109BF), `Delta (0); + (0x10A00,0x10A00), `Abs (0x10A00); + (0x10A10,0x10A13), `Delta (0); + (0x10A15,0x10A17), `Delta (0); + (0x10A19,0x10A33), `Delta (0); + (0x10A60,0x10A7C), `Delta (0); + (0x10A80,0x10A9C), `Delta (0); + (0x10AC0,0x10AC7), `Delta (0); + (0x10AC9,0x10AE4), `Delta (0); + (0x10B00,0x10B35), `Delta (0); + (0x10B40,0x10B55), `Delta (0); + (0x10B60,0x10B72), `Delta (0); + (0x10B80,0x10B91), `Delta (0); + (0x10C00,0x10C48), `Delta (0); + (0x11003,0x11037), `Delta (0); + (0x11083,0x110AF), `Delta (0); + (0x110D0,0x110E8), `Delta (0); + (0x11103,0x11126), `Delta (0); + (0x11150,0x11172), `Delta (0); + (0x11176,0x11176), `Abs (0x11176); + (0x11183,0x111B2), `Delta (0); + (0x111C1,0x111C4), `Delta (0); + (0x111DA,0x111DA), `Abs (0x111DA); + (0x111DC,0x111DC), `Abs (0x111DC); + (0x11200,0x11211), `Delta (0); + (0x11213,0x1122B), `Delta (0); + (0x11280,0x11286), `Delta (0); + (0x11288,0x11288), `Abs (0x11288); + (0x1128A,0x1128D), `Delta (0); + (0x1128F,0x1129D), `Delta (0); + (0x1129F,0x112A8), `Delta (0); + (0x112B0,0x112DE), `Delta (0); + (0x11305,0x1130C), `Delta (0); + (0x1130F,0x11310), `Delta (0); + (0x11313,0x11328), `Delta (0); + (0x1132A,0x11330), `Delta (0); + (0x11332,0x11333), `Delta (0); + (0x11335,0x11339), `Delta (0); + (0x1133D,0x1133D), `Abs (0x1133D); + (0x11350,0x11350), `Abs (0x11350); + (0x1135D,0x11361), `Delta (0); + (0x11400,0x11434), `Delta (0); + (0x11447,0x1144A), `Delta (0); + (0x11480,0x114AF), `Delta (0); + (0x114C4,0x114C5), `Delta (0); + (0x114C7,0x114C7), `Abs (0x114C7); + (0x11580,0x115AE), `Delta (0); + (0x115D8,0x115DB), `Delta (0); + (0x11600,0x1162F), `Delta (0); + (0x11644,0x11644), `Abs (0x11644); + (0x11680,0x116AA), `Delta (0); + (0x11700,0x11719), `Delta (0); + (0x118FF,0x118FF), `Abs (0x118FF); + (0x11AC0,0x11AF8), `Delta (0); + (0x11C00,0x11C08), `Delta (0); + (0x11C0A,0x11C2E), `Delta (0); + (0x11C40,0x11C40), `Abs (0x11C40); + (0x11C72,0x11C8F), `Delta (0); + (0x12000,0x12399), `Delta (0); + (0x12480,0x12543), `Delta (0); + (0x13000,0x1342E), `Delta (0); + (0x14400,0x14646), `Delta (0); + (0x16800,0x16A38), `Delta (0); + (0x16A40,0x16A5E), `Delta (0); + (0x16AD0,0x16AED), `Delta (0); + (0x16B00,0x16B2F), `Delta (0); + (0x16B63,0x16B77), `Delta (0); + (0x16B7D,0x16B8F), `Delta (0); + (0x16F00,0x16F44), `Delta (0); + (0x16F50,0x16F50), `Abs (0x16F50); + (0x17000,0x187EC), `Delta (0); + (0x18800,0x18AF2), `Delta (0); + (0x1B000,0x1B001), `Delta (0); + (0x1BC00,0x1BC6A), `Delta (0); + (0x1BC70,0x1BC7C), `Delta (0); + (0x1BC80,0x1BC88), `Delta (0); + (0x1BC90,0x1BC99), `Delta (0); + (0x1E800,0x1E8C4), `Delta (0); + (0x1EE00,0x1EE03), `Delta (0); + (0x1EE05,0x1EE1F), `Delta (0); + (0x1EE21,0x1EE22), `Delta (0); + (0x1EE24,0x1EE24), `Abs (0x1EE24); + (0x1EE27,0x1EE27), `Abs (0x1EE27); + (0x1EE29,0x1EE32), `Delta (0); + (0x1EE34,0x1EE37), `Delta (0); + (0x1EE39,0x1EE39), `Abs (0x1EE39); + (0x1EE3B,0x1EE3B), `Abs (0x1EE3B); + (0x1EE42,0x1EE42), `Abs (0x1EE42); + (0x1EE47,0x1EE47), `Abs (0x1EE47); + (0x1EE49,0x1EE49), `Abs (0x1EE49); + (0x1EE4B,0x1EE4B), `Abs (0x1EE4B); + (0x1EE4D,0x1EE4F), `Delta (0); + (0x1EE51,0x1EE52), `Delta (0); + (0x1EE54,0x1EE54), `Abs (0x1EE54); + (0x1EE57,0x1EE57), `Abs (0x1EE57); + (0x1EE59,0x1EE59), `Abs (0x1EE59); + (0x1EE5B,0x1EE5B), `Abs (0x1EE5B); + (0x1EE5D,0x1EE5D), `Abs (0x1EE5D); + (0x1EE5F,0x1EE5F), `Abs (0x1EE5F); + (0x1EE61,0x1EE62), `Delta (0); + (0x1EE64,0x1EE64), `Abs (0x1EE64); + (0x1EE67,0x1EE6A), `Delta (0); + (0x1EE6C,0x1EE72), `Delta (0); + (0x1EE74,0x1EE77), `Delta (0); + (0x1EE79,0x1EE7C), `Delta (0); + (0x1EE7E,0x1EE7E), `Abs (0x1EE7E); + (0x1EE80,0x1EE89), `Delta (0); + (0x1EE8B,0x1EE9B), `Delta (0); + (0x1EEA1,0x1EEA3), `Delta (0); + (0x1EEA5,0x1EEA9), `Delta (0); + (0x1EEAB,0x1EEBB), `Delta (0); + (0x20000,0x2A6D6), `Delta (0); + (0x2A700,0x2B734), `Delta (0); + (0x2B740,0x2B81D), `Delta (0); + (0x2B820,0x2CEA1), `Delta (0); + (0x2F800,0x2FA1D), `Delta (0); + (0x0005F,0x0005F), `Abs (0x0005F); + (0x0203F,0x02040), `Delta (0); + (0x02054,0x02054), `Abs (0x02054); + (0x0FE33,0x0FE34), `Delta (0); + (0x0FE4D,0x0FE4F), `Delta (0); + (0x0FF3F,0x0FF3F), `Abs (0x0FF3F); + (0x0002D,0x0002D), `Abs (0x0002D); + (0x0058A,0x0058A), `Abs (0x0058A); + (0x005BE,0x005BE), `Abs (0x005BE); + (0x01400,0x01400), `Abs (0x01400); + (0x01806,0x01806), `Abs (0x01806); + (0x02010,0x02015), `Delta (0); + (0x02E17,0x02E17), `Abs (0x02E17); + (0x02E1A,0x02E1A), `Abs (0x02E1A); + (0x02E3A,0x02E3B), `Delta (0); + (0x02E40,0x02E40), `Abs (0x02E40); + (0x0301C,0x0301C), `Abs (0x0301C); + (0x03030,0x03030), `Abs (0x03030); + (0x030A0,0x030A0), `Abs (0x030A0); + (0x0FE31,0x0FE32), `Delta (0); + (0x0FE58,0x0FE58), `Abs (0x0FE58); + (0x0FE63,0x0FE63), `Abs (0x0FE63); + (0x0FF0D,0x0FF0D), `Abs (0x0FF0D); + (0x00028,0x00028), `Abs (0x00028); + (0x0005B,0x0005B), `Abs (0x0005B); + (0x0007B,0x0007B), `Abs (0x0007B); + (0x00F3A,0x00F3A), `Abs (0x00F3A); + (0x00F3C,0x00F3C), `Abs (0x00F3C); + (0x0169B,0x0169B), `Abs (0x0169B); + (0x0201A,0x0201A), `Abs (0x0201A); + (0x0201E,0x0201E), `Abs (0x0201E); + (0x02045,0x02045), `Abs (0x02045); + (0x0207D,0x0207D), `Abs (0x0207D); + (0x0208D,0x0208D), `Abs (0x0208D); + (0x02308,0x02308), `Abs (0x02308); + (0x0230A,0x0230A), `Abs (0x0230A); + (0x02329,0x02329), `Abs (0x02329); + (0x02768,0x02768), `Abs (0x02768); + (0x0276A,0x0276A), `Abs (0x0276A); + (0x0276C,0x0276C), `Abs (0x0276C); + (0x0276E,0x0276E), `Abs (0x0276E); + (0x02770,0x02770), `Abs (0x02770); + (0x02772,0x02772), `Abs (0x02772); + (0x02774,0x02774), `Abs (0x02774); + (0x027C5,0x027C5), `Abs (0x027C5); + (0x027E6,0x027E6), `Abs (0x027E6); + (0x027E8,0x027E8), `Abs (0x027E8); + (0x027EA,0x027EA), `Abs (0x027EA); + (0x027EC,0x027EC), `Abs (0x027EC); + (0x027EE,0x027EE), `Abs (0x027EE); + (0x02983,0x02983), `Abs (0x02983); + (0x02985,0x02985), `Abs (0x02985); + (0x02987,0x02987), `Abs (0x02987); + (0x02989,0x02989), `Abs (0x02989); + (0x0298B,0x0298B), `Abs (0x0298B); + (0x0298D,0x0298D), `Abs (0x0298D); + (0x0298F,0x0298F), `Abs (0x0298F); + (0x02991,0x02991), `Abs (0x02991); + (0x02993,0x02993), `Abs (0x02993); + (0x02995,0x02995), `Abs (0x02995); + (0x02997,0x02997), `Abs (0x02997); + (0x029D8,0x029D8), `Abs (0x029D8); + (0x029DA,0x029DA), `Abs (0x029DA); + (0x029FC,0x029FC), `Abs (0x029FC); + (0x02E22,0x02E22), `Abs (0x02E22); + (0x02E24,0x02E24), `Abs (0x02E24); + (0x02E26,0x02E26), `Abs (0x02E26); + (0x02E28,0x02E28), `Abs (0x02E28); + (0x02E42,0x02E42), `Abs (0x02E42); + (0x03008,0x03008), `Abs (0x03008); + (0x0300A,0x0300A), `Abs (0x0300A); + (0x0300C,0x0300C), `Abs (0x0300C); + (0x0300E,0x0300E), `Abs (0x0300E); + (0x03010,0x03010), `Abs (0x03010); + (0x03014,0x03014), `Abs (0x03014); + (0x03016,0x03016), `Abs (0x03016); + (0x03018,0x03018), `Abs (0x03018); + (0x0301A,0x0301A), `Abs (0x0301A); + (0x0301D,0x0301D), `Abs (0x0301D); + (0x0FD3F,0x0FD3F), `Abs (0x0FD3F); + (0x0FE17,0x0FE17), `Abs (0x0FE17); + (0x0FE35,0x0FE35), `Abs (0x0FE35); + (0x0FE37,0x0FE37), `Abs (0x0FE37); + (0x0FE39,0x0FE39), `Abs (0x0FE39); + (0x0FE3B,0x0FE3B), `Abs (0x0FE3B); + (0x0FE3D,0x0FE3D), `Abs (0x0FE3D); + (0x0FE3F,0x0FE3F), `Abs (0x0FE3F); + (0x0FE41,0x0FE41), `Abs (0x0FE41); + (0x0FE43,0x0FE43), `Abs (0x0FE43); + (0x0FE47,0x0FE47), `Abs (0x0FE47); + (0x0FE59,0x0FE59), `Abs (0x0FE59); + (0x0FE5B,0x0FE5B), `Abs (0x0FE5B); + (0x0FE5D,0x0FE5D), `Abs (0x0FE5D); + (0x0FF08,0x0FF08), `Abs (0x0FF08); + (0x0FF3B,0x0FF3B), `Abs (0x0FF3B); + (0x0FF5B,0x0FF5B), `Abs (0x0FF5B); + (0x0FF5F,0x0FF5F), `Abs (0x0FF5F); + (0x0FF62,0x0FF62), `Abs (0x0FF62); + (0x00029,0x00029), `Abs (0x00029); + (0x0005D,0x0005D), `Abs (0x0005D); + (0x0007D,0x0007D), `Abs (0x0007D); + (0x00F3B,0x00F3B), `Abs (0x00F3B); + (0x00F3D,0x00F3D), `Abs (0x00F3D); + (0x0169C,0x0169C), `Abs (0x0169C); + (0x02046,0x02046), `Abs (0x02046); + (0x0207E,0x0207E), `Abs (0x0207E); + (0x0208E,0x0208E), `Abs (0x0208E); + (0x02309,0x02309), `Abs (0x02309); + (0x0230B,0x0230B), `Abs (0x0230B); + (0x0232A,0x0232A), `Abs (0x0232A); + (0x02769,0x02769), `Abs (0x02769); + (0x0276B,0x0276B), `Abs (0x0276B); + (0x0276D,0x0276D), `Abs (0x0276D); + (0x0276F,0x0276F), `Abs (0x0276F); + (0x02771,0x02771), `Abs (0x02771); + (0x02773,0x02773), `Abs (0x02773); + (0x02775,0x02775), `Abs (0x02775); + (0x027C6,0x027C6), `Abs (0x027C6); + (0x027E7,0x027E7), `Abs (0x027E7); + (0x027E9,0x027E9), `Abs (0x027E9); + (0x027EB,0x027EB), `Abs (0x027EB); + (0x027ED,0x027ED), `Abs (0x027ED); + (0x027EF,0x027EF), `Abs (0x027EF); + (0x02984,0x02984), `Abs (0x02984); + (0x02986,0x02986), `Abs (0x02986); + (0x02988,0x02988), `Abs (0x02988); + (0x0298A,0x0298A), `Abs (0x0298A); + (0x0298C,0x0298C), `Abs (0x0298C); + (0x0298E,0x0298E), `Abs (0x0298E); + (0x02990,0x02990), `Abs (0x02990); + (0x02992,0x02992), `Abs (0x02992); + (0x02994,0x02994), `Abs (0x02994); + (0x02996,0x02996), `Abs (0x02996); + (0x02998,0x02998), `Abs (0x02998); + (0x029D9,0x029D9), `Abs (0x029D9); + (0x029DB,0x029DB), `Abs (0x029DB); + (0x029FD,0x029FD), `Abs (0x029FD); + (0x02E23,0x02E23), `Abs (0x02E23); + (0x02E25,0x02E25), `Abs (0x02E25); + (0x02E27,0x02E27), `Abs (0x02E27); + (0x02E29,0x02E29), `Abs (0x02E29); + (0x03009,0x03009), `Abs (0x03009); + (0x0300B,0x0300B), `Abs (0x0300B); + (0x0300D,0x0300D), `Abs (0x0300D); + (0x0300F,0x0300F), `Abs (0x0300F); + (0x03011,0x03011), `Abs (0x03011); + (0x03015,0x03015), `Abs (0x03015); + (0x03017,0x03017), `Abs (0x03017); + (0x03019,0x03019), `Abs (0x03019); + (0x0301B,0x0301B), `Abs (0x0301B); + (0x0301E,0x0301F), `Delta (0); + (0x0FD3E,0x0FD3E), `Abs (0x0FD3E); + (0x0FE18,0x0FE18), `Abs (0x0FE18); + (0x0FE36,0x0FE36), `Abs (0x0FE36); + (0x0FE38,0x0FE38), `Abs (0x0FE38); + (0x0FE3A,0x0FE3A), `Abs (0x0FE3A); + (0x0FE3C,0x0FE3C), `Abs (0x0FE3C); + (0x0FE3E,0x0FE3E), `Abs (0x0FE3E); + (0x0FE40,0x0FE40), `Abs (0x0FE40); + (0x0FE42,0x0FE42), `Abs (0x0FE42); + (0x0FE44,0x0FE44), `Abs (0x0FE44); + (0x0FE48,0x0FE48), `Abs (0x0FE48); + (0x0FE5A,0x0FE5A), `Abs (0x0FE5A); + (0x0FE5C,0x0FE5C), `Abs (0x0FE5C); + (0x0FE5E,0x0FE5E), `Abs (0x0FE5E); + (0x0FF09,0x0FF09), `Abs (0x0FF09); + (0x0FF3D,0x0FF3D), `Abs (0x0FF3D); + (0x0FF5D,0x0FF5D), `Abs (0x0FF5D); + (0x0FF60,0x0FF60), `Abs (0x0FF60); + (0x0FF63,0x0FF63), `Abs (0x0FF63); + (0x000AB,0x000AB), `Abs (0x000AB); + (0x02018,0x02018), `Abs (0x02018); + (0x0201B,0x0201C), `Delta (0); + (0x0201F,0x0201F), `Abs (0x0201F); + (0x02039,0x02039), `Abs (0x02039); + (0x02E02,0x02E02), `Abs (0x02E02); + (0x02E04,0x02E04), `Abs (0x02E04); + (0x02E09,0x02E09), `Abs (0x02E09); + (0x02E0C,0x02E0C), `Abs (0x02E0C); + (0x02E1C,0x02E1C), `Abs (0x02E1C); + (0x02E20,0x02E20), `Abs (0x02E20); + (0x000BB,0x000BB), `Abs (0x000BB); + (0x02019,0x02019), `Abs (0x02019); + (0x0201D,0x0201D), `Abs (0x0201D); + (0x0203A,0x0203A), `Abs (0x0203A); + (0x02E03,0x02E03), `Abs (0x02E03); + (0x02E05,0x02E05), `Abs (0x02E05); + (0x02E0A,0x02E0A), `Abs (0x02E0A); + (0x02E0D,0x02E0D), `Abs (0x02E0D); + (0x02E1D,0x02E1D), `Abs (0x02E1D); + (0x02E21,0x02E21), `Abs (0x02E21); + (0x00021,0x00023), `Delta (0); + (0x00025,0x00027), `Delta (0); + (0x0002A,0x0002A), `Abs (0x0002A); + (0x0002C,0x0002C), `Abs (0x0002C); + (0x0002E,0x0002F), `Delta (0); + (0x0003A,0x0003B), `Delta (0); + (0x0003F,0x00040), `Delta (0); + (0x0005C,0x0005C), `Abs (0x0005C); + (0x000A1,0x000A1), `Abs (0x000A1); + (0x000A7,0x000A7), `Abs (0x000A7); + (0x000B6,0x000B7), `Delta (0); + (0x000BF,0x000BF), `Abs (0x000BF); + (0x0037E,0x0037E), `Abs (0x0037E); + (0x00387,0x00387), `Abs (0x00387); + (0x0055A,0x0055F), `Delta (0); + (0x00589,0x00589), `Abs (0x00589); + (0x005C0,0x005C0), `Abs (0x005C0); + (0x005C3,0x005C3), `Abs (0x005C3); + (0x005C6,0x005C6), `Abs (0x005C6); + (0x005F3,0x005F4), `Delta (0); + (0x00609,0x0060A), `Delta (0); + (0x0060C,0x0060D), `Delta (0); + (0x0061B,0x0061B), `Abs (0x0061B); + (0x0061E,0x0061F), `Delta (0); + (0x0066A,0x0066D), `Delta (0); + (0x006D4,0x006D4), `Abs (0x006D4); + (0x00700,0x0070D), `Delta (0); + (0x007F7,0x007F9), `Delta (0); + (0x00830,0x0083E), `Delta (0); + (0x0085E,0x0085E), `Abs (0x0085E); + (0x00964,0x00965), `Delta (0); + (0x00970,0x00970), `Abs (0x00970); + (0x00AF0,0x00AF0), `Abs (0x00AF0); + (0x00DF4,0x00DF4), `Abs (0x00DF4); + (0x00E4F,0x00E4F), `Abs (0x00E4F); + (0x00E5A,0x00E5B), `Delta (0); + (0x00F04,0x00F12), `Delta (0); + (0x00F14,0x00F14), `Abs (0x00F14); + (0x00F85,0x00F85), `Abs (0x00F85); + (0x00FD0,0x00FD4), `Delta (0); + (0x00FD9,0x00FDA), `Delta (0); + (0x0104A,0x0104F), `Delta (0); + (0x010FB,0x010FB), `Abs (0x010FB); + (0x01360,0x01368), `Delta (0); + (0x0166D,0x0166E), `Delta (0); + (0x016EB,0x016ED), `Delta (0); + (0x01735,0x01736), `Delta (0); + (0x017D4,0x017D6), `Delta (0); + (0x017D8,0x017DA), `Delta (0); + (0x01800,0x01805), `Delta (0); + (0x01807,0x0180A), `Delta (0); + (0x01944,0x01945), `Delta (0); + (0x01A1E,0x01A1F), `Delta (0); + (0x01AA0,0x01AA6), `Delta (0); + (0x01AA8,0x01AAD), `Delta (0); + (0x01B5A,0x01B60), `Delta (0); + (0x01BFC,0x01BFF), `Delta (0); + (0x01C3B,0x01C3F), `Delta (0); + (0x01C7E,0x01C7F), `Delta (0); + (0x01CC0,0x01CC7), `Delta (0); + (0x01CD3,0x01CD3), `Abs (0x01CD3); + (0x02016,0x02017), `Delta (0); + (0x02020,0x02027), `Delta (0); + (0x02030,0x02038), `Delta (0); + (0x0203B,0x0203E), `Delta (0); + (0x02041,0x02043), `Delta (0); + (0x02047,0x02051), `Delta (0); + (0x02053,0x02053), `Abs (0x02053); + (0x02055,0x0205E), `Delta (0); + (0x02CF9,0x02CFC), `Delta (0); + (0x02CFE,0x02CFF), `Delta (0); + (0x02D70,0x02D70), `Abs (0x02D70); + (0x02E00,0x02E01), `Delta (0); + (0x02E06,0x02E08), `Delta (0); + (0x02E0B,0x02E0B), `Abs (0x02E0B); + (0x02E0E,0x02E16), `Delta (0); + (0x02E18,0x02E19), `Delta (0); + (0x02E1B,0x02E1B), `Abs (0x02E1B); + (0x02E1E,0x02E1F), `Delta (0); + (0x02E2A,0x02E2E), `Delta (0); + (0x02E30,0x02E39), `Delta (0); + (0x02E3C,0x02E3F), `Delta (0); + (0x02E41,0x02E41), `Abs (0x02E41); + (0x02E43,0x02E44), `Delta (0); + (0x03001,0x03003), `Delta (0); + (0x0303D,0x0303D), `Abs (0x0303D); + (0x030FB,0x030FB), `Abs (0x030FB); + (0x0A4FE,0x0A4FF), `Delta (0); + (0x0A60D,0x0A60F), `Delta (0); + (0x0A673,0x0A673), `Abs (0x0A673); + (0x0A67E,0x0A67E), `Abs (0x0A67E); + (0x0A6F2,0x0A6F7), `Delta (0); + (0x0A874,0x0A877), `Delta (0); + (0x0A8CE,0x0A8CF), `Delta (0); + (0x0A8F8,0x0A8FA), `Delta (0); + (0x0A8FC,0x0A8FC), `Abs (0x0A8FC); + (0x0A92E,0x0A92F), `Delta (0); + (0x0A95F,0x0A95F), `Abs (0x0A95F); + (0x0A9C1,0x0A9CD), `Delta (0); + (0x0A9DE,0x0A9DF), `Delta (0); + (0x0AA5C,0x0AA5F), `Delta (0); + (0x0AADE,0x0AADF), `Delta (0); + (0x0AAF0,0x0AAF1), `Delta (0); + (0x0ABEB,0x0ABEB), `Abs (0x0ABEB); + (0x0FE10,0x0FE16), `Delta (0); + (0x0FE19,0x0FE19), `Abs (0x0FE19); + (0x0FE30,0x0FE30), `Abs (0x0FE30); + (0x0FE45,0x0FE46), `Delta (0); + (0x0FE49,0x0FE4C), `Delta (0); + (0x0FE50,0x0FE52), `Delta (0); + (0x0FE54,0x0FE57), `Delta (0); + (0x0FE5F,0x0FE61), `Delta (0); + (0x0FE68,0x0FE68), `Abs (0x0FE68); + (0x0FE6A,0x0FE6B), `Delta (0); + (0x0FF01,0x0FF03), `Delta (0); + (0x0FF05,0x0FF07), `Delta (0); + (0x0FF0A,0x0FF0A), `Abs (0x0FF0A); + (0x0FF0C,0x0FF0C), `Abs (0x0FF0C); + (0x0FF0E,0x0FF0F), `Delta (0); + (0x0FF1A,0x0FF1B), `Delta (0); + (0x0FF1F,0x0FF20), `Delta (0); + (0x0FF3C,0x0FF3C), `Abs (0x0FF3C); + (0x0FF61,0x0FF61), `Abs (0x0FF61); + (0x0FF64,0x0FF65), `Delta (0); + (0x10100,0x10102), `Delta (0); + (0x1039F,0x1039F), `Abs (0x1039F); + (0x103D0,0x103D0), `Abs (0x103D0); + (0x1056F,0x1056F), `Abs (0x1056F); + (0x10857,0x10857), `Abs (0x10857); + (0x1091F,0x1091F), `Abs (0x1091F); + (0x1093F,0x1093F), `Abs (0x1093F); + (0x10A50,0x10A58), `Delta (0); + (0x10A7F,0x10A7F), `Abs (0x10A7F); + (0x10AF0,0x10AF6), `Delta (0); + (0x10B39,0x10B3F), `Delta (0); + (0x10B99,0x10B9C), `Delta (0); + (0x11047,0x1104D), `Delta (0); + (0x110BB,0x110BC), `Delta (0); + (0x110BE,0x110C1), `Delta (0); + (0x11140,0x11143), `Delta (0); + (0x11174,0x11175), `Delta (0); + (0x111C5,0x111C9), `Delta (0); + (0x111CD,0x111CD), `Abs (0x111CD); + (0x111DB,0x111DB), `Abs (0x111DB); + (0x111DD,0x111DF), `Delta (0); + (0x11238,0x1123D), `Delta (0); + (0x112A9,0x112A9), `Abs (0x112A9); + (0x1144B,0x1144F), `Delta (0); + (0x1145B,0x1145B), `Abs (0x1145B); + (0x1145D,0x1145D), `Abs (0x1145D); + (0x114C6,0x114C6), `Abs (0x114C6); + (0x115C1,0x115D7), `Delta (0); + (0x11641,0x11643), `Delta (0); + (0x11660,0x1166C), `Delta (0); + (0x1173C,0x1173E), `Delta (0); + (0x11C41,0x11C45), `Delta (0); + (0x11C70,0x11C71), `Delta (0); + (0x12470,0x12474), `Delta (0); + (0x16A6E,0x16A6F), `Delta (0); + (0x16AF5,0x16AF5), `Abs (0x16AF5); + (0x16B37,0x16B3B), `Delta (0); + (0x16B44,0x16B44), `Abs (0x16B44); + (0x1BC9F,0x1BC9F), `Abs (0x1BC9F); + (0x1DA87,0x1DA8B), `Delta (0); + (0x1E95E,0x1E95F), `Delta (0); + (0x0002B,0x0002B), `Abs (0x0002B); + (0x0003C,0x0003E), `Delta (0); + (0x0007C,0x0007C), `Abs (0x0007C); + (0x0007E,0x0007E), `Abs (0x0007E); + (0x000AC,0x000AC), `Abs (0x000AC); + (0x000B1,0x000B1), `Abs (0x000B1); + (0x000D7,0x000D7), `Abs (0x000D7); + (0x000F7,0x000F7), `Abs (0x000F7); + (0x003F6,0x003F6), `Abs (0x003F6); + (0x00606,0x00608), `Delta (0); + (0x02044,0x02044), `Abs (0x02044); + (0x02052,0x02052), `Abs (0x02052); + (0x0207A,0x0207C), `Delta (0); + (0x0208A,0x0208C), `Delta (0); + (0x02118,0x02118), `Abs (0x02118); + (0x02140,0x02144), `Delta (0); + (0x0214B,0x0214B), `Abs (0x0214B); + (0x02190,0x02194), `Delta (0); + (0x0219A,0x0219B), `Delta (0); + (0x021A0,0x021A0), `Abs (0x021A0); + (0x021A3,0x021A3), `Abs (0x021A3); + (0x021A6,0x021A6), `Abs (0x021A6); + (0x021AE,0x021AE), `Abs (0x021AE); + (0x021CE,0x021CF), `Delta (0); + (0x021D2,0x021D2), `Abs (0x021D2); + (0x021D4,0x021D4), `Abs (0x021D4); + (0x021F4,0x022FF), `Delta (0); + (0x02320,0x02321), `Delta (0); + (0x0237C,0x0237C), `Abs (0x0237C); + (0x0239B,0x023B3), `Delta (0); + (0x023DC,0x023E1), `Delta (0); + (0x025B7,0x025B7), `Abs (0x025B7); + (0x025C1,0x025C1), `Abs (0x025C1); + (0x025F8,0x025FF), `Delta (0); + (0x0266F,0x0266F), `Abs (0x0266F); + (0x027C0,0x027C4), `Delta (0); + (0x027C7,0x027E5), `Delta (0); + (0x027F0,0x027FF), `Delta (0); + (0x02900,0x02982), `Delta (0); + (0x02999,0x029D7), `Delta (0); + (0x029DC,0x029FB), `Delta (0); + (0x029FE,0x02AFF), `Delta (0); + (0x02B30,0x02B44), `Delta (0); + (0x02B47,0x02B4C), `Delta (0); + (0x0FB29,0x0FB29), `Abs (0x0FB29); + (0x0FE62,0x0FE62), `Abs (0x0FE62); + (0x0FE64,0x0FE66), `Delta (0); + (0x0FF0B,0x0FF0B), `Abs (0x0FF0B); + (0x0FF1C,0x0FF1E), `Delta (0); + (0x0FF5C,0x0FF5C), `Abs (0x0FF5C); + (0x0FF5E,0x0FF5E), `Abs (0x0FF5E); + (0x0FFE2,0x0FFE2), `Abs (0x0FFE2); + (0x0FFE9,0x0FFEC), `Delta (0); + (0x1D6C1,0x1D6C1), `Abs (0x1D6C1); + (0x1D6DB,0x1D6DB), `Abs (0x1D6DB); + (0x1D6FB,0x1D6FB), `Abs (0x1D6FB); + (0x1D715,0x1D715), `Abs (0x1D715); + (0x1D735,0x1D735), `Abs (0x1D735); + (0x1D74F,0x1D74F), `Abs (0x1D74F); + (0x1D76F,0x1D76F), `Abs (0x1D76F); + (0x1D789,0x1D789), `Abs (0x1D789); + (0x1D7A9,0x1D7A9), `Abs (0x1D7A9); + (0x1D7C3,0x1D7C3), `Abs (0x1D7C3); + (0x1EEF0,0x1EEF1), `Delta (0); + (0x00024,0x00024), `Abs (0x00024); + (0x000A2,0x000A5), `Delta (0); + (0x0058F,0x0058F), `Abs (0x0058F); + (0x0060B,0x0060B), `Abs (0x0060B); + (0x009F2,0x009F3), `Delta (0); + (0x009FB,0x009FB), `Abs (0x009FB); + (0x00AF1,0x00AF1), `Abs (0x00AF1); + (0x00BF9,0x00BF9), `Abs (0x00BF9); + (0x00E3F,0x00E3F), `Abs (0x00E3F); + (0x017DB,0x017DB), `Abs (0x017DB); + (0x020A0,0x020BE), `Delta (0); + (0x0A838,0x0A838), `Abs (0x0A838); + (0x0FDFC,0x0FDFC), `Abs (0x0FDFC); + (0x0FE69,0x0FE69), `Abs (0x0FE69); + (0x0FF04,0x0FF04), `Abs (0x0FF04); + (0x0FFE0,0x0FFE1), `Delta (0); + (0x0FFE5,0x0FFE6), `Delta (0); + (0x0005E,0x0005E), `Abs (0x0005E); + (0x00060,0x00060), `Abs (0x00060); + (0x000A8,0x000A8), `Abs (0x000A8); + (0x000AF,0x000AF), `Abs (0x000AF); + (0x000B4,0x000B4), `Abs (0x000B4); + (0x000B8,0x000B8), `Abs (0x000B8); + (0x002C2,0x002C5), `Delta (0); + (0x002D2,0x002DF), `Delta (0); + (0x002E5,0x002EB), `Delta (0); + (0x002ED,0x002ED), `Abs (0x002ED); + (0x002EF,0x002FF), `Delta (0); + (0x00375,0x00375), `Abs (0x00375); + (0x00384,0x00385), `Delta (0); + (0x01FBD,0x01FBD), `Abs (0x01FBD); + (0x01FBF,0x01FC1), `Delta (0); + (0x01FCD,0x01FCF), `Delta (0); + (0x01FDD,0x01FDF), `Delta (0); + (0x01FED,0x01FEF), `Delta (0); + (0x01FFD,0x01FFE), `Delta (0); + (0x0309B,0x0309C), `Delta (0); + (0x0A700,0x0A716), `Delta (0); + (0x0A720,0x0A721), `Delta (0); + (0x0A789,0x0A78A), `Delta (0); + (0x0AB5B,0x0AB5B), `Abs (0x0AB5B); + (0x0FBB2,0x0FBC1), `Delta (0); + (0x0FF3E,0x0FF3E), `Abs (0x0FF3E); + (0x0FF40,0x0FF40), `Abs (0x0FF40); + (0x0FFE3,0x0FFE3), `Abs (0x0FFE3); + (0x1F3FB,0x1F3FF), `Delta (0); + (0x000A6,0x000A6), `Abs (0x000A6); + (0x000A9,0x000A9), `Abs (0x000A9); + (0x000AE,0x000AE), `Abs (0x000AE); + (0x000B0,0x000B0), `Abs (0x000B0); + (0x00482,0x00482), `Abs (0x00482); + (0x0058D,0x0058E), `Delta (0); + (0x0060E,0x0060F), `Delta (0); + (0x006DE,0x006DE), `Abs (0x006DE); + (0x006E9,0x006E9), `Abs (0x006E9); + (0x006FD,0x006FE), `Delta (0); + (0x007F6,0x007F6), `Abs (0x007F6); + (0x009FA,0x009FA), `Abs (0x009FA); + (0x00B70,0x00B70), `Abs (0x00B70); + (0x00BF3,0x00BF8), `Delta (0); + (0x00BFA,0x00BFA), `Abs (0x00BFA); + (0x00C7F,0x00C7F), `Abs (0x00C7F); + (0x00D4F,0x00D4F), `Abs (0x00D4F); + (0x00D79,0x00D79), `Abs (0x00D79); + (0x00F01,0x00F03), `Delta (0); + (0x00F13,0x00F13), `Abs (0x00F13); + (0x00F15,0x00F17), `Delta (0); + (0x00F1A,0x00F1F), `Delta (0); + (0x00F34,0x00F34), `Abs (0x00F34); + (0x00F36,0x00F36), `Abs (0x00F36); + (0x00F38,0x00F38), `Abs (0x00F38); + (0x00FBE,0x00FC5), `Delta (0); + (0x00FC7,0x00FCC), `Delta (0); + (0x00FCE,0x00FCF), `Delta (0); + (0x00FD5,0x00FD8), `Delta (0); + (0x0109E,0x0109F), `Delta (0); + (0x01390,0x01399), `Delta (0); + (0x01940,0x01940), `Abs (0x01940); + (0x019DE,0x019FF), `Delta (0); + (0x01B61,0x01B6A), `Delta (0); + (0x01B74,0x01B7C), `Delta (0); + (0x02100,0x02101), `Delta (0); + (0x02103,0x02106), `Delta (0); + (0x02108,0x02109), `Delta (0); + (0x02114,0x02114), `Abs (0x02114); + (0x02116,0x02117), `Delta (0); + (0x0211E,0x02123), `Delta (0); + (0x02125,0x02125), `Abs (0x02125); + (0x02127,0x02127), `Abs (0x02127); + (0x02129,0x02129), `Abs (0x02129); + (0x0212E,0x0212E), `Abs (0x0212E); + (0x0213A,0x0213B), `Delta (0); + (0x0214A,0x0214A), `Abs (0x0214A); + (0x0214C,0x0214D), `Delta (0); + (0x0214F,0x0214F), `Abs (0x0214F); + (0x0218A,0x0218B), `Delta (0); + (0x02195,0x02199), `Delta (0); + (0x0219C,0x0219F), `Delta (0); + (0x021A1,0x021A2), `Delta (0); + (0x021A4,0x021A5), `Delta (0); + (0x021A7,0x021AD), `Delta (0); + (0x021AF,0x021CD), `Delta (0); + (0x021D0,0x021D1), `Delta (0); + (0x021D3,0x021D3), `Abs (0x021D3); + (0x021D5,0x021F3), `Delta (0); + (0x02300,0x02307), `Delta (0); + (0x0230C,0x0231F), `Delta (0); + (0x02322,0x02328), `Delta (0); + (0x0232B,0x0237B), `Delta (0); + (0x0237D,0x0239A), `Delta (0); + (0x023B4,0x023DB), `Delta (0); + (0x023E2,0x023FE), `Delta (0); + (0x02400,0x02426), `Delta (0); + (0x02440,0x0244A), `Delta (0); + (0x0249C,0x024B5), `Delta (0); + (0x024B6,0x024CF), `Delta (26); + (0x024D0,0x024E9), `Delta (0); + (0x02500,0x025B6), `Delta (0); + (0x025B8,0x025C0), `Delta (0); + (0x025C2,0x025F7), `Delta (0); + (0x02600,0x0266E), `Delta (0); + (0x02670,0x02767), `Delta (0); + (0x02794,0x027BF), `Delta (0); + (0x02800,0x028FF), `Delta (0); + (0x02B00,0x02B2F), `Delta (0); + (0x02B45,0x02B46), `Delta (0); + (0x02B4D,0x02B73), `Delta (0); + (0x02B76,0x02B95), `Delta (0); + (0x02B98,0x02BB9), `Delta (0); + (0x02BBD,0x02BC8), `Delta (0); + (0x02BCA,0x02BD1), `Delta (0); + (0x02BEC,0x02BEF), `Delta (0); + (0x02CE5,0x02CEA), `Delta (0); + (0x02E80,0x02E99), `Delta (0); + (0x02E9B,0x02EF3), `Delta (0); + (0x02F00,0x02FD5), `Delta (0); + (0x02FF0,0x02FFB), `Delta (0); + (0x03004,0x03004), `Abs (0x03004); + (0x03012,0x03013), `Delta (0); + (0x03020,0x03020), `Abs (0x03020); + (0x03036,0x03037), `Delta (0); + (0x0303E,0x0303F), `Delta (0); + (0x03190,0x03191), `Delta (0); + (0x03196,0x0319F), `Delta (0); + (0x031C0,0x031E3), `Delta (0); + (0x03200,0x0321E), `Delta (0); + (0x0322A,0x03247), `Delta (0); + (0x03250,0x03250), `Abs (0x03250); + (0x03260,0x0327F), `Delta (0); + (0x0328A,0x032B0), `Delta (0); + (0x032C0,0x032FE), `Delta (0); + (0x03300,0x033FF), `Delta (0); + (0x04DC0,0x04DFF), `Delta (0); + (0x0A490,0x0A4C6), `Delta (0); + (0x0A828,0x0A82B), `Delta (0); + (0x0A836,0x0A837), `Delta (0); + (0x0A839,0x0A839), `Abs (0x0A839); + (0x0AA77,0x0AA79), `Delta (0); + (0x0FDFD,0x0FDFD), `Abs (0x0FDFD); + (0x0FFE4,0x0FFE4), `Abs (0x0FFE4); + (0x0FFE8,0x0FFE8), `Abs (0x0FFE8); + (0x0FFED,0x0FFEE), `Delta (0); + (0x0FFFC,0x0FFFD), `Delta (0); + (0x10137,0x1013F), `Delta (0); + (0x10179,0x10189), `Delta (0); + (0x1018C,0x1018E), `Delta (0); + (0x10190,0x1019B), `Delta (0); + (0x101A0,0x101A0), `Abs (0x101A0); + (0x101D0,0x101FC), `Delta (0); + (0x10877,0x10878), `Delta (0); + (0x10AC8,0x10AC8), `Abs (0x10AC8); + (0x1173F,0x1173F), `Abs (0x1173F); + (0x16B3C,0x16B3F), `Delta (0); + (0x16B45,0x16B45), `Abs (0x16B45); + (0x1BC9C,0x1BC9C), `Abs (0x1BC9C); + (0x1D000,0x1D0F5), `Delta (0); + (0x1D100,0x1D126), `Delta (0); + (0x1D129,0x1D164), `Delta (0); + (0x1D16A,0x1D16C), `Delta (0); + (0x1D183,0x1D184), `Delta (0); + (0x1D18C,0x1D1A9), `Delta (0); + (0x1D1AE,0x1D1E8), `Delta (0); + (0x1D200,0x1D241), `Delta (0); + (0x1D245,0x1D245), `Abs (0x1D245); + (0x1D300,0x1D356), `Delta (0); + (0x1D800,0x1D9FF), `Delta (0); + (0x1DA37,0x1DA3A), `Delta (0); + (0x1DA6D,0x1DA74), `Delta (0); + (0x1DA76,0x1DA83), `Delta (0); + (0x1DA85,0x1DA86), `Delta (0); + (0x1F000,0x1F02B), `Delta (0); + (0x1F030,0x1F093), `Delta (0); + (0x1F0A0,0x1F0AE), `Delta (0); + (0x1F0B1,0x1F0BF), `Delta (0); + (0x1F0C1,0x1F0CF), `Delta (0); + (0x1F0D1,0x1F0F5), `Delta (0); + (0x1F110,0x1F12E), `Delta (0); + (0x1F130,0x1F16B), `Delta (0); + (0x1F170,0x1F1AC), `Delta (0); + (0x1F1E6,0x1F202), `Delta (0); + (0x1F210,0x1F23B), `Delta (0); + (0x1F240,0x1F248), `Delta (0); + (0x1F250,0x1F251), `Delta (0); + (0x1F300,0x1F3FA), `Delta (0); + (0x1F400,0x1F6D2), `Delta (0); + (0x1F6E0,0x1F6EC), `Delta (0); + (0x1F6F0,0x1F6F6), `Delta (0); + (0x1F700,0x1F773), `Delta (0); + (0x1F780,0x1F7D4), `Delta (0); + (0x1F800,0x1F80B), `Delta (0); + (0x1F810,0x1F847), `Delta (0); + (0x1F850,0x1F859), `Delta (0); + (0x1F860,0x1F887), `Delta (0); + (0x1F890,0x1F8AD), `Delta (0); + (0x1F910,0x1F91E), `Delta (0); + (0x1F920,0x1F927), `Delta (0); + (0x1F930,0x1F930), `Abs (0x1F930); + (0x1F933,0x1F93E), `Delta (0); + (0x1F940,0x1F94B), `Delta (0); + (0x1F950,0x1F95E), `Delta (0); + (0x1F980,0x1F991), `Delta (0) +];; diff -Nru coq-doc-8.6/clib/unionfind.ml coq-doc-8.15.0/clib/unionfind.ml --- coq-doc-8.6/clib/unionfind.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/unionfind.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,138 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t + + (** Add (in place) an element in the partition, or do nothing + if the element is already in the partition. *) + val add : elt -> t -> unit + + (** Find the canonical representative of an element. + Raise [not_found] if the element isn't known yet. *) + val find : elt -> t -> elt + + (** Merge (in place) the equivalence classes of two elements. + This will add the elements in the partition if necessary. *) + val union : elt -> elt -> t -> unit + + (** Merge (in place) the equivalence classes of many elements. *) + val union_set : set -> t -> unit + + (** Listing the different components of the partition *) + val partition : t -> set list + +end + +module type SetS = +sig + type t + type elt + val singleton : elt -> t + val union : t -> t -> t + val choose : t -> elt + val iter : (elt -> unit) -> t -> unit +end + +module type MapS = +sig + type key + type +'a t + val empty : 'a t + val find : key -> 'a t -> 'a + val add : key -> 'a -> 'a t -> 'a t + val mem : key -> 'a t -> bool + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b +end + +module Make (S:SetS)(M:MapS with type key = S.elt) = struct + + type elt = S.elt + type set = S.t + + type node = + | Canon of set + | Equiv of elt + + type t = node ref M.t ref + + let create () = ref (M.empty : node ref M.t) + + let fresh x p = + let node = ref (Canon (S.singleton x)) in + p := M.add x node !p; + x, node + + let rec lookup x p = + let node = M.find x !p in + match !node with + | Canon _ -> x, node + | Equiv y -> + let ((z,_) as res) = lookup y p in + if not (z == y) then node := Equiv z; + res + + let add x p = if not (M.mem x !p) then ignore (fresh x p) + + let find x p = fst (lookup x p) + + let canonical x p = try lookup x p with Not_found -> fresh x p + + let union x y p = + let ((x,_) as xcan) = canonical x p in + let ((y,_) as ycan) = canonical y p in + if x = y then () + else + let xcan, ycan = if x < y then xcan, ycan else ycan, xcan in + let x,xnode = xcan and y,ynode = ycan in + match !xnode, !ynode with + | Canon lx, Canon ly -> + xnode := Canon (S.union lx ly); + ynode := Equiv x; + | _ -> assert false + + let union_set s p = + try + let x = S.choose s in + S.iter (fun y -> union x y p) s + with Not_found -> () + + let partition p = + List.rev (M.fold + (fun x node acc -> match !node with + | Equiv _ -> acc + | Canon lx -> lx::acc) + !p []) + +end diff -Nru coq-doc-8.6/clib/unionfind.mli coq-doc-8.15.0/clib/unionfind.mli --- coq-doc-8.6/clib/unionfind.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/clib/unionfind.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,82 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* t + + (** Add (in place) an element in the partition, or do nothing + if the element is already in the partition. *) + val add : elt -> t -> unit + + (** Find the canonical representative of an element. + Raise [not_found] if the element isn't known yet. *) + val find : elt -> t -> elt + + (** Merge (in place) the equivalence classes of two elements. + This will add the elements in the partition if necessary. *) + val union : elt -> elt -> t -> unit + + (** Merge (in place) the equivalence classes of many elements. *) + val union_set : set -> t -> unit + + (** Listing the different components of the partition *) + val partition : t -> set list + +end + +module type SetS = +sig + type t + type elt + val singleton : elt -> t + val union : t -> t -> t + val choose : t -> elt + val iter : (elt -> unit) -> t -> unit +end +(** Minimal interface for sets, subtype of stdlib's Set. *) + +module type MapS = +sig + type key + type +'a t + val empty : 'a t + val find : key -> 'a t -> 'a + val add : key -> 'a -> 'a t -> 'a t + val mem : key -> 'a t -> bool + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b +end +(** Minimal interface for maps, subtype of stdlib's Map. *) + +module Make : + functor (S:SetS) -> + functor (M:MapS with type key = S.elt) -> + PartitionSig with type elt = S.elt and type set = S.t diff -Nru coq-doc-8.6/CODE_OF_CONDUCT.md coq-doc-8.15.0/CODE_OF_CONDUCT.md --- coq-doc-8.6/CODE_OF_CONDUCT.md 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/CODE_OF_CONDUCT.md 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,124 @@ +# Coq Code of Conduct # + +The Coq development team and the user community are made up of a mixture of +professionals and volunteers from all over the world. +Diversity brings variety of perspectives that can be very valuable, but it can +also lead to communication issues and unhappiness. Therefore, we have a few +ground rules that we ask people to adhere to. +These rules apply equally to core developers (who should lead by example), +occasional contributors and those seeking help and guidance. +Their goal is that everyone feels safe and welcome when contributing to Coq or +interacting with others in Coq related forums. + +These rules apply to all spaces managed by the Coq development team. +This includes the GitHub repository, the Discourse forum, the Zulip chat, the mailing lists, +physical events like Coq working groups and workshops, and any other forums +created or managed by the development team which the community uses for +communication. In addition, violations of these rules outside these spaces may +affect a person's ability to participate within them. + +- **Be friendly and patient.** +- **Be welcoming.** + We strive to be a community that welcomes and supports people of all + backgrounds and identities. This includes, but is not limited to people of + any origin, color, status, educational level, gender identity, sexual + orientation, age, culture and beliefs, and mental and physical ability. +- **Be considerate.** + Your work will be used by other people, and you in turn will depend on the + work of others. Any decision you take will affect users and colleagues, and + you should take those consequences into account when making decisions. +- **Be respectful.** + Not all of us will agree all the time, but disagreement is no excuse for poor + behavior and poor manners. We might all experience some frustration now and + then, but we cannot allow that frustration to turn into a personal attack. + It's important to remember that a community where people feel uncomfortable + or threatened is not a productive one. Members of the Coq development team + and user community should be respectful when dealing with other members as + well as with people outside the community. +- **Be careful in the words that you choose.** + Be kind to others. Do not insult or put down other participants. Harassment + and other exclusionary behavior aren't acceptable. + * Violent language or threats or personal insults have no chance to + resolve a dispute or to let a discussion florish. Worse, they can + hurt durably, or generate durable fears. They are thus unwelcome. + * Not everyone is comfortable with sexually explicit or violent + material, even as a joke. In an online open multicultural world, you + don't know who might be listening. So be cautious and responsible + with your words. + * Discussions are online and recorded for posterity; we all have our + right for privacy and online gossiping as well as posting or threatening to + post other people's personally identifying information is prohibited. +- **Remember that what you write in a public online forum might be read by + many people you don't know.** + Consider what image your words will give to outsiders of the development + team / the user community as a whole. Try to avoid references to private + knowledge to be understandable by anyone. +- **Coq online forums are only to discuss Coq-related subjects.** + Unrelated political discussions or long digressions are unwelcome, + even for illustration or comparison purposes. +- **When we disagree, try to understand why.** + Disagreements, both social and technical, happen all the time and Coq is no + exception. It is important that we resolve disagreements and differing views + constructively. Remember that we are different. Different people + have different perspectives on issues. Being unable to understand why someone + holds a viewpoint doesn't mean that they're wrong. +- **It is human to make errors, and please try not to take things personally.** + Please do not answer aggressively to problematic behavior and simply + signal the issue. If actions have been taken with you (e.g. bans or simple + demands of apology, of rephrasing or keeping personal beliefs or troubles + private), please understand that they are not intended as aggression or + punishment ― even if you they feel harsh to you ― but as ways to enforce a + calm communication for the other participants and to give you the opportunity + to change your behavior. We understand you may feel hurt, or maybe you had a + bad day, so please take this opportunity to question yourself, cool down if + necessary and do not persist in the exact same behavior you have been + reported for. + +## Enforcement ## + +If you believe someone is violating the code of conduct, we ask that you report +it by emailing the Coq Code of Conduct enforcement team at + or, at your discretion, any member of the team. +Confidentiality with regard to the reporter of an +incident will be maintained while dealing with it. + +In particular, you should seek support from the team instead of dealing by +yourself with a behavior that you consider hurtful. This applies to members of +the enforcement team as well, who shouldn't deal by themselves with violations +in discussions in which they are a participant. + +Depending on the violation, the team can choose to address a private or public +warning to the offender, request an apology, or ban them for a short or a long +period from interacting on one or all of our forums. + +Except in case of serious violations, the team will always try a pedagogical +approach first (the offender does not necessarily realize immediately why their +behavior is wrong). We consider short bans to form part of the pedagogical +approach, especially when they come with explanatory comments, as this can give +some time to the offender to calm down and think about their actions. + +The members of the team are currently: + +- Matthieu Sozeau +- Théo Zimmermann + +## Questions? ## + +If you have questions, feel free to write to . + +## Attribution ## + +This text is adapted from the [Django Code of Conduct][django-code-of-conduct] +which itself was adapted from the Speak Up! Community Code of Conduct. + +## License ## + + +Creative Commons License +
+This work is licensed under a + +Creative Commons Attribution 4.0 International License +. + +[django-code-of-conduct]: https://web.archive.org/web/20180714161115/https://www.djangoproject.com/conduct/ diff -Nru coq-doc-8.6/COMPATIBILITY coq-doc-8.15.0/COMPATIBILITY --- coq-doc-8.6/COMPATIBILITY 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/COMPATIBILITY 1970-01-01 00:00:00.000000000 +0000 @@ -1,191 +0,0 @@ -Potential sources of incompatibilities between Coq V8.5 and V8.6 ----------------------------------------------------------------- - -Symptom: An obligation generated by Program or an abstracted subproof -has different arguments. -Cause: Set Shrink Abstract and Set Shrink Obligations are on by default -and the subproof does not use the argument. -Remedy: -- Adapt the script. -- Write an explicit lemma to prove the obligation/subproof and use it - instead (compatible with 8.4). -- Unset the option for the program/proof the obligation/subproof originates - from. - -Symptom: In a goal, order of hypotheses, or absence of an equality of -the form "x = t" or "t = x", or no unfolding of a local definition. -Cause: This might be connected to a number of fixes in the tactic -"subst". The former behavior can be reactivated by issuing "Unset -Regular Subst Tactic". - -Potential sources of incompatibilities between Coq V8.4 and V8.5 ----------------------------------------------------------------- - -* List of typical changes to be done to adapt files from Coq 8.4 * -* to Coq 8.5 when not using compatibility option "-compat 8.4". * - -Symptom: "The reference omega was not found in the current environment". -Cause: "Require Omega" does not import the tactic "omega" any more -Possible solutions: -- use "Require Import OmegaTactic" (not compatible with 8.4) -- use "Require Import Omega" (compatible with 8.4) -- add definition "Ltac omega := Coq.omega.Omega.omega." - -Symptom: "intuition" cannot solve a goal (not working anymore on non standard connective) -Cause: "intuition" had an accidental non uniform behavior fixed on non standard connectives -Possible solutions: -- use "dintuition" instead; it is stronger than "intuition" and works - uniformly on non standard connectives, such as n-ary conjunctions or disjunctions - (not compatible with 8.4) -- do the script differently - -Symptom: The constructor foo (in type bar) expects n arguments. -Cause: parameters must now be given in patterns -Possible solutions: -- use option "Set Asymmetric Patterns" (compatible with 8.4) -- add "_" for the parameters (not compatible with 8.4) -- turn the parameters into implicit arguments (compatible with 8.4) - -Symptom: "NPeano.Nat.foo" not existing anymore -Possible solutions: -- use "Nat.foo" instead - -Symptom: typing problems with proj1_sig or similar -Cause: coercion from sig to sigT and similar coercions have been - removed so as to make the initial state easier to understand for - beginners -Solution: change proj1_sig into projT1 and similarly (compatible with 8.4) - -* Other detailed changes * - -(see also file CHANGES) - -- options for *coq* compilation (see below for ocaml). - -** [-I foo] is now deprecated and will not add directory foo to the - coq load path (only for ocaml, see below). Just replace [-I foo] by - [-Q foo ""] in your project file and re-generate makefile. Or - perform the same operation directly in your makefile if you edit it - by hand. - -** Option -R Foo bar is the same in v8.5 than in v8.4 concerning coq - load path. - -** Option [-I foo -as bar] is unchanged but discouraged unless you - compile ocaml code. Use -Q foo bar instead. - - for more details: file CHANGES or section "Customization at launch - time" of the reference manual. - -- Command line options for ocaml Compilation of ocaml code (plugins) - -** [-I foo] is *not* deprecated to add foo to the ocaml load path. - -** [-I foo -as bar] adds foo to the ocaml load path *and* adds foo to - the coq load path with logical name bar (shortcut for -I foo -Q foo - bar). - - for more details: file CHANGES or section "Customization at launch - time" of the reference manual. - -- Universe Polymorphism. - -- Refinement, unification and tactics are now aware of universes, - resulting in more localized errors. Universe inconsistencies - should no more get raised at Qed time but during the proof. - Unification *always* produces well-typed substitutions, hence - some rare cases of unifications that succeeded while producing - ill-typed terms before will now fail. - -- The [change p with c] tactic semantics changed, now typechecking - [c] at each matching occurrence [t] of the pattern [p], and - converting [t] with [c]. - -- Template polymorphic inductive types: the partial application - of a template polymorphic type (e.g. list) is not polymorphic. - An explicit parameter application (e.g [fun A => list A]) or - [apply (list _)] will result in a polymorphic instance. - -- The type inference algorithm now takes opacity of constants into - account. This may have effects on tactics using type inference - (e.g. induction). Extra "Transparent" might have to be added to - revert opacity of constants. - -Type classes. - -- When writing an Instance foo : Class A := {| proj := t |} (note the - vertical bars), support for typechecking the projections using the - type information and switching to proof mode is no longer available. - Use { } (without the vertical bars) instead. - -Tactic abstract. - -- Auxiliary lemmas generated by the abstract tactic are removed from - the global environment and inlined in the proof term when a proof - is ended with Qed. The behavior of 8.4 can be obtained by ending - proofs with "Qed exporting" or "Qed exporting ident, .., ident". - -Potential sources of incompatibilities between Coq V8.3 and V8.4 ----------------------------------------------------------------- - -(see also file CHANGES) - -The main known incompatibilities between 8.3 and 8.4 are consequences -of the following changes: - -- The reorganization of the library of numbers: - - Several definitions have new names or are defined in modules of - different names, but a special care has been taken to have this - renaming transparent for the user thanks to compatibility notations. - - However some definitions have changed, what might require some - adaptations. The most noticeable examples are: - - The "?=" notation which now bind to Pos.compare rather than former - Pcompare (now Pos.compare_cont). - - Changes in names may induce different automatically generated - names in proof scripts (e.g. when issuing "destruct Z_le_gt_dec"). - - Z.add has a new definition, hence, applying "simpl" on subterms of - its body might give different results than before. - - BigN.shiftl and BigN.shiftr have reversed arguments order, the - power function in BigN now takes two BigN. - -- Other changes in libraries: - - - The definition of functions over "vectors" (list of fixed length) - have changed. - - TheoryList.v has been removed. - -- Slight changes in tactics: - - - Less unfolding of fixpoints when applying destruct or inversion on - a fixpoint hiding an inductive type (add an extra call to simpl to - preserve compatibility). - - Less unexpected local definitions when applying "destruct" - (incompatibilities solvable by adapting name hypotheses). - - Tactic "apply" might succeed more often, e.g. by now solving - pattern-matching of the form ?f x y = g(x,y) (compatibility - ensured by using "Unset Tactic Pattern Unification"), but also - because it supports (full) betaiota (using "simple apply" might - then help). - - Tactic autorewrite does no longer instantiate pre-existing - existential variables. - - Tactic "info" is now available only for auto, eauto and trivial. - -- Miscellaneous changes: - - - The command "Load" is now atomic for backtracking (use "Unset - Atomic Load" for compatibility). - - -Incompatibilities beyond 8.4... - -- Syntax: "x -> y" has now lower priority than "<->" "A -> B <-> C" is - now "A -> (B <-> C)" - -- Tactics: tauto and intuition no longer accidentally destruct binary - connectives or records other than and, or, prod, sum, iff. In most - of cases, dtauto or dintuition, though stronger than 8.3 tauto and - 8.3 intuition will provide compatibility. - -- "Solve Obligations using" is now "Solve Obligations with". diff -Nru coq-doc-8.6/config/coq_config.mli coq-doc-8.15.0/config/coq_config.mli --- coq-doc-8.6/config/coq_config.mli 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/config/coq_config.mli 2022-01-13 11:55:53.000000000 +0000 @@ -1,64 +1,49 @@ (************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* [||] + +let () = Array.sort compare plugins + +let () =Array.iter (fun f -> + let f' = "plugins/"^f in + if Sys.is_directory f' && f.[0] <> '.' then print_endline f) + plugins diff -Nru coq-doc-8.6/configure coq-doc-8.15.0/configure --- coq-doc-8.6/configure 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/configure 2022-01-13 11:55:53.000000000 +0000 @@ -2,36 +2,13 @@ ## This micro-configure shell script is here only to ## launch the real configuration via ocaml +configure=./tools/configure/configure.exe -cmd=ocaml -script=./configure.ml - -if [ ! -f $script ]; then - echo "Error: file $script not found in the current directory." - echo "Please run the configure script from the root of the coq sources." - echo "Configuration script failed!" +## Check that dune is available, provide an error message otherwise +if ! command -v dune > /dev/null +then + 1>&2 echo "Dune could not be found, please ensure you have a working OCaml enviroment" exit 1 fi -## Parse the args, only looking for -camldir -## We avoid using shift to keep "$@" intact - -last= -for i; do - case $last in - -camldir|--camldir) cmd="$i/ocaml"; break;; - esac - last=$i -done - -## We check that $cmd is ok before the real exec $cmd - -`$cmd -version > /dev/null 2>&1` && exec $cmd $script "$@" - -## If we're still here, something is wrong with $cmd - -echo "Error: failed to run $cmd" -echo "Please use the option -camldir

if 'ocaml' is installed" -echo "in directory , or add to your path." -echo "Configuration script failed!" -exit 1 +dune exec --root . -- $configure "$@" diff -Nru coq-doc-8.6/configure.ml coq-doc-8.15.0/configure.ml --- coq-doc-8.6/configure.ml 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/configure.ml 1970-01-01 00:00:00.000000000 +0000 @@ -1,1199 +0,0 @@ -(**********************************) - -(** Configuration script for Coq *) - -(**********************************) - -(** This file should be run via: ocaml configure.ml - You could also use our wrapper ./configure *) - -#load "unix.cma" -#load "str.cma" -open Printf - -let coq_version = "8.6" -let coq_macos_version = "8.6.00" (** "[...] should be a string comprised of -three non-negative, period-separated integers [...]" *) -let vo_magic = 8600 -let state_magic = 58600 -let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqmktop";"coqworkmgr"; -"coqdoc";"coq_makefile";"coq-tex";"gallina";"coqwc";"csdpcert";"coqdep"] - -let verbose = ref false (* for debugging this script *) - -(** * Utility functions *) - -let die msg = eprintf "%s\nConfiguration script failed!\n" msg; exit 1 - -let s2i = int_of_string -let i2s = string_of_int -let (/) x y = x ^ "/" ^ y - -(** Remove the final '\r' that may exists on Win32 *) - -let remove_final_cr s = - let n = String.length s in - if n<>0 && s.[n-1] = '\r' then String.sub s 0 (n-1) - else s - -let check_exit_code (_,code) = match code with - | Unix.WEXITED 0 -> () - | Unix.WEXITED 127 -> failwith "no such command" - | Unix.WEXITED n -> failwith ("exit code " ^ i2s n) - | Unix.WSIGNALED n -> failwith ("killed by signal " ^ i2s n) - | Unix.WSTOPPED n -> failwith ("stopped by signal " ^ i2s n) - -(** As for Unix.close_process, our Unix.waipid will ignore all EINTR *) - -let rec waitpid_non_intr pid = - try Unix.waitpid [] pid - with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_non_intr pid - -(** Below, we'd better read all lines on a channel before closing it, - otherwise a SIGPIPE could be encountered by the sub-process *) - -let read_lines_and_close fd = - let cin = Unix.in_channel_of_descr fd in - let lines = ref [] in - begin - try - while true do - lines := remove_final_cr (input_line cin) :: !lines - done - with End_of_file -> () - end; - close_in cin; - let lines = List.rev !lines in - try List.hd lines, lines with Failure _ -> "", [] - -(** Run some unix command and read the first line of its output. - We avoid Unix.open_process and its non-fully-portable /bin/sh, - especially when it comes to quoting the filenames. - See open_process_pid in ide/coq.ml for more details. - Error messages: - - if err=StdErr, any error message goes in the stderr of our script. - - if err=StdOut, we merge stderr and stdout (just as 2>&1). - - if err=DevNull, we drop the error messages (same as 2>/dev/null). *) - -type err = StdErr | StdOut | DevNull - -let exe = ref "" (* Will be set later on, when the suffix is known *) - -let run ?(fatal=true) ?(err=StdErr) prog args = - let prog = (* Ensure prog ends with exe *) - if Str.string_match (Str.regexp ("^.*" ^ !exe ^ "$")) prog 0 - then prog else (prog ^ !exe) in - let argv = Array.of_list (prog::args) in - try - let out_r,out_w = Unix.pipe () in - let nul_r,nul_w = Unix.pipe () in - let () = Unix.set_close_on_exec out_r in - let () = Unix.set_close_on_exec nul_r in - let fd_err = match err with - | StdErr -> Unix.stderr - | StdOut -> out_w - | DevNull -> nul_w - in - let pid = Unix.create_process prog argv Unix.stdin out_w fd_err in - let () = Unix.close out_w in - let () = Unix.close nul_w in - let line, all = read_lines_and_close out_r in - let _ = read_lines_and_close nul_r in - let () = check_exit_code (waitpid_non_intr pid) in - line, all - with - | _ when not fatal && not !verbose -> "", [] - | e -> - let cmd = String.concat " " (prog::args) in - let exn = match e with Failure s -> s | _ -> Printexc.to_string e in - let msg = sprintf "Error while running '%s' (%s)" cmd exn in - if fatal then die msg else (printf "W: %s\n" msg; "", []) - -let tryrun prog args = run ~fatal:false ~err:DevNull prog args - -(** Splitting a string at some character *) - -let string_split c s = - let len = String.length s in - let rec split n = - try - let pos = String.index_from s n c in - let dir = String.sub s n (pos-n) in - dir :: split (succ pos) - with - | Not_found -> [String.sub s n (len-n)] - in - if len = 0 then [] else split 0 - -(** String prefix test : does [s1] starts with [s2] ? *) - -let starts_with s1 s2 = - let l1 = String.length s1 and l2 = String.length s2 in - l2 <= l1 && s2 = String.sub s1 0 l2 - -(** Turn a version string such as "4.01.0+rc2" into the list - ["4";"01";"1"], stopping at the first non-digit or "." *) - -let numeric_prefix_list s = - let isnum c = (c = '.' || (c >= '0' && c <= '9')) in - let max = String.length s in - let i = ref 0 in - while !i < max && isnum s.[!i] do incr i done; - string_split '.' (String.sub s 0 !i) - -(** Combined existence and directory tests *) - -let dir_exists f = Sys.file_exists f && Sys.is_directory f - -(** Does a file exist and is executable ? *) - -let is_executable f = - try let () = Unix.access f [Unix.X_OK] in true - with Unix.Unix_error _ -> false - -(** Equivalent of rm -f *) - -let safe_remove f = - try Unix.chmod f 0o644; Sys.remove f with _ -> () - -(** The PATH list for searching programs *) - -let os_type_win32 = (Sys.os_type = "Win32") -let os_type_cygwin = (Sys.os_type = "Cygwin") - -let global_path = - try string_split (if os_type_win32 then ';' else ':') (Sys.getenv "PATH") - with Not_found -> [] - -(** A "which" command. May raise [Not_found] *) - -let which prog = - let rec search = function - | [] -> raise Not_found - | dir :: path -> - let file = if os_type_win32 then dir/prog^".exe" else dir/prog in - if is_executable file then file else search path - in search global_path - -let program_in_path prog = - try let _ = which prog in true with Not_found -> false - -(** As per bug #4828, ocamlfind on Windows/Cygwin barfs if you pass it - a quoted path to camlpXo via -pp. So we only quote camlpXo on not - Windows, and warn on Windows if the path contains spaces *) -let contains_suspicious_characters str = - List.fold_left (fun b ch -> String.contains str ch || b) false [' '; '\t'] - -let win_aware_quote_executable str = - if not (os_type_win32 || os_type_cygwin) then - sprintf "%S" str - else - let _ = if contains_suspicious_characters str then - printf "*Warning* The string %S contains suspicious characters; ocamlfind might fail\n" str in - Str.global_replace (Str.regexp "\\\\") "/" str - -(** * Date *) - -(** The short one is displayed when starting coqtop, - The long one is used as compile date *) - -let months = - [| "January";"February";"March";"April";"May";"June"; - "July";"August";"September";"October";"November";"December" |] - -let get_date () = - let now = Unix.localtime (Unix.time ()) in - let year = 1900+now.Unix.tm_year in - let month = months.(now.Unix.tm_mon) in - sprintf "%s %d" month year, - sprintf "%s %d %d %d:%d:%d" (String.sub month 0 3) now.Unix.tm_mday year - now.Unix.tm_hour now.Unix.tm_min now.Unix.tm_sec - -let short_date, full_date = get_date () - - -(** Create the bin/ directory if non-existent *) - -let _ = if not (dir_exists "bin") then Unix.mkdir "bin" 0o755 - - -(** * Command-line parsing *) - -type ide = Opt | Byte | No - -let get_bool = function - | "true" | "yes" | "y" | "all" -> true - | "false" | "no" | "n" -> false - | s -> raise (Arg.Bad ("boolean argument expected instead of "^s)) - -let get_ide = function - | "opt" -> Opt - | "byte" -> Byte - | "no" -> No - | s -> raise (Arg.Bad ("(opt|byte|no) argument expected instead of "^s)) - -let arg_bool r = Arg.String (fun s -> r := get_bool s) - -let arg_string_option r = Arg.String (fun s -> r := Some s) - -module Prefs = struct - let prefix = ref (None : string option) - let local = ref false - let vmbyteflags = ref (None : string option) - let custom = ref (None : bool option) - let bindir = ref (None : string option) - let libdir = ref (None : string option) - let configdir = ref (None : string option) - let datadir = ref (None : string option) - let mandir = ref (None : string option) - let docdir = ref (None : string option) - let emacslib = ref (None : string option) - let coqdocdir = ref (None : string option) - let ocamlfindcmd = ref (None : string option) - let lablgtkdir = ref (None : string option) - let usecamlp5 = ref true - let camlp5dir = ref (None : string option) - let arch = ref (None : string option) - let natdynlink = ref true - let coqide = ref (None : ide option) - let macintegration = ref true - let browser = ref (None : string option) - let withdoc = ref false - let geoproof = ref false - let byteonly = ref false - let debug = ref false - let profile = ref false - let annotate = ref false - let nativecompiler = ref (not (os_type_win32 || os_type_cygwin)) - let coqwebsite = ref "http://coq.inria.fr/" - let force_caml_version = ref false -end - -(* TODO : earlier any option -foo was also available as --foo *) - -let args_options = Arg.align [ - "-prefix", arg_string_option Prefs.prefix, - " Set installation directory to "; - "-local", Arg.Set Prefs.local, - " Set installation directory to the current source tree"; - "-vmbyteflags", arg_string_option Prefs.vmbyteflags, - " Comma-separated link flags for the VM of coqtop.byte"; - "-custom", Arg.Unit (fun () -> Prefs.custom := Some true), - " Build bytecode executables with -custom (not recommended)"; - "-no-custom", Arg.Unit (fun () -> Prefs.custom := Some false), - " Do not build with -custom on Windows and MacOS"; - "-bindir", arg_string_option Prefs.bindir, - " Where to install bin files"; - "-libdir", arg_string_option Prefs.libdir, - " Where to install lib files"; - "-configdir", arg_string_option Prefs.configdir, - " Where to install config files"; - "-datadir", arg_string_option Prefs.datadir, - " Where to install data files"; - "-mandir", arg_string_option Prefs.mandir, - " Where to install man files"; - "-docdir", arg_string_option Prefs.docdir, - " Where to install doc files"; - "-emacslib", arg_string_option Prefs.emacslib, - " Where to install emacs files"; - "-emacs", Arg.String (fun s -> - printf "Warning: obsolete -emacs option\n"; - Prefs.emacslib := Some s), - " Obsolete: same as -emacslib"; - "-coqdocdir", arg_string_option Prefs.coqdocdir, - " Where to install Coqdoc style files"; - "-ocamlfind", arg_string_option Prefs.ocamlfindcmd, - " Specifies the ocamlfind command to use"; - "-lablgtkdir", arg_string_option Prefs.lablgtkdir, - " Specifies the path to the Lablgtk library"; - "-usecamlp5", Arg.Set Prefs.usecamlp5, - " Specifies to use camlp5 instead of camlp4"; - "-usecamlp4", Arg.Clear Prefs.usecamlp5, - " Specifies to use camlp4 instead of camlp5"; - "-camlp5dir", - Arg.String (fun s -> Prefs.usecamlp5:=true; Prefs.camlp5dir:=Some s), - " Specifies where is the Camlp5 library and tells to use it"; - "-arch", arg_string_option Prefs.arch, - " Specifies the architecture"; - "-opt", Arg.Unit (fun () -> printf "Warning: obsolete -opt option\n"), - " Obsolete: native OCaml executables detected automatically"; - "-natdynlink", arg_bool Prefs.natdynlink, - "(yes|no) Use dynamic loading of native code or not"; - "-coqide", Arg.String (fun s -> Prefs.coqide := Some (get_ide s)), - "(opt|byte|no) Specifies whether or not to compile Coqide"; - "-nomacintegration", Arg.Clear Prefs.macintegration, - " Do not try to build coqide mac integration"; - "-browser", arg_string_option Prefs.browser, - " Use to open URL %s"; - "-nodoc", Arg.Clear Prefs.withdoc, - " Do not compile the documentation"; - "-with-doc", arg_bool Prefs.withdoc, - "(yes|no) Compile the documentation or not"; - "-with-geoproof", arg_bool Prefs.geoproof, - "(yes|no) Use Geoproof binding or not"; - "-byte-only", Arg.Set Prefs.byteonly, - " Compiles only bytecode version of Coq"; - "-byteonly", Arg.Set Prefs.byteonly, - " Compiles only bytecode version of Coq"; - "-debug", Arg.Set Prefs.debug, - " Add debugging information in the Coq executables"; - "-profile", Arg.Set Prefs.profile, - " Add profiling information in the Coq executables"; - "-annotate", Arg.Set Prefs.annotate, - " Dumps ml annotation files while compiling Coq"; - "-makecmd", Arg.String (fun _ -> printf "Warning: obsolete -makecmd option\n"), - " Obsolete: name of GNU Make command"; - "-native-compiler", arg_bool Prefs.nativecompiler, - "(yes|no) Compilation to native code for conversion and normalization"; - "-coqwebsite", Arg.Set_string Prefs.coqwebsite, - " URL of the coq website"; - "-force-caml-version", Arg.Set Prefs.force_caml_version, - " Force OCaml version"; -] - -let parse_args () = - Arg.parse - args_options - (fun s -> raise (Arg.Bad ("Unknown option: "^s))) - "Available options for configure are:"; - if !Prefs.local && !Prefs.prefix <> None then - die "Options -prefix and -local are incompatible." - -let _ = parse_args () - -(** Default OCaml binaries *) - -type camlexec = - { mutable find : string; - mutable top : string; - mutable lex : string; } - -let camlexec = - { find = "ocamlfind"; - top = "ocaml"; - lex = "ocamllex"; } - -let reset_caml_lex c o = c.lex <- o -let reset_caml_top c o = c.top <- o -let reset_caml_find c o = c.find <- o - -let coq_debug_flag = if !Prefs.debug then "-g" else "" -let coq_profile_flag = if !Prefs.profile then "-p" else "" -let coq_annotate_flag = - if !Prefs.annotate - then if program_in_path "ocamlmerlin" then "-bin-annot" else "-dtypes" - else "" - -let cflags = "-Wall -Wno-unused -g -O2" - -(** * Architecture *) - -let arch_progs = - [("/bin/uname",["-s"]); - ("/usr/bin/uname",["-s"]); - ("/bin/arch", []); - ("/usr/bin/arch", []); - ("/usr/ucb/arch", []) ] - -let query_arch () = - printf "I can not automatically find the name of your architecture.\n"; - printf "Give me a name, please [win32 for Win95, Win98 or WinNT]: %!"; - read_line () - -let rec try_archs = function - | (prog,args)::rest when is_executable prog -> - let arch, _ = tryrun prog args in - if arch <> "" then arch else try_archs rest - | _ :: rest -> try_archs rest - | [] -> query_arch () - -let arch = match !Prefs.arch with - | Some a -> a - | None -> - let arch,_ = tryrun "uname" ["-s"] in - if starts_with arch "CYGWIN" then "win32" - else if starts_with arch "MINGW32" then "win32" - else if arch <> "" then arch - else try_archs arch_progs - -(** NB: [arch_win32] is broader than [os_type_win32], cf. cygwin *) - -let arch_win32 = (arch = "win32") - -let exe = exe := if arch_win32 then ".exe" else ""; !exe -let dll = if os_type_win32 then ".dll" else ".so" - -(** * VCS - - Is the source tree checked out from a recognised - Version Control System ? *) - -let vcs = - let git_dir = try Sys.getenv "GIT_DIR" with Not_found -> ".git" in - if Sys.file_exists git_dir then "git" - else if Sys.file_exists ".svn/entries" then "svn" - else if dir_exists "{arch}" then "gnuarch" - else "none" - -(** * Browser command *) - -let browser = - match !Prefs.browser with - | Some b -> b - | None when arch_win32 -> "start %s" - | None when arch = "Darwin" -> "open %s" - | _ -> "firefox -remote \"OpenURL(%s,new-tab)\" || firefox %s &" - -(** * OCaml programs *) - -let camlbin, caml_version, camllib = - let () = match !Prefs.ocamlfindcmd with - | Some cmd -> reset_caml_find camlexec cmd - | None -> - try reset_caml_find camlexec (which camlexec.find) - with Not_found -> - die (sprintf "Error: cannot find '%s' in your path!\n" camlexec.find ^ - "Please adjust your path or use the -ocamlfind option of ./configure") - in - if not (is_executable camlexec.find) - then die ("Error: cannot find the executable '"^camlexec.find^"'.") - else - let caml_version, _ = run camlexec.find ["ocamlc";"-version"] in - let camllib, _ = run camlexec.find ["printconf";"stdlib"] in - let camlbin = (* TODO beurk beurk beurk *) - Filename.dirname (Filename.dirname camllib) / "bin/" in - let () = - if is_executable (camlbin / "ocamllex") - then reset_caml_lex camlexec (camlbin / "ocamllex") in - let () = - if is_executable (camlbin / "ocaml") - then reset_caml_top camlexec (camlbin / "ocaml") in - camlbin, caml_version, camllib - -let camlp4compat = "-loc loc" - -(** Caml version as a list of string, e.g. ["4";"00";"1"] *) - -let caml_version_list = numeric_prefix_list caml_version - -(** Same, with integers in the version list *) - -let caml_version_nums = - try - if List.length caml_version_list < 2 then failwith "bad version"; - List.map s2i caml_version_list - with _ -> - die ("I found the OCaml compiler but cannot read its version number!\n" ^ - "Is it installed properly?") - -let check_caml_version () = - if caml_version_nums >= [4;1;0] then - if caml_version_nums = [4;2;0] && not !Prefs.force_caml_version then - die ("Your version of OCaml is 4.02.0 which suffers from a bug inducing\n" ^ - "very slow compilation times. If you still want to use it, use \n" ^ - "option -force-caml-version.\n") - else - printf "You have OCaml %s. Good!\n" caml_version - else - let () = printf "Your version of OCaml is %s.\n" caml_version in - if !Prefs.force_caml_version then - printf "*Warning* Your version of OCaml is outdated.\n" - else - die "You need OCaml 4.01 or later." - -let _ = check_caml_version () - -let coq_debug_flag_opt = - if caml_version_nums >= [3;10] then coq_debug_flag else "" - -let camltag = match caml_version_list with - | x::y::_ -> "OCAML"^x^y - | _ -> assert false - - -(** * CamlpX configuration *) - -(* Convention: we use camldir as a prioritary location for camlpX, if given *) - -let which_camlpX base = - let file = Filename.concat camlbin base in - if is_executable file then file else which base - -(* TODO: camlp5dir should rather be the *binary* location, just as camldir *) -(* TODO: remove the late attempts at finding gramlib.cma *) - -exception NoCamlp5 - -let check_camlp5 testcma = match !Prefs.camlp5dir with - | Some dir -> - if Sys.file_exists (dir/testcma) then - let camlp5o = - try which_camlpX "camlp5o" - with Not_found -> die "Error: cannot find Camlp5 binaries in path.\n" in - dir, camlp5o - else - let msg = - sprintf "Cannot find camlp5 libraries in '%s' (%s not found)." - dir testcma - in die msg - | None -> - try - let camlp5o = which_camlpX "camlp5o" in - let dir,_ = tryrun camlp5o ["-where"] in - dir, camlp5o - with Not_found -> - let () = printf "No Camlp5 installation found." in - let () = printf "Looking for Camlp4 instead...\n" in - raise NoCamlp5 - -let check_camlp5_version camlp5o = - let version_line, _ = run ~err:StdOut camlp5o ["-v"] in - let version = List.nth (string_split ' ' version_line) 2 in - match string_split '.' version with - | major::minor::_ when s2i major > 6 || (s2i major, s2i minor) >= (6,6) -> - printf "You have Camlp5 %s. Good!\n" version; version - | _ -> die "Error: unsupported Camlp5 (version < 6.06 or unrecognized).\n" - -let check_caml_version_for_camlp4 () = - if caml_version_nums = [4;1;0] && !Prefs.debug && not !Prefs.force_caml_version then - die ("Your version of OCaml is detected to be 4.01.0 which fails to compile\n" ^ - "Coq in -debug mode with Camlp4. Remove -debug option or use a different\n" ^ - "version of OCaml or use Camlp5, or bypass this test by using option\n" ^ - "-force-caml-version.\n") - -let config_camlpX () = - try - if not !Prefs.usecamlp5 then raise NoCamlp5; - let camlp5mod = "gramlib" in - let camlp5libdir, camlp5o = check_camlp5 (camlp5mod^".cma") in - let camlp5_version = check_camlp5_version camlp5o in - "camlp5", camlp5o, Filename.dirname camlp5o, camlp5libdir, camlp5mod, camlp5_version - with NoCamlp5 -> - (* We now try to use Camlp4, either by explicit choice or - by lack of proper Camlp5 installation *) - let camlp4mod = "camlp4lib" in - let camlp4libdir = camllib/"camlp4" in - if not (Sys.file_exists (camlp4libdir/camlp4mod^".cma")) then - die "No Camlp4 installation found.\n"; - try - let camlp4orf = which_camlpX "camlp4orf" in - let version_line, _ = run ~err:StdOut camlp4orf ["-v"] in - let camlp4_version = List.nth (string_split ' ' version_line) 2 in - check_caml_version_for_camlp4 (); - "camlp4", camlp4orf, Filename.dirname camlp4orf, camlp4libdir, camlp4mod, camlp4_version - with _ -> die "No Camlp4 installation found.\n" - -let camlpX, camlpXo, camlpXbindir, fullcamlpXlibdir, camlpXmod, camlpX_version = config_camlpX () - -let shorten_camllib s = - if starts_with s (camllib^"/") then - let l = String.length camllib + 1 in - "+" ^ String.sub s l (String.length s - l) - else s - -let camlpXlibdir = shorten_camllib fullcamlpXlibdir - -(** * Native compiler *) - -let msg_byteonly () = - printf "Only the bytecode version of Coq will be available.\n" - -let msg_no_ocamlopt () = - printf "Cannot find the OCaml native-code compiler.\n"; msg_byteonly () - -let msg_no_camlpX_cmxa () = - printf "Cannot find the native-code library of %s.\n" camlpX; msg_byteonly () - -let msg_no_dynlink_cmxa () = - printf "Cannot find native-code dynlink library.\n"; msg_byteonly (); - printf "For building a native-code Coq, you may try to first\n"; - printf "compile and install a dummy dynlink.cmxa (see dev/dynlink.ml)\n"; - printf "and then run ./configure -natdynlink no\n" - -let check_native () = - let () = if !Prefs.byteonly then raise Not_found in - let version, _ = tryrun camlexec.find ["opt";"-version"] in - if version = "" then let () = msg_no_ocamlopt () in raise Not_found - else if not (Sys.file_exists (fullcamlpXlibdir/camlpXmod^".cmxa")) - then let () = msg_no_camlpX_cmxa () in raise Not_found - else if fst (tryrun camlexec.find ["query";"dynlink"]) = "" - then let () = msg_no_dynlink_cmxa () in raise Not_found - else - let () = - if version <> caml_version then - printf - "Warning: Native and bytecode compilers do not have the same version!\n" - in printf "You have native-code compilation. Good!\n" - -let best_compiler = - try check_native (); "opt" with Not_found -> "byte" - -(** * Native dynlink *) - -let hasnatdynlink = !Prefs.natdynlink && best_compiler = "opt" - -let natdynlinkflag = - if hasnatdynlink then "true" else "false" - - -(** * OS dependent libraries *) - -let osdeplibs = "-cclib -lunix" - -let operating_system, osdeplibs = - if starts_with arch "sun4" then - let os, _ = run "uname" ["-r"] in - if starts_with os "5" then - "Sun Solaris "^os, osdeplibs^" -cclib -lnsl -cclib -lsocket" - else - "Sun OS "^os, osdeplibs - else - (try Sys.getenv "OS" with Not_found -> ""), osdeplibs - - -(** * lablgtk2 and CoqIDE *) - -type source = Manual | OCamlFind | Stdlib - -let get_source = function -| Manual -> "manually provided" -| OCamlFind -> "via ocamlfind" -| Stdlib -> "in OCaml library" - -(** Is some location a suitable LablGtk2 installation ? *) - -let check_lablgtkdir ?(fatal=false) src dir = - let yell msg = if fatal then die msg else (printf "%s\n" msg; false) in - let msg = get_source src in - if not (dir_exists dir) then - yell (sprintf "No such directory '%s' (%s)." dir msg) - else if not (Sys.file_exists (dir/"gSourceView2.cmi")) then - yell (sprintf "Incomplete LablGtk2 (%s): no %s/gSourceView2.cmi." msg dir) - else if not (Sys.file_exists (dir/"glib.mli")) then - yell (sprintf "Incomplete LablGtk2 (%s): no %s/glib.mli." msg dir) - else true - -(** Detect and/or verify the Lablgtk2 location *) - -let get_lablgtkdir () = - match !Prefs.lablgtkdir with - | Some dir -> - let msg = Manual in - if check_lablgtkdir ~fatal:true msg dir then dir, msg - else "", msg - | None -> - let msg = OCamlFind in - let d1,_ = tryrun "ocamlfind" ["query";"lablgtk2.sourceview2"] in - if d1 <> "" && check_lablgtkdir msg d1 then d1, msg - else - (* In debian wheezy, ocamlfind knows only of lablgtk2 *) - let d2,_ = tryrun "ocamlfind" ["query";"lablgtk2"] in - if d2 <> "" && d2 <> d1 && check_lablgtkdir msg d2 then d2, msg - else - let msg = Stdlib in - let d3 = camllib^"/lablgtk2" in - if check_lablgtkdir msg d3 then d3, msg - else "", msg - -(** Detect and/or verify the Lablgtk2 version *) - -let check_lablgtk_version src dir = match src with -| Manual | Stdlib -> - let test accu f = - if accu then - let test = sprintf "grep -q -w %s %S/glib.mli" f dir in - Sys.command test = 0 - else false - in - let heuristics = [ - "convert_with_fallback"; - "wrap_poll_func"; (** Introduced in lablgtk 2.16 *) - ] in - let ans = List.fold_left test true heuristics in - if ans then printf "Warning: could not check the version of lablgtk2.\n"; - (ans, "an unknown version") -| OCamlFind -> - let v, _ = tryrun "ocamlfind" ["query"; "-format"; "%v"; "lablgtk2"] in - try - let vi = List.map s2i (numeric_prefix_list v) in - ([2; 16] <= vi, v) - with _ -> (false, v) - -let pr_ide = function No -> "no" | Byte -> "only bytecode" | Opt -> "native" - -exception Ide of ide - -(** If the user asks an impossible coqide, we abort the configuration *) - -let set_ide ide msg = match ide, !Prefs.coqide with - | No, Some (Byte|Opt) - | Byte, Some Opt -> die (msg^":\n=> cannot build requested CoqIde") - | _ -> - printf "%s:\n=> %s CoqIde will be built.\n" msg (pr_ide ide); - raise (Ide ide) - -let lablgtkdir = ref "" - -(** Which CoqIde is possible ? Which one is requested ? - This function also sets the lablgtkdir reference in case of success. *) - -let check_coqide () = - if !Prefs.coqide = Some No then set_ide No "CoqIde manually disabled"; - let dir, via = get_lablgtkdir () in - if dir = "" then set_ide No "LablGtk2 not found"; - let (ok, version) = check_lablgtk_version via dir in - let found = sprintf "LablGtk2 found (%s, %s)" (get_source via) version in - if not ok then set_ide No (found^", but too old (required >= 2.16, found " ^ version ^ ")"); - (* We're now sure to produce at least one kind of coqide *) - lablgtkdir := shorten_camllib dir; - if !Prefs.coqide = Some Byte then set_ide Byte (found^", bytecode requested"); - if best_compiler<>"opt" then set_ide Byte (found^", but no native compiler"); - if not (Sys.file_exists (dir/"gtkThread.cmx")) then - set_ide Byte (found^", but no native LablGtk2"); - if not (Sys.file_exists (camllib/"threads"/"threads.cmxa")) then - set_ide Byte (found^", but no native threads"); - set_ide Opt (found^", with native threads") - -let coqide = - try check_coqide () - with Ide Opt -> "opt" | Ide Byte -> "byte" | Ide No -> "no" - -(** System-specific CoqIde flags *) - -let lablgtkincludes = ref "" -let idearchflags = ref "" -let idearchfile = ref "" -let idecdepsflags = ref "" -let idearchdef = ref "X11" - -let coqide_flags () = - if !lablgtkdir <> "" then lablgtkincludes := sprintf "-I %S" !lablgtkdir; - match coqide, arch with - | "opt", "Darwin" when !Prefs.macintegration -> - let osxdir,_ = tryrun "ocamlfind" ["query";"lablgtkosx"] in - if osxdir <> "" then begin - lablgtkincludes := sprintf "%s -I %S" !lablgtkincludes osxdir; - idearchflags := "lablgtkosx.cma"; - idearchdef := "QUARTZ" - end - | "opt", "win32" -> - idearchfile := "ide/ide_win32_stubs.o ide/coq_icon.o"; - idecdepsflags := "-custom"; - idearchflags := "-ccopt '-subsystem windows'"; - idearchdef := "WIN32" - | _, "win32" -> - idearchflags := "-ccopt '-subsystem windows'"; - idearchdef := "WIN32" - | _ -> () - -let _ = coqide_flags () - - -(** * strip command *) - -let strip = - if arch = "Darwin" then - if hasnatdynlink then "true" else "strip" - else - if !Prefs.profile || !Prefs.debug then "true" else begin - let _, all = run camlexec.find ["ocamlc";"-config"] in - let strip = String.concat "" (List.map (fun l -> - match string_split ' ' l with - | "ranlib:" :: cc :: _ -> (* on windows, we greb the right strip *) - Str.replace_first (Str.regexp "ranlib") "strip" cc - | _ -> "" - ) all) in - if strip = "" then "strip" else strip - end - -(** * md5sum command *) - -let md5sum = - if List.mem arch ["Darwin"; "FreeBSD"; "OpenBSD"] - then "md5 -q" else "md5sum" - - -(** * Documentation : do we have latex, hevea, ... *) - -let check_doc () = - let err s = - printf "%s was not found; documentation will not be available\n" s; - raise Not_found - in - try - if not !Prefs.withdoc then raise Not_found; - if not (program_in_path "latex") then err "latex"; - if not (program_in_path "hevea") then err "hevea"; - if not (program_in_path "hacha") then err "hacha"; - if not (program_in_path "fig2dev") then err "fig2dev"; - if not (program_in_path "convert") then err "convert"; - true - with Not_found -> false - -let withdoc = check_doc () - - -(** * Installation directories : bindir, libdir, mandir, docdir, etc *) - -let coqtop = Sys.getcwd () - -let unix = os_type_cygwin || not arch_win32 - -(** Variable name, description, ref in Prefs, default dir, prefix-relative *) - -let install = [ - "BINDIR", "the Coq binaries", Prefs.bindir, - (if unix then "/usr/local/bin" else "C:/coq/bin"), - "/bin"; - "COQLIBINSTALL", "the Coq library", Prefs.libdir, - (if unix then "/usr/local/lib/coq" else "C:/coq/lib"), - (if arch_win32 then "" else "/lib/coq"); - "CONFIGDIR", "the Coqide configuration files", Prefs.configdir, - (if unix then "/etc/xdg/coq" else "C:/coq/config"), - (if arch_win32 then "/config" else "/etc/xdg/coq"); - "DATADIR", "the Coqide data files", Prefs.datadir, - (if unix then "/usr/local/share/coq" else "C:/coq/share"), - "/share/coq"; - "MANDIR", "the Coq man pages", Prefs.mandir, - (if unix then "/usr/local/share/man" else "C:/coq/man"), - "/share/man"; - "DOCDIR", "the Coq documentation", Prefs.docdir, - (if unix then "/usr/local/share/doc/coq" else "C:/coq/doc"), - "/share/doc/coq"; - "EMACSLIB", "the Coq Emacs mode", Prefs.emacslib, - (if unix then "/usr/local/share/emacs/site-lisp" else "C:/coq/emacs"), - (if arch_win32 then "/emacs" else "/share/emacs/site-lisp"); - "COQDOCDIR", "the Coqdoc LaTeX files", Prefs.coqdocdir, - (if unix then "/usr/local/share/texmf/tex/latex/misc" else "C:/coq/latex"), - (if arch_win32 then "/latex" else "/share/emacs/site-lisp"); - ] - -let do_one_instdir (var,msg,r,dflt,suff) = - let dir = match !r, !Prefs.prefix with - | Some d, _ -> d - | _, Some p -> p^suff - | _ -> - let () = printf "Where should I install %s [%s]? " msg dflt in - let line = read_line () in - if line = "" then dflt else line - in (var,msg,dir,dir<>dflt) - -let do_one_noinst (var,msg,_,_,_) = - if var="CONFIGDIR" || var="DATADIR" then (var,msg,coqtop^"/ide",true) - else (var,msg,"",false) - -let install_dirs = - let f = if !Prefs.local then do_one_noinst else do_one_instdir in - List.map f install - -let select var = List.find (fun (v,_,_,_) -> v=var) install_dirs - -let libdir = let (_,_,d,_) = select "COQLIBINSTALL" in d - -let docdir = let (_,_,d,_) = select "DOCDIR" in d - -let configdir = - let (_,_,d,b) = select "CONFIGDIR" in if b then Some d else None - -let datadir = - let (_,_,d,b) = select "DATADIR" in if b then Some d else None - - -(** * OCaml runtime flags *) - -(** Do we use -custom (yes by default on Windows and MacOS) *) - -let custom_os = arch_win32 || arch = "Darwin" - -let use_custom = match !Prefs.custom with - | Some b -> b - | None -> custom_os - -let custom_flag = if use_custom then "-custom" else "" - -let build_loadpath = - ref "# you might want to set CAML_LD_LIBRARY_PATH by hand!" - -let config_runtime () = - match !Prefs.vmbyteflags with - | Some flags -> string_split ',' flags - | _ when use_custom -> [custom_flag] - | _ when !Prefs.local -> - ["-dllib";"-lcoqrun";"-dllpath";coqtop/"kernel/byterun"] - | _ -> - let ld="CAML_LD_LIBRARY_PATH" in - build_loadpath := sprintf "export %s:='%s/kernel/byterun':$(%s)" ld coqtop ld; - ["-dllib";"-lcoqrun";"-dllpath";libdir] - -let vmbyteflags = config_runtime () - - -(** * Summary of the configuration *) - -let print_summary () = - let pr s = printf s in - pr "\n"; - pr " Architecture : %s\n" arch; - if operating_system <> "" then - pr " Operating system : %s\n" operating_system; - pr " Coq VM bytecode link flags : %s\n" (String.concat " " vmbyteflags); - pr " Other bytecode link flags : %s\n" custom_flag; - pr " OS dependent libraries : %s\n" osdeplibs; - pr " OCaml version : %s\n" caml_version; - pr " OCaml binaries in : %s\n" camlbin; - pr " OCaml library in : %s\n" camllib; - pr " %s version : %s\n" (String.capitalize camlpX) camlpX_version; - pr " %s binaries in : %s\n" (String.capitalize camlpX) camlpXbindir; - pr " %s library in : %s\n" (String.capitalize camlpX) camlpXlibdir; - if best_compiler = "opt" then - pr " Native dynamic link support : %B\n" hasnatdynlink; - if coqide <> "no" then - pr " Lablgtk2 library in : %s\n" !lablgtkdir; - if !idearchdef = "QUARTZ" then - pr " Mac OS integration is on\n"; - pr " CoqIde : %s\n" coqide; - pr " Documentation : %s\n" - (if withdoc then "All" else "None"); - pr " Web browser : %s\n" browser; - pr " Coq web site : %s\n\n" !Prefs.coqwebsite; - if not !Prefs.nativecompiler then - pr " Native compiler for conversion and normalization disabled\n\n"; - if !Prefs.local then - pr " Local build, no installation...\n" - else - (pr " Paths for true installation:\n"; - List.iter - (fun (_,msg,dir,_) -> pr " - %s will be copied in %s\n" msg dir) - install_dirs); - pr "\n"; - pr "If anything is wrong above, please restart './configure'.\n\n"; - pr "*Warning* To compile the system for a new architecture\n"; - pr " don't forget to do a 'make clean' before './configure'.\n" - -let _ = print_summary () - - -(** * Build the dev/ocamldebug-coq file *) - -let write_dbg_wrapper f = - safe_remove f; - let o = open_out f in - let pr s = fprintf o s in - pr "#!/bin/sh\n\n"; - pr "###### ocamldebug-coq : a wrapper around ocamldebug for Coq ######\n\n"; - pr "# DO NOT EDIT THIS FILE: automatically generated by ../configure #\n\n"; - pr "export COQTOP=%S\n" coqtop; - pr "OCAMLDEBUG=%S\n" (camlbin^"/ocamldebug"); - pr "CAMLP4LIB=%S\n\n" camlpXlibdir; - pr ". $COQTOP/dev/ocamldebug-coq.run\n"; - close_out o; - Unix.chmod f 0o555 - -let _ = write_dbg_wrapper "dev/ocamldebug-coq" - - -(** * Build the config/coq_config.ml file *) - -let write_configml f = - safe_remove f; - let o = open_out f in - let pr s = fprintf o s in - let pr_s = pr "let %s = %S\n" in - let pr_b = pr "let %s = %B\n" in - let pr_i = pr "let %s = %d\n" in - let pr_o s o = pr "let %s = %s\n" s - (match o with None -> "None" | Some d -> sprintf "Some %S" d) - in - pr "(* DO NOT EDIT THIS FILE: automatically generated by ../configure *)\n"; - pr "(* Exact command that generated this file: *)\n"; - pr "(* %s *)\n\n" (String.concat " " (Array.to_list Sys.argv)); - pr_b "local" !Prefs.local; - pr "let vmbyteflags = ["; List.iter (pr "%S;") vmbyteflags; pr "]\n"; - pr_o "coqlib" (if !Prefs.local then None else Some libdir); - pr_o "configdir" configdir; - pr_o "datadir" datadir; - pr_s "docdir" docdir; - pr_s "ocaml" camlexec.top; - pr_s "ocamlfind" camlexec.find; - pr_s "ocamllex" camlexec.lex; - pr_s "camlbin" camlbin; - pr_s "camllib" camllib; - pr_s "camlp4" camlpX; - pr_s "camlp4o" camlpXo; - pr_s "camlp4bin" camlpXbindir; - pr_s "camlp4lib" camlpXlibdir; - pr_s "camlp4compat" camlp4compat; - pr_s "cflags" cflags; - pr_s "best" best_compiler; - pr_s "osdeplibs" osdeplibs; - pr_s "version" coq_version; - pr_s "caml_version" caml_version; - pr_s "date" short_date; - pr_s "compile_date" full_date; - pr_s "arch" arch; - pr_b "arch_is_win32" arch_win32; - pr_s "exec_extension" exe; - pr_s "coqideincl" !lablgtkincludes; - pr_s "has_coqide" coqide; - pr "let gtk_platform = `%s\n" !idearchdef; - pr_b "has_natdynlink" hasnatdynlink; - pr_s "natdynlinkflag" natdynlinkflag; - pr_i "vo_magic_number" vo_magic; - pr_i "state_magic_number" state_magic; - pr "let with_geoproof = ref %B\n" !Prefs.geoproof; - pr_s "browser" browser; - pr_s "wwwcoq" !Prefs.coqwebsite; - pr_s "wwwbugtracker" (!Prefs.coqwebsite ^ "bugs/"); - pr_s "wwwrefman" (!Prefs.coqwebsite ^ "distrib/" ^ coq_version ^ "/refman/"); - pr_s "wwwstdlib" (!Prefs.coqwebsite ^ "distrib/" ^ coq_version ^ "/stdlib/"); - pr_s "localwwwrefman" ("file:/" ^ docdir ^ "/html/refman"); - pr_b "no_native_compiler" (not !Prefs.nativecompiler); - pr "\nlet plugins_dirs = [\n"; - let plugins = Sys.readdir "plugins" in - Array.sort compare plugins; - Array.iter - (fun f -> - let f' = "plugins/"^f in - if Sys.is_directory f' && f.[0] <> '.' then pr " %S;\n" f') - plugins; - pr "]\n"; - close_out o; - Unix.chmod f 0o444 - -let _ = write_configml "config/coq_config.ml" - -(** * Symlinks or copies for the checker *) - -let _ = - let prog, args, prf = - if arch = "win32" then "cp", [], "" - else "ln", ["-s"], "../" in - List.iter (fun file -> - ignore(run "rm" ["-f"; "checker/"^file]); - ignore(run ~fatal:true prog (args @ [prf^"kernel/"^file;"checker/"^file]))) - [ "esubst.ml"; "esubst.mli"; "names.ml"; "names.mli" ] - -(** * Build the config/Makefile file *) - -let write_makefile f = - safe_remove f; - let o = open_out f in - let pr s = fprintf o s in - pr "###### config/Makefile : Configuration file for Coq ##############\n"; - pr "# #\n"; - pr "# This file is generated by the script \"configure\" #\n"; - pr "# DO NOT EDIT IT !! DO NOT EDIT IT !! DO NOT EDIT IT !! #\n"; - pr "# If something is wrong below, then rerun the script \"configure\" #\n"; - pr "# with the good options (see the file INSTALL). #\n"; - pr "# #\n"; - pr "##################################################################\n\n"; - pr "#Variable used to detect whether ./configure has run successfully.\n"; - pr "COQ_CONFIGURED=yes\n\n"; - pr "# Local use (no installation)\n"; - pr "LOCAL=%B\n\n" !Prefs.local; - pr "# Bytecode link flags : should we use -custom or not ?\n"; - pr "CUSTOM=%s\n" custom_flag; - pr "%s\n\n" !build_loadpath; - pr "# Paths for true installation\n"; - List.iter (fun (v,msg,_,_) -> pr "# %s: path for %s\n" v msg) install_dirs; - List.iter (fun (v,_,dir,_) -> pr "%s=%S\n" v dir) install_dirs; - pr "\n# Coq version\n"; - pr "VERSION=%s\n" coq_version; - pr "VERSION4MACOS=%s\n\n" coq_macos_version; - pr "# Objective-Caml compile command\n"; - pr "OCAML=%S\n" camlexec.top; - pr "OCAMLFIND=%S\n" camlexec.find; - pr "OCAMLLEX=%S\n" camlexec.lex; - pr "# The best compiler: native (=opt) or bytecode (=byte)\n"; - pr "BEST=%s\n\n" best_compiler; - pr "# Ocaml version number\n"; - pr "CAMLVERSION=%s\n\n" camltag; - pr "# Ocaml libraries\n"; - pr "CAMLLIB=%S\n\n" camllib; - pr "# Ocaml .h directory\n"; - pr "CAMLHLIB=%S\n\n" camllib; - pr "# Caml link command and Caml make top command\n"; - pr "# Caml flags\n"; - pr "CAMLFLAGS=-rectypes %s\n" coq_annotate_flag; - pr "# User compilation flag\n"; - pr "USERFLAGS=\n\n"; - pr "# Flags for GCC\n"; - pr "CFLAGS=%s\n\n" cflags; - pr "# Compilation debug flags\n"; - pr "CAMLDEBUG=%s\n" coq_debug_flag; - pr "CAMLDEBUGOPT=%s\n\n" coq_debug_flag_opt; - pr "# Compilation profile flag\n"; - pr "CAMLTIMEPROF=%s\n\n" coq_profile_flag; - pr "# Camlp4 : flavor, binaries, libraries ...\n"; - pr "# NB : avoid using CAMLP4LIB (conflict under Windows)\n"; - pr "CAMLP4=%s\n" camlpX; - pr "CAMLP4O=%s\n" (win_aware_quote_executable camlpXo); - pr "CAMLP4COMPAT=%s\n" camlp4compat; - pr "MYCAMLP4LIB=%S\n\n" camlpXlibdir; - pr "# Your architecture\n"; - pr "# Can be obtain by UNIX command arch\n"; - pr "ARCH=%s\n" arch; - pr "HASNATDYNLINK=%s\n\n" natdynlinkflag; - pr "# Supplementary libs for some systems, currently:\n"; - pr "# . Sun Solaris: -cclib -lunix -cclib -lnsl -cclib -lsocket\n"; - pr "# . others : -cclib -lunix\n"; - pr "OSDEPLIBS=%s\n\n" osdeplibs; - pr "# executable files extension, currently:\n"; - pr "# Unix systems:\n"; - pr "# Win32 systems : .exe\n"; - pr "EXE=%s\n" exe; - pr "DLLEXT=%s\n\n" dll; - pr "# the command MKDIR (try to use mkdirhier if you have problems)\n"; - pr "MKDIR=mkdir -p\n\n"; - pr "#the command STRIP\n"; - pr "# Unix systems and profiling: true\n"; - pr "# Unix systems and no profiling: strip\n"; - pr "STRIP=%s\n\n" strip; - pr "#the command md5sum\n"; - pr "MD5SUM=%s\n\n" md5sum; - pr "# LablGTK\n"; - pr "COQIDEINCLUDES=%s\n\n" !lablgtkincludes; - pr "# CoqIde (no/byte/opt)\n"; - pr "HASCOQIDE=%s\n" coqide; - pr "IDEFLAGS=%s\n" !idearchflags; - pr "IDEOPTCDEPS=%s\n" !idearchfile; - pr "IDECDEPS=%s\n" !idearchfile; - pr "IDECDEPSFLAGS=%s\n" !idecdepsflags; - pr "IDEINT=%s\n\n" !idearchdef; - pr "# Defining REVISION\n"; - pr "CHECKEDOUT=%s\n\n" vcs; - pr "# Option to control compilation and installation of the documentation\n"; - pr "WITHDOC=%s\n\n" (if withdoc then "all" else "no"); - pr "# Option to produce precompiled files for native_compute\n"; - pr "NATIVECOMPUTE=%s\n" (if !Prefs.nativecompiler then "-native-compiler" else ""); - close_out o; - Unix.chmod f 0o444 - -let _ = write_makefile "config/Makefile" - -let write_macos_metadata exec = - let f = "config/Info-"^exec^".plist" in - let () = safe_remove f in - let o = open_out f in - let pr s = fprintf o s in - pr "\n"; - pr "\n"; - pr "\n"; - pr "\n"; - pr " CFBundleIdentifier\n"; - pr " fr.inria.coq.%s\n" exec; - pr " CFBundleName\n"; - pr " %s\n" exec; - pr " CFBundleVersion\n"; - pr " %s\n" coq_macos_version; - pr " CFBundleShortVersionString\n"; - pr " %s\n" coq_macos_version; - pr " CFBundleInfoDictionaryVersion\n"; - pr " 6.0\n"; - pr "\n"; - pr "\n"; - let () = close_out o in - Unix.chmod f 0o444 - -let () = if arch = "Darwin" then -List.iter write_macos_metadata distributed_exec diff -Nru coq-doc-8.6/CONTRIBUTING.md coq-doc-8.15.0/CONTRIBUTING.md --- coq-doc-8.6/CONTRIBUTING.md 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/CONTRIBUTING.md 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,1351 @@ +# Guide to contributing to Coq # + +## Foreword ## + +As with any documentation, this guide is most useful if it's promptly +updated to reflect changes in processes, development tools, or the Coq +ecosystem. If you notice anything inaccurate or outdated, please +signal it in a new issue, or fix it in a new pull request. If you +find some parts are not sufficiently clear, you may open an issue as +well. + +## Table of contents ## + +- [Introduction](#introduction) +- [Contributing to the ecosystem](#contributing-to-the-ecosystem) + - [Asking and answering questions](#asking-and-answering-questions) + - [Writing tutorials and blog posts](#writing-tutorials-and-blog-posts) + - [Contributing to the wiki](#contributing-to-the-wiki) + - [Creating and maintaining Coq packages](#creating-and-maintaining-coq-packages) + - [Distribution of Coq packages](#distribution-of-coq-packages) + - [Support for plugin and library authors](#support-for-plugin-and-library-authors) + - [Standard libraries](#standard-libraries) + - [Maintaining existing packages in coq-community](#maintaining-existing-packages-in-coq-community) + - [Contributing to the editor support packages](#contributing-to-the-editor-support-packages) + - [Contributing to the website or the package archive](#contributing-to-the-website-or-the-package-archive) + - [Other ways of creating content](#other-ways-of-creating-content) +- [Issues](#issues) + - [Reporting a bug, requesting an enhancement](#reporting-a-bug-requesting-an-enhancement) + - [Beta testing](#beta-testing) + - [Helping triage existing issues](#helping-triage-existing-issues) +- [Code changes](#code-changes) + - [Using GitHub pull requests](#using-github-pull-requests) + - [Fixing bugs and performing small changes](#fixing-bugs-and-performing-small-changes) + - [Proposing large changes: Coq Enhancement Proposals](#proposing-large-changes-coq-enhancement-proposals) + - [Seeking early feedback on work-in-progress](#seeking-early-feedback-on-work-in-progress) + - [Taking feedback into account](#taking-feedback-into-account) + - [Understanding automatic feedback](#understanding-automatic-feedback) + - [Understanding reviewers' feedback](#understanding-reviewers-feedback) + - [Fixing your branch](#fixing-your-branch) + - [Improving the official documentation](#improving-the-official-documentation) + - [Contributing to the standard library](#contributing-to-the-standard-library) +- [Becoming a maintainer](#becoming-a-maintainer) + - [Reviewing pull requests](#reviewing-pull-requests) + - [Collaborating on a pull request](#collaborating-on-a-pull-request) + - [Merging pull requests](#merging-pull-requests) + - [Additional notes for pull request reviewers and assignees](#additional-notes-for-pull-request-reviewers-and-assignees) + - [Joining / leaving maintainer teams](#joining--leaving-maintainer-teams) + - [Core development team](#core-development-team) +- [Release management](#release-management) + - [Packaging Coq](#packaging-coq) +- [Additional resources](#additional-resources) + - [Developer documentation](#developer-documentation) + - [Where to find the resources](#where-to-find-the-resources) + - [Building Coq](#building-coq) + - [Continuous integration](#continuous-integration) + - [Code owners, issue and pull request templates](#code-owners-issue-and-pull-request-templates) + - [Style guide](#style-guide) + - [OCaml resources](#ocaml-resources) + - [Git documentation, tips and tricks](#git-documentation-tips-and-tricks) + - [GitHub documentation, tips and tricks](#github-documentation-tips-and-tricks) + - [GitLab documentation, tips and tricks](#gitlab-documentation-tips-and-tricks) + - [Merge script dependencies](#merge-script-dependencies) + - [Coqbot](#coqbot) + - [Online forum and chat to talk to developers](#online-forum-and-chat-to-talk-to-developers) + - [Coq calls](#coq-calls) + - [Coq remote working groups](#coq-remote-working-groups) + - [Coq Users and Developers Workshops](#coq-users-and-developers-workshops) + +## Introduction ## + +Thank you for your interest in contributing to Coq! There are many +ways to contribute, and we appreciate all of them. + +People often begin by making small contributions, and contributions to +the ecosystem, before working their way up incrementally to the core +parts of the system, and start to propose larger changes, or take an +active role in maintaining the system. So this is the way this +contributing guide is organized. However, it is by no means necessary +that you go through these steps in this order. Feel free to use this +guide as a reference and quickly jump to the part that is most +relevant to you at the current time. + +We want to make sure that contributing to Coq is a fun and positive +experience for everyone, so please make sure you read and abide by our +[Code of Conduct][Code-of-conduct]. + +## Contributing to the ecosystem ## + +In this section, we present all the ways to contribute to Coq outside +of the Coq repository itself. + +### Asking and answering questions ### + +One very important way of contributing is by asking and answering +questions, in order to create a body of easily-browsable, +problem-oriented, additional documentation. + +There are two main platforms for this purpose: + +- [Stack Overflow][Stack-Overflow] (or more generally the [Stack + Exchange][Stack-Exchange] platforms, as some Coq questions may be + asked on other sites, such as TCS Stack Exchange); +- Our [Discourse forum][Discourse]. + +In particular, our Discourse forum has several non-English categories +that have yet to find their public, so do not hesitate to advertise +them to people you know who might not be at ease with English. + +Other active places to answer questions include the [Coq-Club][] +mailing list, and the Coq IRC channel (`irc://irc.freenode.net/#coq`). + +### Writing tutorials and blog posts ### + +Writing about Coq, in the form of tutorials or blog posts, is also a +very important contribution. In particular, it can help new users get +interested in Coq, and learn about it, and existing users learn about +advance features. Our official resources, such as the [reference +manual][refman] are not suited for learning Coq, but serve as +reference documentation to which you can link from your tutorials. + +The Coq website has a page listing known +[tutorials][Coq-documentation] and the [wiki][] home page contains a +list too. You can expand the former through a pull request on the +[Coq website repository][Coq-website-repository], while the latter can +be edited directly by anyone with a GitHub account. + +At the current time, we do not have a way of aggregating blog posts on +a single page (like [OCaml planet][OCaml-planet]), but this would +probably be something useful to get, so do not hesitate if you want to +create it. Some people use [Reddit][] for this purpose. + +### Contributing to the wiki ### + +Coq's [wiki][] is an informal source of additional documentation which +anyone with a GitHub account can edit directly. In particular, it +contains the Coq [FAQ][] which has not seen so many updates in the +recent years. You should feel free to fix it, expand it, and even +refactor it (if you are not sure if some changes would be welcome, you +can open an issue to discuss them before performing them). + +People who watch the Coq repository will see recent wiki edits in +their GitHub feed. It is recommended to review them *a posteriori* to +check no mistake was introduced. The wiki is also a standard git +repository, so people can follow the changes using any standard git +tool. + +Coq's wiki is formatted using GitHub's flavored Markdown, with some +wiki-specific extensions. See: + +- [GitHub's Markdown guide][GitHub-markdown] +- [GitHub's wiki extensions][GitHub-wiki-extensions] + +### Creating and maintaining Coq packages ### + +*Note: this sub-section is about packages extending Coq, such as +plugins or libraries. A different, but also very valuable, +contribution is to package Coq for your preferred package manager (see +[Packaging Coq](#packaging-coq)).* + +Sharing reusable assets in the form of new libraries, plugins, and +tools is great so that others can start building new things on top. +Having an extensive and healthy package ecosystem will be key to the +success of Coq. + +#### Distribution of Coq packages #### + +You can distribute your library or plugin through the [Coq package +index][Coq-package-index]. Tools can be advertised on the [tools +page][tools-website] of the Coq website, or the [tools +page][tools-wiki] of the wiki. + +#### Support for plugin and library authors #### + +You can find advice and best practices about maintaining a Coq project +on the [coq-community wiki][coq-community-wiki]. + +Learn how to write a Coq plugin, and about best practices, in the Coq +[plugin tutorial][plugin-tutorial]. This tutorial is still a work in +progress, so do not hesitate to expand it, or ask questions. + +If you want quick feedback on best practices, or how to talk to the +Coq API, a good place to hang out is the [Coq devs & plugin devs +stream][Zulip-dev] of our Zulip chat. + +Finally, we strongly encourage authors of plugins to submit their +plugins to join Coq's continuous integration (CI) early on. Indeed, +the Coq API gets continuously reworked, so this is the best way of +ensuring your plugin stays compatible with new Coq versions, as this +means Coq developers will fix your plugin for you. Learn more about +this in the [CI README (user part)][CI-README-users]. + +Pure Coq libraries are also welcome to join Coq's CI, especially if +they test underused / undertested features. + +#### Standard libraries #### + +There are many general purpose Coq libraries, so before you publish +yours, consider whether you could contribute to an existing one +instead (either the official [standard +library](#contributing-to-the-standard-library), or one of the many +[alternative standard libraries][other-standard-libraries]). + +#### Maintaining existing packages in coq-community #### + +Some Coq packages are not maintained by their initial authors anymore +(for instance if they've moved on to new jobs or new projects) even if +they were useful, or interesting. The coq-community organization is a +place for volunteers to take over the maintenance of such packages. + +If you want to contribute by becoming a maintainer, there is [a list +of packages waiting for a +maintainer][coq-community-maintainer-wanted]. You can also propose a +package that is not listed. Find out more about coq-community in [the +manifesto's README][coq-community-manifesto]. + +### Contributing to the editor support packages ### + +Besides CoqIDE, whose sources are available in this repository, and to +which you are welcome to contribute, there are a number of alternative +user interfaces for Coq, more often as an editor support package. + +Here are the URLs of the repositories of the various editor support +packages: + +- Proof-General (Emacs major mode) +- Company-coq (Emacs minor mode) +- Coqtail (Vim) +- VsCoq Reloaded (VsCode) + +And here are alternative user interfaces to be run in the web browser: + +- JsCoq (Coq executed in your browser) +- Jupyter kernel for Coq + +Each of them has their own contribution process. + +### Contributing to the website or the package archive ### + +The website and the package archive have their own repositories: + +- +- + +You can contribute to them by using issues and pull requests on these +repositories. These repositories should get their own contributing +guides, but they don't have any at the time of writing this. + +### Other ways of creating content ### + +There are many other ways of creating content and making the Coq +community thrive, including many which we might not have thought +about. Feel free to add more references / ideas to this sub-section. + +You can tweet about Coq, you can give talks about Coq both in +academic, and in non-academic venues (such as developer conferences). + +[Codewars][] is a platform where people can try to solve some +programming challenges that were proposed by other community members. +Coq is supported and the community is eager to get more challenges. + +## Issues ## + +### Reporting a bug, requesting an enhancement ### + +Bug reports are enormously useful to identify issues with Coq; we +can't fix what we don't know about. To report a bug, please open an +issue in the [Coq issue tracker][Coq-issue-tracker] (you'll need a +GitHub account). You can file a bug for any of the following: + +- An anomaly. These are always considered bugs, so Coq will even ask + you to file a bug report! +- An error you didn't expect. If you're not sure whether it's a bug or + intentional, feel free to file a bug anyway. We may want to improve + the documentation or error message. +- Missing or incorrect documentation. It's helpful to track where the + documentation should be improved, so please file a bug if you can't + find or don't understand some bit of documentation. +- An error message that wasn't as helpful as you'd like. Bonus points + for suggesting what information would have helped you. +- Bugs in CoqIDE should also be filed in the [Coq issue + tracker][Coq-issue-tracker]. Bugs in the Emacs plugin should be + filed against [ProofGeneral][ProofGeneral-issues], or against + [company-coq][company-coq-issues] if they are specific to + company-coq features. + +It would help if you search the existing issues before reporting a +bug. This can be difficult, so consider it extra credit. We don't +mind duplicate bug reports. If unsure, you are always very welcome to +ask on our [Discourse forum][Discourse] or [Zulip chat][Zulip] +before, after, or while writing a bug report. + +It is better if you can test that your bug is still present in the +current testing or development version of Coq (see the [next +sub-section](#beta-testing)) before reporting it, but if you can't, it +should not discourage you from reporting it. + +When it applies, it's extremely helpful for bug reports to include sample +code, and much better if the code is self-contained and complete. It's not +necessary to minimize your bug or identify precisely where the issue is, +since someone else can often do this if you include a complete example. We +tend to include the code in the bug description itself, but if you have a +very large input file then you can add it as an attachment. + +If you want to minimize your bug (or help minimize someone else's) for +more extra credit, then you can use the [Coq bug +minimizer][JasonGross-coq-tools] (specifically, the bug minimizer is +the `find-bug.py` script in that repo). + +### Beta testing ### + +Coq gets a new major release about every six months. Before a new +major version is released, there is a beta-testing period, which +usually lasts one month (see the [release plan][release-plan]). You +can help make the upcoming release better, by testing the beta +version, and trying to port your projects to it. You should report +any bug you notice, but also any change of behavior that is not +documented in the changelog. Then Coq developers will be able to +check if what you reported is a regression that needs to be fixed, or +an expected change that needs to be mentioned in the changelog. + +You can go even further by using the development version (`master` +branch) of Coq on a day by day basis, and report problems as soon as +you notice them. If you wish to do so, the easiest way to install Coq +is through opam (using the `dev` version of the Coq package, available +in the repository) or through +[Nix][]. The documentation of the development version is [available +online][master-doc], including the [unreleased +changelog][unreleased-changelog]. + +### Helping triage existing issues ### + +Coq has too many bug reports for its core developers alone to manage. +You can help a lot by: + +- confirming that reported bugs are still active with the current + version of Coq; +- determining if the bug is a regression (new, and unexpected, + behavior from a recent Coq version); +- more generally, by reproducing a bug, on another system, + configuration, another version of Coq, and by documenting what you + did; +- giving a judgement about whether the reported behavior is really a + bug, or is expected but just improperly documented, or expected and + already documented; +- producing a trace if it is relevant and you know how to do it; +- producing another example exhibiting the same bug, or minimizing the + initial example using the bug minimizer mentioned above; +- using `git bisect` to find the commit that introduced a regression; +- fixing the bug if you have an idea of how to do so (see the + [following section](#code-changes)). + +Once you have some experience with the Coq issue tracker, you can +request to join the **@coq/contributors** team (any member of the +**@coq/core** team can do so using [this link][add-contributor]). +Being in this team will grant you the following access: + +- **Updating labels:** every open issue and pull request should + ideally get one or several `kind:` and `part:` labels. In + particular, valid issues should generally get either a `kind: bug` + (the reported behavior can indeed be considered a bug, this can be + completed with the `kind: anomaly`, and `kind: regression` labels), + `kind: documentation` (e.g. if a reported behavior is expected but + improperly documented), `kind: enhancement` (a request for + enhancement of an existing feature), or `kind: feature` label (an + idea for a new feature). +- **Creating new labels:** if you feel a `part:` label is missing, do + not hesitate to create it. If you are not sure, you may discuss it + with other contributors and developers on [Zulip][Zulip-dev] first. +- **Closing issues:** if a bug cannot be reproduced anymore, is a + duplicate, or should not be considered a bug report in the first + place, you should close it. When doing so, try putting an + appropriate `resolved:` label to indicate the reason. If the bug + has been fixed already, and you know in which version, you can add a + milestone to it, even a milestone that's already closed, instead of + a `resolved:` label. When closing a duplicate issue, try to add all + the additional info that could be gathered to the original issue. +- **Editing issue titles:** you may want to do so to better reflect + the current understanding of the underlying issue. +- **Editing comments:** feel free to do so to fix typos and formatting + only (in particular, some old comments from the Bugzilla era or + before are not properly formatted). You may also want to edit the + OP's initial comment (a.k.a. body of the issue) to better reflect + the current understanding of the issue, especially if the discussion + is long. If you do so, only add to the original comment, and mark + it clearly with an `EDITED by @YourNickname:`. +- **Hiding comments:** when the discussion has become too long, this + can be done to hide irrelevant comments (off-topic, outdated or + resolved sub-issues). +- **Deleting things:** please don't delete any comment or issue, our + policy doesn't allow for comments to be deleted, unless done by the + community moderators. You should hide them instead. An audit log + is available to track deleted items if needed (but does not allow + recovering them). +- **Pushing a branch or a tag to the main repository:** please push + changes to your own fork rather than the main repository. (Branches + pushed to the main repository will be removed promptly and without + notice.) + +Yet to be fully specified: use of priority, difficulty, `help wanted`, +and `good first issue` labels, milestones, assignments, and GitHub +projects. + +## Code changes ## + +### Using GitHub pull requests ### + +If you want to contribute a documentation update, bug fix or feature +yourself, pull requests (PRs) on the [GitHub +repository][coq-repository] are the way to contribute directly to the +Coq implementation (all changes, even the smallest changes from core +developers, go through PRs). You will need to create a fork of the +repository on GitHub and push your changes to a new "topic branch" in +that fork (instead of using an existing branch name like `master`). + +PRs should always target the `master` branch. Make sure that your +copy of this branch is up-to-date before starting to do your changes, +and that there are no conflicts before submitting your PR. If you +need to fix conflicts, we generally prefer that you rebase your branch +on top of `master`, instead of creating a merge commit. + +If you are not familiar with `git` or GitHub, Sections [Git +documentation, tips and tricks](#git-documentation-tips-and-tricks), +and [GitHub documentation, tips and +tricks](#github-documentation-tips-and-tricks), should be helpful (and +even if you are, you might learn a few tricks). + +Once you have submitted your PR, it may take some time to get +feedback, in the form of reviews from maintainers, and test results +from our continuous integration system. Our code owner system will +automatically request reviews from relevant maintainers. Then, one +maintainer should self-assign the PR (if that does not happen after a +few days, feel free to ping the maintainers that were requested a +review). The PR assignee will then become your main point of contact +for handling the PR: they should ensure that everything is in order +and merge when it is the case (you can ping them if the PR is ready +from your side but nothing happens for a few days). + +After your PR is accepted and merged, it may get backported to a +release branch if appropriate, and will eventually make it to a +release. You do not have to worry about this, it is the role of the +assignee and the release manager to do so (see Section [Release +management](#release-management)). The milestone should give you an +indication of when to expect your change to be released (this could be +several months after your PR is merged). That said, you can start +using the latest Coq `master` branch to take advantage of all the new +features, improvements, and fixes. + +#### Fixing bugs and performing small changes #### + +Before fixing a bug, it is best to check that it was reported before: + +- If it was already reported and you intend to fix it, self-assign the + issue (if you have the permission), or leave a comment marking your + intention to work on it (and a contributor with write-access may + then assign the issue to you). + +- If the issue already has an assignee, you should check with them if + they still intend to work on it. If the assignment is several + weeks, months, or even years (!) old, there are good chances that it + does not reflect their current priorities. + +- If the bug has not been reported before, it can be a good idea to + open an issue about it, while stating that you are preparing a fix. + The issue can be the place to discuss about the bug itself while the + PR will be the place to discuss your proposed fix. + +It is generally a good idea to add a regression test to the +test-suite. See the test-suite [README][test-suite-README] for how to +do so. + +Small fixes do not need any documentation, or changelog update. New, +or updated, user-facing features, and major bug fixes do. See above +on how to contribute to the documentation, and the README in +[`doc/changelog`][user-changelog] for how to add a changelog entry. + +#### Proposing large changes: Coq Enhancement Proposals #### + +You are always welcome to open a PR for a change of any size. +However, you should be aware that the larger the change, the higher +the chances it will take very long to review, and possibly never get +merged. + +So it is recommended that before spending a lot of time coding, you +seek feedback from maintainers to see if your change would be +supported, and if they have recommendations about its implementation. +You can do this informally by opening an issue, or more formally by +producing a design document as a [Coq Enhancement Proposal][CEP]. + +Another recommendation is that you do not put several unrelated +changes in the same PR (even if you produced them together). In +particular, make sure you split bug fixes into separate PRs when this +is possible. More generally, smaller-sized PRs, or PRs changing less +components, are more likely to be reviewed and merged promptly. + +#### Seeking early feedback on work-in-progress #### + +You should always feel free to open your PR before the documentation, +changelog entry and tests are ready. That's the purpose of the +checkboxes in the PR template which you can leave unticked. This can +be a way of getting reviewers' approval before spending time on +writing the documentation (but you should still do it before your PR +can be merged). + +If even the implementation is not ready but you are still looking for +early feedback on your code changes, please use the [draft +PR](#draft-pull-requests) mechanism. + +If you are looking for feedback on the design of your change, rather +than on its implementation, then please refrain from opening a PR. +You may open an issue to start a discussion, or create a [Coq +Enhancement Proposal][CEP] if you have a clear enough view of the +design to write a document about it. + +### Taking feedback into account ### + +#### Understanding automatic feedback #### + +When you open or update a PR, you get automatically some feedback: we +have a bot whose job will be to push a branch to our GitLab mirror to +run some continuous integration (CI) tests. The tests will run on a +commit merging your branch with the base branch, so if there is a +conflict and this merge cannot be performed automatically, the bot +will put a `needs: rebase` label, and the tests won't run. + +Otherwise, a large suite of tests will be run on GitLab, plus some +additional tests on GitHub Actions for Windows and macOS compatibility. + +If a test fails on GitLab, you will see in the GitHub PR interface, +both the failure of the whole pipeline, and of the specific failed +job. Most of these failures indicate problems that should be +addressed, but some can still be due to synchronization issues out of +your control. In particular, if you get a failure in one of the +tested plugins but you didn't change the Coq API, it is probably a +transient issue and you shouldn't have to worry about it. In case of +doubt, ask the reviewers. + +##### Test-suite failures ##### + +If you broke the test-suite, you should get many failed jobs, because +the test-suite is run multiple times in various settings. You should +get the same failure locally by running `make test-suite` or `make -f +Makefile.dune test-suite`. It's helpful to run this locally and +ensure the test-suite is not broken before submitting a PR as this +will spare a lot of runtime on distant machines. + +To learn more about the test-suite, you should refer to its +[README][test-suite-README]. + +##### Linter failures ##### + +We have a linter that checks a few different things: + +- **Every commit can build.** This is an important requirement to + allow the use of `git bisect` in the future. It should be possible + to build every commit, and in principle even the test-suite should + pass on every commit (but this isn't tested in CI because it would + take too long). A good way to test this is to use `git rebase + master --exec "make -f Makefile.dune check"`. +- **No tabs or end-of-line spaces on updated lines**. We are trying + to get rid of all tabs and all end-of-line spaces from the code base + (except in some very special files that need them). This checks not + only that you didn't introduce new ones, but also that updated lines + are clean (even if they were there before). You can avoid worrying + about tabs and end-of-line spaces by installing our [pre-commit git + hook][git-hook], which will fix these issues at commit time. + Running `./configure` once will install this hook automatically + unless you already have a pre-commit hook installed. If you are + encountering these issues nonetheless, you can fix them by rebasing + your branch with `git rebase --whitespace=fix`. +- **All files should end with a single newline**. See the section + [Style guide](#style-guide) for additional style recommendations. +- **Documented syntax is up-to-date**. If you update the grammar, you + should run `make -f Makefile.make doc_gram_rsts` to update the + documented syntax. You should then update the text describing the + syntax in the documentation and commit the changes. In some cases, + the documented syntax is edited to make the documentation more + readable. In this case, you may have to edit + `doc/tools/docgram/common.edit_mlg` to make `doc_gram_rsts` pass. + See [doc_grammar's README][doc_gram] for details. + + Note that in the case where you added new commands or tactics, you + will have to manually insert them in the documentation, the tool + won't do that for you, only check that what you documented is + consistent with the parser. + +You may run the linter yourself with `dev/lint-repository.sh`. + +##### Plugin failures ##### + +If you did change the Coq API, then you may have broken a plugin. +After ensuring that the failure comes from your change, you will have +to provide a fix to the plugin, and the PR assignee will have to +ensure that this fix is merged in the plugin simultaneously with your +PR on the Coq repository. + +If your changes to the API are not straightforward, you should also +document them in `dev/doc/changes.md`. + +The [CI README (developer part)][CI-README-developers] contains more +information on how to fix plugins, test and submit your changes, and +how you can anticipate the results of the CI before opening a PR. + +##### Library failures ##### + +Such a failure can indicate either a bug in your branch, or a breaking +change that you introduced voluntarily. All such breaking changes +should be properly documented in the [user changelog][user-changelog]. +Furthermore, a backward-compatible fix should be found, properly +documented in the changelog when non-obvious, and this fix should be +merged in the broken projects *before* your PR to the Coq repository +can be. + +Note that once the breaking change is well understood, it should not +feel like it is your role to fix every project that is affected: as +long as reviewers have approved and are ready to integrate your +breaking change, you are entitled to (politely) request project +authors / maintainers to fix the breakage on their own, or help you +fix it. Obviously, you should leave enough time for this to happen +(you cannot expect a project maintainer to allocate time for this as +soon as you request it) and you should be ready to listen to more +feedback and reconsider the impact of your change. + +#### Understanding reviewers' feedback #### + +The reviews you get are highly dependent on the kind of changes you +did. In any case, you should always remember that reviewers are +friendly volunteers that do their best to help you get your changes in +(and should abide by our [Code of Conduct][Code-of-Conduct]). But at +the same time, they try to ensure that code that is introduced or +updated is of the highest quality and will be easy to maintain in the +future, and that's why they may ask you to perform small or even large +changes. If you need a clarification, do not hesitate to ask. + +Here are a few labels that reviewers may add to your PR to track its +status. In general, this will come in addition to comments from the +reviewers, with specific requests. + +- [needs: rebase][needs-rebase] indicates the PR should be rebased on + top of the latest version of the base branch (usually `master`). We + generally ask you to rebase only when there are merge conflicts or + if the PR has been opened for a long time and we want a fresh CI + run. +- [needs: fixing][needs-fixing] indicates the PR needs a fix, as + discussed in the comments. +- [needs: documentation][needs-documentation] indicates the PR + introduces changes that should be documented before it can be merged. +- [needs: changelog entry][needs-changelog] indicates the PR introduces + changes that should be documented in the [user + changelog][user-changelog]. +- [needs: benchmarking][needs-benchmarking] and [needs: testing][needs-testing] + indicate the PR needs testing beyond what the test suite can handle. + For example, performance benchmarking is currently performed with a different + infrastructure ([documented in the wiki][Benchmarking]). Unless some followup + is specifically requested, you aren't expected to do this additional testing. + +More generally, such labels should come with a description that should +allow you to understand what they mean. + +#### Fixing your branch #### + +If you have changes to perform before your PR can be merged, you might +want to do them in separate commits at first to ease the reviewers' +task, but we generally appreciate that they are squashed with the +commits that they fix before merging. This is especially true of +commits fixing previously introduced bugs or failures. + +### Improving the official documentation ### + +The documentation is usually a good place to start contributing, +because you can get used to the pull request submitting and review +process, without needing to learn about the code source of Coq at the +same time. + +The official documentation is formed of two components: + +- the [reference manual][refman], +- the [documentation of the standard library][stdlib-doc]. + +The sources of the reference manual are located in the +[`doc/sphinx`][refman-sources] directory. They are written in rst +(Sphinx) format with some Coq-specific extensions, which are +documented in the [README][refman-README] in the above directory. +This README was written to be read from begin to end. As soon as your +edits to the documentation are more than changing the textual content, +we strongly encourage you to read this document. + +The documentation of the standard library is generated with +[coqdoc][coqdoc-documentation] from the comments in the sources of the +standard library. + +The [README in the `doc` directory][doc-README] contains more +information about the documentation's build dependencies, and the +`make` targets. + +You can browse through the list of open documentation issues using the +[kind: documentation][kind-documentation] label, or the [user +documentation GitHub project][documentation-github-project] (you can +look in particular at the "Writing" and "Fixing" columns). + +### Contributing to the standard library ### + +Contributing to the standard library is also made easier by not having +to learn about Coq's internals, and its implementation language. + +Due to the compatibility constraints created by the many projects that +depend on it, proposing breaking changes, such as changing a +definition, may frequently be rejected, or at the very least might +take a long time before getting approved and merged. This does not +mean that you cannot try. On the other hand, contributing new lemmas +on existing definitions and cleaning up existing proofs are likely to +be accepted. Contributing new operations on existing types are also +likely to be accepted in many cases. In case of doubt, ask in an +issue before spending too much time preparing your PR. + +If you create a new file, it needs to be listed in +`doc/stdlib/index-list.html`. + +Add coqdoc comments to extend the [standard library +documentation][stdlib-doc]. See the [coqdoc +documentation][coqdoc-documentation] to learn more. + +## Becoming a maintainer ## + +### Reviewing pull requests ### + +You can start reviewing PRs as soon as you feel comfortable doing so +(anyone can review anything, although some designated reviewers +will have to give a final approval before a PR can be merged, as is +explained in the next sub-section). + +Reviewers should ensure that the code that is changed or introduced is +in good shape and will not be a burden to maintain, is unlikely to +break anything, or the compatibility-breakage has been identified and +validated, includes documentation, changelog entries, and test files +when necessary. Reviewers can use labels, or change requests to +further emphasize what remains to be changed before they can approve +the PR. Once reviewers are satisfied (regarding the part they +reviewed), they should formally approve the PR, possibly stating what +they reviewed. + +That being said, reviewers should also make sure that they do not make +the contributing process harder than necessary: they should make it +clear which comments are really required to perform before approving, +and which are just suggestions. They should strive to reduce the +number of rounds of feedback that are needed by posting most of their +comments at the same time. If they are opposed to the change, they +should clearly say so from the beginning to avoid the contributor +spending time in vain. + +Furthermore, when reviewing a first contribution (GitHub highlights +first-time contributors), be extra careful to be welcoming, whatever +the decision on the PR is. When approving a PR, consider thanking the +newcomer for their contribution, even if it is a very small one (in +cases where, if the PR had come from a regular contributor, it would +have felt OK to just merge it without comment). When rejecting a PR, +take some extra steps to explain the reasons, so that it doesn't feel +hurtful. Don't hesitate to still thank the contributor and possibly +redirect them to smaller tasks that might be more appropriate for a +newcomer. + +#### Collaborating on a pull request #### + +Beyond making suggestions to a PR author during the review process, +you may want to collaborate further by checking out the code, making +changes, and pushing them. There are two main ways of doing this: + +- **Pull requests on pull requests:** You can checkout the PR branch + (GitHub provides the link to the remote to pull from and the branch + name on the top and the bottom of the PR discussion thread), + checkout a new personal branch from there, do some changes, commit + them, push to your fork, and open a new PR on the PR author's fork. +- **Pushing to the PR branch:** If the PR author has not unchecked the + "Allow edit from maintainers" checkbox, and you have write-access to + the repository (i.e. you are in the **@coq/contributors** team), + then you can also push (and even force-push) directly to the PR + branch, on the main author's fork. Obviously, don't do it without + coordinating with the PR author first (in particular, in case you + need to force-push). + +When several people have co-authored a single commit (e.g. because +someone fixed something in a commit initially authored by someone +else), this should be reflected by adding ["Co-authored-by:" +tags][GitHub-co-authored-by] at the end of the commit message. The +line should contain the co-author name and committer e-mail address. + +### Merging pull requests ### + +Our [CODEOWNERS][] file associates a team of maintainers to each +component. When a PR is opened (or a [draft PR](#draft-pull-requests) +is marked as ready for review), GitHub will automatically request +reviews to maintainer teams of affected components. As soon as it is +the case, one available member of a team that was requested a review +should self-assign the PR, and will act as its shepherd from then on. + +The PR assignee is responsible for making sure that all the proposed +changes have been reviewed by relevant maintainers (at least one +reviewer for each component that is significantly affected), that +change requests have been implemented, that CI is passing, and +eventually will be the one who merges the PR. + +*If you have already frequently contributed to a component, we would +be happy to have you join one of the maintainer teams.* See the +[section below](#joining--leaving-maintainer-teams) on joining / +leaving maintainer teams. + +The complete list of maintainer teams is available [here][coq-pushers] +(link only accessible to people who are already members of the Coq +organization, because of a limitation of GitHub). + +#### Additional notes for pull request reviewers and assignees #### + +- NEVER USE GITHUB'S MERGE BUTTON. Instead, you should either: + + - post a comment containing "@coqbot: merge now"; + This is the recommended method and more convenient than the previous + script based method (see next bullet) e.g. for developers who do not have + a GPG key and for when you do not have access to a console. + "coqbot" will **not** check CI status - it is expected that the merger does + this manually upfront, but coqbot will deny the merge with an error + response in the following cases: + - no assignee + - no milestone + - no `kind` label + - left-over `needs` labels + - you try to merge a PR which you authored (this is decided by the + creator of the PR - reviewers can still do minor changes and merge) + + - alternatively run the [`dev/tools/merge-pr.sh`][merge-pr] script; + Since "coqbot" this method is deprecated with a few exceptions, like + merges to release branches - which only release managers do. + This requires having configured gpg with git. + +- PR authors or co-authors cannot review, self-assign, or merge the PR + they contributed to. However, reviewers may push small fixes to the + PR branch to facilitate the PR integration. + +- PRs are merged when there is consensus. Consensus is defined by an + explicit approval from at least one maintainer for each component + that is significantly affected and an absence of dissent. As soon + as a developer opposes a PR, it should not be merged without being + discussed first (usually in a call or working group). + +- Sometimes (especially for large or potentially controversial PRs), + it is a good practice to announce the intent to merge, one or + several days in advance, when unsure that everyone had a chance to + voice their opinion, or to finish reviewing the PR. + +- Only PRs targetting the `master` branch can be merged by a + maintainer. For PRs targetting a release branch, the assignee + should always be the release manager. + +- Before merging, the assignee must also select a milestone for the PR + (see also Section [Release management](#release-management)). + +- To know which files you are a maintainer of, you can look for black + shields icons in the "Files changed" tab. Alternatively, you may + use the [`dev/tools/check-owners-pr.sh`][check-owners] script for + the same purpose. + + ![shield icon](dev/doc/shield-icon.png) + +- When a PR has [overlays][user-overlays], then: + + - the overlays that are backward-compatible (normally the case for + overlays fixing Coq code) should have been merged *before* the PR + can be merged; it might be a good idea to ask the PR author to + remove the overlay information from the PR to get a fresh CI run + and ensure that all the overlays have been merged; the PR assignee + may also push a commit removing the overlay information (in that + case the assignee is not considered a co-author, hence no need to + change the assignee) + + - the overlays that are not backward-compatible (normally only the + case for overlays fixing OCaml code) should be merged *just after* + the PR has been merged (and thus the assignee should ping the + maintainers of the affected projects to ask them to merge the + overlays). + +#### Joining / leaving maintainer teams #### + +We are always happy to have more people involved in the PR reviewing +and merging process, so do not hesitate to propose yourself if you +already have experience on a component. + +Maintainers can leave teams at any time (and core members can also +join any team where they feel able to help) but you should always +announce it to other maintainers when you do join or leave a team. + +### Core development team ### + +The core developers are the active developers with a lengthy and +significant contribution track record. They are the ones with admin +powers over the Coq organization, and the ones who take part in votes +in case of conflicts to take a decision (rare). One of them is +designated as a development coordinator, and has to approve the +changes in the core team membership (until we get a more formal +joining and leaving process). + +The core developers are the members of the **@coq/core** team ([member +list][coq-core] only visible to the Coq organization members because +of a limitation of GitHub). + +## Release management ## + +Coq's major release cycles generally span about six months, with about +4-5 months of development, and 1-2 months of stabilization / +beta-releases. The release manager (RM) role is a rolling position +among core developers. The [release plan][release-plan] is published +on the wiki. + +Development of new features, refactorings, deprecations and clean-ups +always happens on `master`. Stabilization starts by branching +(creating a new `v...` release branch from the current `master`), which +marks the beginning of a feature freeze (new features will continue to +be merged into `master` but won't make it for the upcoming major +release, but only for the next one). + +After branching, most changes are introduced in the release branch by a +backporting process. PR authors and assignee can signal a desire to +have a PR backported by selecting an appropriate milestone. Most of +the time, the choice of milestone is between two options: the next +major version that has yet to branch from `master`, or the next +version (beta, final, or patch-level release) of the active release +branch. In the end, it is the RM who decides whether to follow or not +the recommendation of the PR assignee, and who backports PRs to the +release branch. + +Very specific changes that are only relevant for the release branch and +not for the `master` branch can result in a PR targetting the release +branch instead of `master`. In this case, the RM is the only one who +can merge the PR, and they may even do so if they are the author of +the PR. Examples of such PRs include bug fixes to a feature that has +been removed in `master`, and PRs from the RM changing the version +number in preparation for the next release. + +Some automation is in place to help the RM in their task: a GitHub +project is created at branching time to manage PRs to backport; when a +PR is merged in a milestone corresponding to the release branch, our +bot will add this PR in a "Request inclusion" column in this project; +the RM can browse through the list of PRs waiting to be backported in +this column, possibly reject some of them by simply removing the PR +from the column (in which case, the bot will update the PR milestone), +and proceed to backport others; when a backported PR is pushed to the +release branch, the bot moves the PR from the "Request inclusion" +column to a "Shipped" column. + +More information about the RM tasks can be found in the [release +process checklist][RM-checklist]. + +### Packaging Coq ### + +The RM role does not include the task of making Coq available through +the various package managers out there: several contributors (most +often external to the development team) take care of this, and we +thank them for this. If your preferred package manager does not +include Coq, it is a very worthy contribution to make it available +there. But be careful not to let a package get outdated, as this +could lead some users to install an outdated version of Coq without +even being aware of it. + +This [Repology page][repology-coq] lists the versions of Coq which are +packaged in many repositories, although it is missing information on +some repositories, like opam. + +The Windows and macOS installers are auto-generated in our CI, and +this infrastructure has dedicated maintainers within the development +team. + +## Additional resources ## + +### Developer documentation ### + +#### Where to find the resources #### + +- You can find developer resources in the `dev` directory, and more + specifically developer documentation in `dev/doc`. The + [README][dev-README] in the `dev` directory lists what's available. + + For example, [`dev/doc/README.md`][dev-doc-README] is a beginner's + guide to hacking Coq, and documentation on debugging Coq can be + found in [`dev/doc/debugging.md`][debugging-doc]. + +- When it makes sense, the documentation is kept even closer to the + sources, in README files in various directories (e.g. the test-suite + [README][test-suite-README] or the refman [README][refman-README]). + +- Documentation of the Coq API is written directly in comments in + `.mli` files. You can browse it on [the Coq website][api-doc], or + rebuild it locally (`make -f Makefile.dune apidoc`, requires `odoc` + and `dune`). + +- A plugin tutorial is located in + [`doc/plugin_tutorial`][plugin-tutorial]. + +- The Coq [wiki][] contains additional developer resources. + +#### Building Coq #### + +The list of dependencies can be found in the first section of the +[`INSTALL.md`](INSTALL.md) file. + +Today, the recommended method for building Coq is to use `dune`. Run +`make -f Makefile.dune` to get help on the various available targets, +Additional documentation can be found in +[`dev/doc/build-system.dune.md`][dev-doc-dune], and in [the official +Dune documentation][dune-doc]. + +The legacy make-based system is still available. If you wish to use +it, you need to start by running `./configure -profile devel`. Most +of the available targets are not documented, so you will need to ask. + +#### Continuous integration #### + +Continuous integration (CI) testing is key in ensuring that the +`master` branch is kept in a well-functioning state at all times, and +that no accidental compatibility breakages are introduced. Our CI is +quite extensive since it includes testing many external projects, some +of them taking more than an hour to compile. However, you can get +partial results much more quickly (when our CI is not overloaded). + +The main documentation resources on our CI are: + +- the [README for users, i.e. plugin and library authors][CI-README-users]; +- the [README for developers, and contributors][CI-README-developers]; +- the README of the [user-overlays][] directory. + +Preparing an overlay (i.e. a patch to an external project that we test +in our CI, to make it compile with the modified version of Coq in your +branch) is a step that everyone goes through at some point. All you +need to know to prepare an overlay manually is in the README in the +[user-overlays][] directory. You might want to use some additional +tooling such as the `make ci-*` targets of `Makefile.ci`, the Nix +support for getting the dependencies of the external projects (see the +README in [`dev/ci/nix`][dev-ci-nix], and the (so far undocumented) +[`dev/tools/create_overlays.sh`][dev-tools-create_overlays.sh] script. + +More work is to be done on understanding how each developer proceeds +to prepare overlays, and propose a simplified and documented +procedure. + +We also have a benchmarking infrastructure, which is documented [on +the wiki][Benchmarking]. + +##### Restarting failed jobs ##### + +When CI has a few failures which look spurious, restarting the +corresponding jobs is a good way to ensure this was indeed the case. +You can restart jobs on Azure from the "Checks" tab on GitHub. To +restart a job on GitLab CI, you should sign into GitLab (this can be +done using a GitHub account); if you are part of the [Coq organization +on GitLab](https://gitlab.com/coq), you should see a "Retry" button; +otherwise, send a request to join the organization. + +#### Code owners, issue and pull request templates #### + +These files can be found in the [`.github`](.github) directory. The +templates are particularly useful to remind contributors what +information we need for them, and, in the case of PRs, to update the +documentation, changelog, and test-suite when relevant. + +GitHub now supports setting up multiple issue templates, and we could +use this to define distinct requirements for various kind of bugs, +enhancement and feature requests. + +#### Style guide #### + +There exists an [old style guide][old-style-guide] whose content is +still mostly relevant. Yet to be done: extract the parts that are +most relevant, and put them in this section instead. + +We don't use a code formatter at the current time, and we are +reluctant to merge changes to parts of the code that are unchanged +aside from formatting. However, it is still a good idea if you don't +know how to format a block of code to use the formatting that +[ocamlformat][] would give + +#### OCaml resources #### + +You can find lots of OCaml resources on , including +documentation, a Discourse forum, the package archive, etc. You may +also want to refer to the [Dune documentation][dune-doc]. + +Another ressource is , especially its +[community page][ocamlverse-community], which lists the various OCaml +discussion platforms. + +#### Git documentation, tips and tricks #### + +Lots of resources about git, the version control system, are available +on the web, starting with the [official website][git]. + +We recommend a setup with two configured remotes, one for the official +Coq repository, called `upstream`, and one for your fork, called +`origin`. Here is a way to do this for a clean clone: + +``` shell +git clone https://github.com/coq/coq -o upstream +cd coq +git remote add origin git@github.com:$YOURNAME/coq +# Make sure you click the fork button on GitHub so that this repository exists +cp dev/tools/pre-commit .git/hooks/ # Setup the pre-commit hook +``` + +Then, if you want to prepare a fix: + +``` shell +# Make sure we start from an up-to-date master +git checkout master +git pull --ff-only # If this fails, then your master branch is messy +git checkout -b my-topic-branch +# Modify some files +git add . +# Every untracked or modified file will be included in the next commit +# You can also replace the dot with an explicit list of files +git commit -m "My commit summary. + +You can add more information on multiple lines, +but you need to skip a line first." +git push -u origin my-topic-branch +# Next time, you push to this branch, you can just do git push +``` + +When you push a new branch for the first time, GitHub gives you a link +to open a PR. + +If you need to fix the last commit in your branch (typically, if your +branch has a single commit on top of `master`), you can do so with + +``` +git add . +git commit --amend --no-edit +``` + +If you need to fix another commit in your branch, or if you need to +fix a conflict with `master`, you will need to learn about `git rebase`. +GitHub provides [a short introduction][GitHub-rebase] to `git rebase`. + +#### GitHub documentation, tips and tricks #### + +GitHub has [extensive documentation][GitHub-doc] about everything you +can do on the platform, and tips about using `git` as well. See in +particular, [how to configure your commit e-mail +address][GitHub-commit-email] and [how to open a PR from a +fork][GitHub-PR-from-fork]. + +##### Watching the repository ##### + +["Watching" this repository][GitHub-watching] can result in a very +large number of notifications. We recommend you, either, [configure +your mailbox][notification-email] to handle incoming notifications +efficiently, or you read your notifications within a web browser. You +can configure how you receive notifications in [your GitHub +settings][GitHub-notification-settings], you can use the GitHub +interface to mark as read, save for later or mute threads. You can +also manage your GitHub web notifications using a tool such as +[Octobox][]. + +##### Draft pull requests ##### + +[Draft PRs][GitHub-draft-PR] are a mechanism proposed by GitHub to +open a pull request before it is ready for review. + +Opening a draft PR is a way of announcing a change and seeking early +feedback without formally requesting maintainers' reviews. Indeed, +you should avoid cluttering our maintainers' review request lists +before a change is ready on your side. + +When opening a draft PR, make sure to give it a descriptive enough +title so that interested developers still notice it in their +notification feed. You may also advertise it by talking about it in +our [developer chat][Zulip-dev]. If you know which developer would be +able to provide useful feedback to you, you may also ping them. + +###### Turning a PR into draft mode ###### + +If a PR was opened as ready for review, but it turns out that it still +needs work, it can be transformed into a draft PR. + +In this case, previous review requests won't be removed automatically. +Someone with write access to the repository should remove them +manually. Afterwards, upon marking the PR as ready for review, +someone with write access will have to manually add the review +requests that were previously removed. + +#### GitLab documentation, tips and tricks #### + +We use GitLab mostly for its CI service. The [Coq organization on +GitLab][GitLab-coq] hosts a number of CI/CD-only mirrors. If you are +a regular contributor, you can request access to it from [the +organization page][GitLab-coq]: this will grant you permission to +restart failing CI jobs. + +GitLab too has [extensive documentation][GitLab-doc], in particular on +configuring CI. + +#### Merge script dependencies #### + +The merge script passes option `-S` to `git merge` to ensure merge +commits are signed. Consequently, it depends on the GnuPG command +utility being installed and a GPG key being available. Here is a +short documentation on how to use GPG, git & GitHub: +https://help.github.com/articles/signing-commits-with-gpg/. + +The script depends on a few other utilities. If you are a Nix user, +the simplest way of getting them is to run `nix-shell` first. + +**Note for homebrew (MacOS) users:** it has been reported that +installing GnuPG is not out of the box. Installing explicitly +`pinentry-mac` seems important for typing of passphrase to work +correctly (see also this [Stack Overflow Q-and-A][pinentry-mac]). + +#### Coqbot #### + +Our bot sources can be found at . Its +documentation is still a work-in-progress. + +### Online forum and chat to talk to developers ### + +We have a [Discourse forum][Discourse] (see in particular the [Coq +development][Discourse-development-category] category) and a [Zulip +chat][Zulip] (see in particular the [Coq devs & plugin devs][Zulip-dev] +stream). Feel free to join any of them and ask questions. +People are generally happy to help and very reactive. + +Obviously, the issue tracker is also a good place to ask questions, +especially if the development processes are unclear, or the developer +documentation should be improved. + +### Coq calls ### + +We try to gather every week for one hour through video-conference to +discuss current and urgent matters. When longer discussions are +needed, topics are left out for the next working group. See the +[wiki][wiki-calls] for more information about Coq calls, as well as +notes of past ones. + +### Coq remote working groups ### + +We semi-regularly (up to every month) organize remote working groups, +which can be accessed through video-conference, and are most often +live streamed on [YouTube][]. Summary notes and announcements of the +next working group can be found [on the wiki][wiki-WG] + +These working groups are where important decisions are taken, most +often by consensus, but also, if it is needed, by a vote of core +developers. + +### Coq Users and Developers Workshops ### + +We have an annual gathering late Spring in France where most core +developers are present, and whose objective is to help new +contributors get started with the Coq codebase, provide help to plugin +and library authors, and more generally have fun together. + +The list of past (and upcoming, when it's already planned) workshops +can be found [on the wiki][wiki-CUDW]. + +[add-contributor]: https://github.com/orgs/coq/teams/contributors/members?add=true +[api-doc]: https://coq.github.io/doc/master/api/ +[Benchmarking]: https://github.com/coq/coq/wiki/Benchmarking +[CEP]: https://github.com/coq/ceps +[check-owners]: dev/tools/check-owners-pr.sh +[CI-README-developers]: dev/ci/README-developers.md +[CI-README-users]: dev/ci/README-users.md +[Code-of-Conduct]: CODE_OF_CONDUCT.md +[CODEOWNERS]: .github/CODEOWNERS +[Codewars]: https://www.codewars.com/?language=coq +[company-coq-issues]: https://github.com/cpitclaudel/company-coq/issues +[Coq-Club]: https://sympa.inria.fr/sympa/arc/coq-club +[coq-community-maintainer-wanted]: https://github.com/coq-community/manifesto/issues?q=is%3Aissue+is%3Aopen+label%3Amaintainer-wanted +[coq-community-manifesto]: https://github.com/coq-community/manifesto +[coq-community-wiki]: https://github.com/coq-community/manifesto/wiki +[coq-core]: https://github.com/orgs/coq/teams/core/members +[coqdoc-documentation]: https://coq.inria.fr/refman/practical-tools/utilities.html#documenting-coq-files-with-coqdoc +[Coq-documentation]: https://coq.inria.fr/documentation +[Coq-issue-tracker]: https://github.com/coq/coq/issues +[Coq-package-index]: https://coq.inria.fr/packages +[coq-pushers]: https://github.com/orgs/coq/teams/pushers/teams +[coq-repository]: https://github.com/coq/coq +[Coq-website-repository]: https://github.com/coq/www +[debugging-doc]: dev/doc/debugging.md +[dev-ci-nix]: dev/ci/nix/README.md +[dev-doc-README]: dev/doc/README.md +[dev-doc-dune]: dev/doc/build-system.dune.md +[dev-README]: dev/README.md +[dev-tools-create_overlays.sh]: dev/tools/create_overlays.sh +[Discourse]: https://coq.discourse.group/ +[Discourse-development-category]: https://coq.discourse.group/c/coq-development +[doc_gram]: doc/tools/docgram/README.md +[doc-README]: doc/README.md +[documentation-github-project]: https://github.com/coq/coq/projects/3 +[dune-doc]: https://dune.readthedocs.io/en/latest/ +[FAQ]: https://github.com/coq/coq/wiki/The-Coq-FAQ +[git]: https://git-scm.com/ +[git-hook]: dev/tools/pre-commit +[GitHub-co-authored-by]: https://github.blog/2018-01-29-commit-together-with-co-authors/ +[GitHub-commit-email]: https://help.github.com/en/articles/setting-your-commit-email-address-in-git +[GitHub-doc]: https://help.github.com/ +[GitHub-draft-PR]: https://github.blog/2019-02-14-introducing-draft-pull-requests/ +[GitHub-markdown]: https://guides.github.com/features/mastering-markdown/ +[GitHub-notification-settings]: https://github.com/settings/notifications +[GitHub-PR-from-fork]: https://help.github.com/en/articles/creating-a-pull-request-from-a-fork +[GitHub-rebase]: https://help.github.com/articles/about-git-rebase/ +[GitHub-watching]: https://github.com/coq/coq/subscription +[GitHub-wiki-extensions]: https://help.github.com/en/articles/editing-wiki-content +[GitLab-coq]: https://gitlab.com/coq +[GitLab-doc]: https://docs.gitlab.com/ +[JasonGross-coq-tools]: https://github.com/JasonGross/coq-tools +[kind-documentation]: https://github.com/coq/coq/issues?q=is%3Aopen+is%3Aissue+label%3A%22kind%3A+documentation%22 +[master-doc]: https://coq.github.io/doc/master/refman/ +[merge-pr]: dev/tools/merge-pr.sh +[needs-benchmarking]: https://github.com/coq/coq/labels/needs%3A%20benchmarking +[needs-changelog]: https://github.com/coq/coq/labels/needs%3A%20changelog%20entry +[needs-documentation]: https://github.com/coq/coq/labels/needs%3A%20documentation +[needs-fixing]: https://github.com/coq/coq/labels/needs%3A%20fixing +[needs-rebase]: https://github.com/coq/coq/labels/needs%3A%20rebase +[needs-testing]: https://github.com/coq/coq/labels/needs%3A%20testing +[Nix]: https://github.com/coq/coq/wiki/Nix +[notification-email]: https://blog.github.com/2017-07-18-managing-large-numbers-of-github-notifications/#prioritize-the-notifications-you-receive +[OCaml-planet]: http://ocaml.org/community/planet/ +[ocamlformat]: https://github.com/ocaml-ppx/ocamlformat +[ocamlverse-community]: https://ocamlverse.github.io/content/community.html +[Octobox]: http://octobox.io/ +[old-style-guide]: dev/doc/style.txt +[other-standard-libraries]: https://github.com/coq/stdlib2/wiki/Other-%22standard%22-libraries +[pinentry-mac]: https://stackoverflow.com/questions/39494631/gpg-failed-to-sign-the-data-fatal-failed-to-write-commit-object-git-2-10-0 +[plugin-tutorial]: doc/plugin_tutorial +[ProofGeneral-issues]: https://github.com/ProofGeneral/PG/issues +[Reddit]: https://www.reddit.com/r/Coq/ +[refman]: https://coq.inria.fr/distrib/current/refman/ +[refman-sources]: doc/sphinx +[refman-README]: doc/sphinx/README.rst +[release-plan]: https://github.com/coq/coq/wiki/Release-Plan +[repology-coq]: https://repology.org/project/coq/versions +[RM-checklist]: dev/doc/release-process.md +[Stack-Exchange]: https://stackexchange.com/filters/299857/questions-tagged-coq-on-stackexchange-sites +[Stack-Overflow]: https://stackoverflow.com/questions/tagged/coq +[stdlib-doc]: https://coq.inria.fr/stdlib/ +[test-suite-README]: test-suite/README.md +[tools-website]: https://coq.inria.fr/related-tools.html +[tools-wiki]: https://github.com/coq/coq/wiki/Tools +[unreleased-changelog]: https://coq.github.io/doc/master/refman/changes.html#unreleased-changes +[user-changelog]: doc/changelog +[user-overlays]: dev/ci/user-overlays +[wiki]: https://github.com/coq/coq/wiki +[wiki-calls]: https://github.com/coq/coq/wiki/Coq-Calls +[wiki-CUDW]: https://github.com/coq/coq/wiki/CoqImplementorsWorkshop +[wiki-WG]: https://github.com/coq/coq/wiki/Coq-Working-Groups +[YouTube]: https://www.youtube.com/channel/UCbJo6gYYr0OF18x01M4THdQ +[Zulip]: https://coq.zulipchat.com +[Zulip-dev]: https://coq.zulipchat.com/#narrow/stream/237656-Coq-devs.20.26.20plugin.20devs diff -Nru coq-doc-8.6/COPYRIGHT coq-doc-8.15.0/COPYRIGHT --- coq-doc-8.6/COPYRIGHT 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/COPYRIGHT 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ - The Coq proof assistant - -Copyright 1999-2016 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) - Pierre Corbineau, Radboud University, Nijmegen (declarative mode) - John Harrison, University of Cambridge (csdp wrapper) - Georges Gonthier, Microsoft Research - Inria Joint Centre (plugins/ssrmatching) - -The file CREDITS contains a list of contributors. -The credits section in the Reference Manual details contributions. diff -Nru coq-doc-8.6/coq-core.opam coq-doc-8.15.0/coq-core.opam --- coq-doc-8.6/coq-core.opam 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coq-core.opam 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,54 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "dev" +synopsis: "The Coq Proof Assistant -- Core Binaries and Tools" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. + +Typical applications include the certification of properties of +programming languages (e.g. the CompCert compiler certification +project, or the Bedrock verified low-level programming library), the +formalization of mathematics (e.g. the full formalization of the +Feit-Thompson theorem or homotopy type theory) and teaching. + +This package includes the Coq core binaries, plugins, and tools, but +not the vernacular standard library. + +Note that in this setup, Coq needs to be started with the -boot and +-noinit options, as will otherwise fail to find the regular Coq +prelude, now living in the coq-stdlib package.""" +maintainer: ["The Coq development team "] +authors: ["The Coq development team, INRIA, CNRS, and contributors"] +license: "LGPL-2.1-only" +homepage: "https://coq.inria.fr/" +doc: "https://coq.github.io/doc/" +bug-reports: "https://github.com/coq/coq/issues" +depends: [ + "dune" {>= "2.5"} + "ocaml" {>= "4.05.0"} + "ocamlfind" {>= "1.8.1"} + "zarith" {>= "1.10"} + "ounit2" {with-test} +] +build: [ + # Requires dune 2.8 due to https://github.com/ocaml/dune/issues/3219 + # ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/coq/coq.git" +build-env: [ + [ COQ_CONFIGURE_PREFIX = "%{prefix}" ] +] diff -Nru coq-doc-8.6/coq-core.opam.template coq-doc-8.15.0/coq-core.opam.template --- coq-doc-8.6/coq-core.opam.template 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coq-core.opam.template 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,3 @@ +build-env: [ + [ COQ_CONFIGURE_PREFIX = "%{prefix}" ] +] diff -Nru coq-doc-8.6/coq-doc.opam coq-doc-8.15.0/coq-doc.opam --- coq-doc-8.6/coq-doc.opam 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coq-doc.opam 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,38 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "dev" +synopsis: "The Coq Proof Assistant --- Reference Manual" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. + +This package provides the Coq Reference Manual.""" +maintainer: ["The Coq development team "] +authors: ["The Coq development team, INRIA, CNRS, and contributors"] +license: "OPL-1.0" +homepage: "https://coq.inria.fr/" +doc: "https://coq.github.io/doc/" +bug-reports: "https://github.com/coq/coq/issues" +depends: [ + "dune" {build & >= "2.5.0"} + "conf-python-3" {build} + "coq" {build & = version} +] +build: [ + # Requires dune 2.8 due to https://github.com/ocaml/dune/issues/3219 + # ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/coq/coq.git" diff -Nru coq-doc-8.6/coqide.opam coq-doc-8.15.0/coqide.opam --- coq-doc-8.6/coqide.opam 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqide.opam 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,38 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "dev" +synopsis: "The Coq Proof Assistant --- GTK3 IDE" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. + +This package provides the CoqIDE, a graphical user interface for the +development of interactive proofs.""" +maintainer: ["The Coq development team "] +authors: ["The Coq development team, INRIA, CNRS, and contributors"] +license: "LGPL-2.1-only" +homepage: "https://coq.inria.fr/" +doc: "https://coq.github.io/doc/" +bug-reports: "https://github.com/coq/coq/issues" +depends: [ + "dune" {>= "2.5"} + "coqide-server" {= version} +] +build: [ + # Requires dune 2.8 due to https://github.com/ocaml/dune/issues/3219 + # ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/coq/coq.git" diff -Nru coq-doc-8.6/coqide-server.opam coq-doc-8.15.0/coqide-server.opam --- coq-doc-8.6/coqide-server.opam 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqide-server.opam 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,40 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "dev" +synopsis: "The Coq Proof Assistant, XML protocol server" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. + +This package provides the `coqidetop` language server, an +implementation of Coq's [XML protocol](https://github.com/coq/coq/blob/master/dev/doc/xml-protocol.md) +which allows clients, such as CoqIDE, to interact with Coq in a +structured way.""" +maintainer: ["The Coq development team "] +authors: ["The Coq development team, INRIA, CNRS, and contributors"] +license: "LGPL-2.1-only" +homepage: "https://coq.inria.fr/" +doc: "https://coq.github.io/doc/" +bug-reports: "https://github.com/coq/coq/issues" +depends: [ + "dune" {>= "2.5"} + "coq-core" {= version} +] +build: [ + # Requires dune 2.8 due to https://github.com/ocaml/dune/issues/3219 + # ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/coq/coq.git" diff -Nru coq-doc-8.6/coq.opam coq-doc-8.15.0/coq.opam --- coq-doc-8.6/coq.opam 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coq.opam 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,41 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "dev" +synopsis: "The Coq Proof Assistant" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. + +Typical applications include the certification of properties of +programming languages (e.g. the CompCert compiler certification +project, or the Bedrock verified low-level programming library), the +formalization of mathematics (e.g. the full formalization of the +Feit-Thompson theorem or homotopy type theory) and teaching.""" +maintainer: ["The Coq development team "] +authors: ["The Coq development team, INRIA, CNRS, and contributors"] +license: "LGPL-2.1-only" +homepage: "https://coq.inria.fr/" +doc: "https://coq.github.io/doc/" +bug-reports: "https://github.com/coq/coq/issues" +depends: [ + "dune" {>= "2.5"} + "coq-core" {= version} + "coq-stdlib" {= version} +] +build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/coq/coq.git" diff -Nru coq-doc-8.6/coq.opam.docker coq-doc-8.15.0/coq.opam.docker --- coq-doc-8.6/coq.opam.docker 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coq.opam.docker 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,44 @@ +synopsis: "The Coq Proof Assistant" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. Typical +applications include the certification of properties of programming +languages (e.g. the CompCert compiler certification project, or the +Bedrock verified low-level programming library), the formalization of +mathematics (e.g. the full formalization of the Feit-Thompson theorem +or homotopy type theory) and teaching. +""" +opam-version: "2.0" +maintainer: "The Coq development team " +authors: "The Coq development team, INRIA, CNRS, and contributors." +homepage: "https://coq.inria.fr/" +bug-reports: "https://github.com/coq/coq/issues" +dev-repo: "git+https://github.com/coq/coq.git" +license: "LGPL-2.1" + +version: "dev" + +depends: [ + "ocaml" { >= "4.05.0" } + "ocamlfind" { build } + "zarith" { >= "1.10" } + "conf-findutils" {build} +] + +depopts: [ + "coq-native" +] + +build: [ + [ "./configure" "-prefix" prefix "-coqide" "no" + "-native-compiler" "yes" {coq-native:installed} "no" {!coq-native:installed} + ] + [make "-j%{jobs}%"] + [make "-j%{jobs}%" "byte"] +] +install: [ + [make "install"] + [make "install-byte"] +] diff -Nru coq-doc-8.6/coqpp/coqpp_ast.mli coq-doc-8.15.0/coqpp/coqpp_ast.mli --- coq-doc-8.6/coqpp/coqpp_ast.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqpp/coqpp_ast.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,159 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* Buffer.add_string ocaml_buf "{" + | Extend -> ocaml_start_pos := lexeme_start_p lexbuf + in + incr num_braces + +let end_ocaml lexbuf = + let () = decr num_braces in + if !num_braces < 0 then lex_error lexbuf "Unexpected end of OCaml code" + else if !num_braces = 0 then + let s = Buffer.contents ocaml_buf in + let () = Buffer.reset ocaml_buf in + let loc = { + Coqpp_ast.loc_start = !ocaml_start_pos; + Coqpp_ast.loc_end = lexeme_end_p lexbuf + } in + Some (CODE { Coqpp_ast.code = s; loc }) + else + let () = Buffer.add_string ocaml_buf "}" in + None + +} + +let letter = ['a'-'z' 'A'-'Z'] +let letterlike = ['_' 'a'-'z' 'A'-'Z'] +let alphanum = ['_' 'a'-'z' 'A'-'Z' '0'-'9' '\''] +let ident = letterlike alphanum* +let qualid = ident ('.' ident)* +let space = [' ' '\t' '\r'] +let number = [ '0'-'9' ] + +rule extend = parse +| "(*" { start_comment (); comment lexbuf } +| "{" { start_ocaml lexbuf; ocaml lexbuf } +| "GRAMMAR" { GRAMMAR } +| "VERNAC" { VERNAC } +| "COMMAND" { COMMAND } +| "TACTIC" { TACTIC } +| "EXTEND" { EXTEND } +| "DOC_GRAMMAR" { DOC_GRAMMAR } +| "END" { END } +| "DECLARE" { DECLARE } +| "PLUGIN" { PLUGIN } +| "DEPRECATED" { DEPRECATED } +| "CLASSIFIED" { CLASSIFIED } +| "STATE" { STATE } +| "PRINTED" { PRINTED } +| "TYPED" { TYPED } +| "INTERPRETED" { INTERPRETED } +| "GLOBALIZED" { GLOBALIZED } +| "SUBSTITUTED" { SUBSTITUTED } +| "ARGUMENT" { ARGUMENT } +| "RAW_PRINTED" { RAW_PRINTED } +| "GLOB_PRINTED" { GLOB_PRINTED } +| "BY" { BY } +| "AS" { AS } +(** Camlp5 specific keywords *) +| "GLOBAL" { GLOBAL } +| "TOP" { TOP } +| "FIRST" { FIRST } +| "LAST" { LAST } +| "BEFORE" { BEFORE } +| "AFTER" { AFTER } +| "LEVEL" { LEVEL } +| "LEFTA" { LEFTA } +| "RIGHTA" { RIGHTA } +| "NONA" { NONA } +(** Standard *) +| ident { IDENT (Lexing.lexeme lexbuf) } +| qualid { QUALID (Lexing.lexeme lexbuf) } +| number { INT (int_of_string (Lexing.lexeme lexbuf)) } +| space { extend lexbuf } +| '\"' { string lexbuf } +| '\n' { newline lexbuf; extend lexbuf } +| "![" { BANGBRACKET } +| "#[" { HASHBRACKET } +| '[' { LBRACKET } +| ']' { RBRACKET } +| '|' { PIPE } +| "->" { ARROW } +| "=>" { FUN } +| ',' { COMMA } +| ':' { COLON } +| ';' { SEMICOLON } +| '(' { LPAREN } +| ')' { RPAREN } +| '=' { EQUAL } +| '*' { STAR } +| _ { lex_error lexbuf "syntax error" } +| eof { EOF } + +and ocaml = parse +| "{" { start_ocaml lexbuf; ocaml lexbuf } +| "}" { match end_ocaml lexbuf with Some tk -> tk | None -> ocaml lexbuf } +| '\n' { newline lexbuf; Buffer.add_char ocaml_buf '\n'; ocaml lexbuf } +| '\"' { Buffer.add_char ocaml_buf '\"'; ocaml_string lexbuf } +| (_ as c) { Buffer.add_char ocaml_buf c; ocaml lexbuf } +| eof { lex_unexpected_eof lexbuf "OCaml code" } + +and comment = parse +| "*)" { match end_comment lexbuf with Some _ -> extend lexbuf | None -> comment lexbuf } +| "(*" { start_comment lexbuf; comment lexbuf } +| '\n' { newline lexbuf; Buffer.add_char comment_buf '\n'; comment lexbuf } +| (_ as c) { Buffer.add_char comment_buf c; comment lexbuf } +| eof { lex_unexpected_eof lexbuf "comment" } + +and string = parse +| '\"' + { + let s = Buffer.contents string_buf in + let () = Buffer.reset string_buf in + STRING s + } +| "\\\"" { Buffer.add_char string_buf '\"'; string lexbuf } +| '\n' { newline lexbuf; Buffer.add_char string_buf '\n'; string lexbuf } +| (_ as c) { Buffer.add_char string_buf c; string lexbuf } +| eof { lex_unexpected_eof lexbuf "string" } + +and ocaml_string = parse +| "\\\"" { Buffer.add_string ocaml_buf "\\\""; ocaml_string lexbuf } +| '\"' { Buffer.add_char ocaml_buf '\"'; ocaml lexbuf } +| (_ as c) { Buffer.add_char ocaml_buf c; ocaml_string lexbuf } +| eof { lex_unexpected_eof lexbuf "OCaml string" } + +{ + +let token lexbuf = match mode () with +| OCaml -> ocaml lexbuf +| Extend -> extend lexbuf + +} diff -Nru coq-doc-8.6/coqpp/coqpp_main.ml coq-doc-8.15.0/coqpp/coqpp_main.ml --- coq-doc-8.6/coqpp/coqpp_main.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqpp/coqpp_main.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,666 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* %s@]@\n" code_insert + +module StringSet = Set.Make(String) + +let string_split s = + let len = String.length s in + let rec split n = + try + let pos = String.index_from s n '.' in + let dir = String.sub s n (pos-n) in + dir :: split (succ pos) + with + | Not_found -> [String.sub s n (len-n)] + in + if len == 0 then [] else split 0 + +let plugin_name = "__coq_plugin_name" + +let print_list fmt pr l = + let rec prl fmt = function + | [] -> () + | [x] -> fprintf fmt "%a" pr x + | x :: l -> fprintf fmt "%a;@ %a" pr x prl l + in + fprintf fmt "@[[%a]@]" prl l + +let rec print_binders fmt = function +| [] -> () +| ExtTerminal _ :: rem -> print_binders fmt rem +| ExtNonTerminal (_, TokNone) :: rem -> + fprintf fmt "_@ %a" print_binders rem +| ExtNonTerminal (_, TokName id) :: rem -> + fprintf fmt "%s@ %a" id print_binders rem + +let rec print_symbol fmt = function +| Ulist1 s -> + fprintf fmt "@[Extend.TUlist1 (%a)@]" print_symbol s +| Ulist1sep (s, sep) -> + fprintf fmt "@[Extend.TUlist1sep (%a, \"%s\")@]" print_symbol s sep +| Ulist0 s -> + fprintf fmt "@[Extend.TUlist0 (%a)@]" print_symbol s +| Ulist0sep (s, sep) -> + fprintf fmt "@[Extend.TUlist0sep (%a, \"%s\")@]" print_symbol s sep +| Uopt s -> + fprintf fmt "@[Extend.TUopt (%a)@]" print_symbol s +| Uentry e -> + fprintf fmt "@[Extend.TUentry (Genarg.get_arg_tag wit_%s)@]" e +| Uentryl (e, l) -> + assert (e = "tactic"); + fprintf fmt "@[Extend.TUentryl (Genarg.get_arg_tag wit_%s, %i)@]" e l + +let print_string fmt s = fprintf fmt "\"%s\"" s + +let print_opt fmt pr = function +| None -> fprintf fmt "None" +| Some x -> fprintf fmt "Some@ @[(%a)@]" pr x + +module GramExt : +sig + +val print_extrule : Format.formatter -> (symb list * string option list * code) -> unit +val print_ast : Format.formatter -> grammar_ext -> unit + +end = +struct + +let is_uident s = match s.[0] with +| 'A'..'Z' -> true +| _ -> false + +let is_qualified = is_uident + +let get_local_entries ext = + let global = StringSet.of_list ext.gramext_globals in + let map e = e.gentry_name in + let entries = List.map map ext.gramext_entries in + let local = List.filter (fun e -> not (is_qualified e || StringSet.mem e global)) entries in + let rec uniquize seen = function + | [] -> [] + | id :: rem -> + let rem = uniquize (StringSet.add id seen) rem in + if StringSet.mem id seen then rem else id :: rem + in + uniquize StringSet.empty local + +let print_local fmt ext = + let locals = get_local_entries ext in + match locals with + | [] -> () + | e :: locals -> + let mk_e fmt e = fprintf fmt "Pcoq.Entry.make \"%s\"" e in + let () = fprintf fmt "@[let %s =@ @[%a@]@]@ " e mk_e e in + let iter e = fprintf fmt "@[and %s =@ @[%a@]@]@ " e mk_e e in + let () = List.iter iter locals in + fprintf fmt "in@ " + +let print_position fmt pos = match pos with +| First -> fprintf fmt "Gramlib.Gramext.First" +| Last -> fprintf fmt "Gramlib.Gramext.Last" +| Before s -> fprintf fmt "Gramlib.Gramext.Before@ \"%s\"" s +| After s -> fprintf fmt "Gramlib.Gramext.After@ \"%s\"" s + +let print_assoc fmt = function +| LeftA -> fprintf fmt "Gramlib.Gramext.LeftA" +| RightA -> fprintf fmt "Gramlib.Gramext.RightA" +| NonA -> fprintf fmt "Gramlib.Gramext.NonA" + +let is_token s = match string_split s with +| [s] -> is_uident s +| _ -> false + +let rec parse_tokens ?(in_anon=false) = +let err_anon () = + if in_anon then + fatal (Printf.sprintf "'SELF' or 'NEXT' illegal in anonymous entry level") in +function +| [GSymbString s] -> SymbToken ("", Some s) +| [GSymbQualid ("QUOTATION", None); GSymbString s] -> + SymbToken ("QUOTATION", Some s) +| [GSymbQualid ("SELF", None)] -> err_anon (); SymbSelf +| [GSymbQualid ("NEXT", None)] -> err_anon (); SymbNext +| [GSymbQualid ("LIST0", None); tkn] -> + SymbList0 (parse_token ~in_anon tkn, None) +| [GSymbQualid ("LIST1", None); tkn] -> + SymbList1 (parse_token ~in_anon tkn, None) +| [GSymbQualid ("LIST0", None); tkn; GSymbQualid ("SEP", None); tkn'] -> + SymbList0 (parse_token ~in_anon tkn, Some (parse_token ~in_anon tkn')) +| [GSymbQualid ("LIST1", None); tkn; GSymbQualid ("SEP", None); tkn'] -> + SymbList1 (parse_token ~in_anon tkn, Some (parse_token ~in_anon tkn')) +| [GSymbQualid ("OPT", None); tkn] -> + SymbOpt (parse_token ~in_anon tkn) +| [GSymbQualid (e, None)] when is_token e -> SymbToken (e, None) +| [GSymbQualid (e, None); GSymbString s] when is_token e -> SymbToken (e, Some s) +| [GSymbQualid (e, lvl)] when not (is_token e) -> SymbEntry (e, lvl) +| [GSymbParen tkns] -> parse_tokens ~in_anon tkns +| [GSymbProd prds] -> + let map p = + let map (pat, tkns) = (pat, parse_tokens ~in_anon:true tkns) in + (List.map map p.gprod_symbs, p.gprod_body) + in + SymbRules (List.map map prds) +| t -> + let rec db_token = function + | GSymbString s -> Printf.sprintf "\"%s\"" s + | GSymbQualid (s, _) -> Printf.sprintf "%s" s + | GSymbParen s -> Printf.sprintf "(%s)" (db_tokens s) + | GSymbProd _ -> Printf.sprintf "[...]" + and db_tokens tkns = + let s = List.map db_token tkns in + String.concat " " s + in + fatal (Printf.sprintf "Invalid token: %s" (db_tokens t)) + +and parse_token ~in_anon tkn = parse_tokens ~in_anon [tkn] + +let print_fun fmt (vars, body) = + let vars = List.rev vars in + let iter = function + | None -> fprintf fmt "_@ " + | Some id -> fprintf fmt "%s@ " id + in + let () = fprintf fmt "fun@ " in + let () = List.iter iter vars in + let () = fprintf fmt "loc ->@ @[%a@]" print_code body in + () + +(** Meta-program instead of calling Tok.of_pattern here because otherwise + violates value restriction *) +let print_tok fmt = +let print_pat fmt = print_opt fmt print_string in +function +| "", Some s -> fprintf fmt "Tok.PKEYWORD (%a)" print_string s +| "IDENT", s -> fprintf fmt "Tok.PIDENT (%a)" print_pat s +| "PATTERNIDENT", s -> fprintf fmt "Tok.PPATTERNIDENT (%a)" print_pat s +| "FIELD", s -> fprintf fmt "Tok.PFIELD (%a)" print_pat s +| "NUMBER", None -> fprintf fmt "Tok.PNUMBER None" +| "NUMBER", Some s -> fprintf fmt "Tok.PNUMBER (Some (NumTok.Unsigned.of_string %a))" print_string s +| "STRING", s -> fprintf fmt "Tok.PSTRING (%a)" print_pat s +| "LEFTQMARK", None -> fprintf fmt "Tok.PLEFTQMARK" +| "BULLET", s -> fprintf fmt "Tok.PBULLET (%a)" print_pat s +| "QUOTATION", Some s -> fprintf fmt "Tok.PQUOTATION %a" print_string s +| "EOI", None -> fprintf fmt "Tok.PEOI" +| _ -> failwith "Tok.of_pattern: not a constructor" + +let rec print_prod fmt p = + let (vars, tkns) = List.split p.gprod_symbs in + let tkn = List.map parse_tokens tkns in + print_extrule fmt (tkn, vars, p.gprod_body) + +and print_extrule fmt (tkn, vars, body) = + let tkn = List.rev tkn in + fprintf fmt "@[Pcoq.Production.make@ @[(%a)@]@ @[(%a)@]@]" (print_symbols ~norec:false) tkn print_fun (vars, body) + +and print_symbols ~norec fmt = function +| [] -> fprintf fmt "Pcoq.Rule.stop" +| tkn :: tkns -> + let c = if norec then "Pcoq.Rule.next_norec" else "Pcoq.Rule.next" in + fprintf fmt "%s @[(%a)@ (%a)@]" c (print_symbols ~norec) tkns print_symbol tkn + +and print_symbol fmt tkn = match tkn with +| SymbToken (t, s) -> + fprintf fmt "(Pcoq.Symbol.token (%a))" print_tok (t, s) +| SymbEntry (e, None) -> + fprintf fmt "(Pcoq.Symbol.nterm %s)" e +| SymbEntry (e, Some l) -> + fprintf fmt "(Pcoq.Symbol.nterml %s (%a))" e print_string l +| SymbSelf -> + fprintf fmt "Pcoq.Symbol.self" +| SymbNext -> + fprintf fmt "Pcoq.Symbol.next" +| SymbList0 (s, None) -> + fprintf fmt "(Pcoq.Symbol.list0 %a)" print_symbol s +| SymbList0 (s, Some sep) -> + fprintf fmt "(Pcoq.Symbol.list0sep (%a) (%a) false)" print_symbol s print_anonymized_symbol sep +| SymbList1 (s, None) -> + fprintf fmt "(Pcoq.Symbol.list1 (%a))" print_symbol s +| SymbList1 (s, Some sep) -> + fprintf fmt "(Pcoq.Symbol.list1sep (%a) (%a) false)" print_symbol s print_anonymized_symbol sep +| SymbOpt s -> + fprintf fmt "(Pcoq.Symbol.opt %a)" print_symbol s +| SymbRules rules -> + let pr fmt (r, body) = + let (vars, tkn) = List.split r in + let tkn = List.rev tkn in + fprintf fmt "Pcoq.Rules.make @[(%a)@ (%a)@]" (print_symbols ~norec:true) tkn print_fun (vars, body) + in + let pr fmt rules = print_list fmt pr rules in + fprintf fmt "(Pcoq.Symbol.rules %a)" pr (List.rev rules) +| SymbQuote c -> + fprintf fmt "(%s)" c + +and print_anonymized_symbol fmt tkn = match tkn with +| SymbToken (t, s) -> + fprintf fmt "(Pcoq.Symbol.tokens [Pcoq.TPattern (%a)])" print_tok (t, s) +| _ -> print_symbol fmt (SymbRules [[None, tkn], mk_code "()"]) + +let print_rule fmt r = + let pr_lvl fmt lvl = print_opt fmt print_string lvl in + let pr_asc fmt asc = print_opt fmt print_assoc asc in + let pr_prd fmt prd = print_list fmt print_prod prd in + fprintf fmt "@[(%a,@ %a,@ %a)@]" pr_lvl r.grule_label pr_asc r.grule_assoc pr_prd (List.rev r.grule_prods) + +let print_entry fmt e = match e.gentry_rules with +| GDataReuse (pos, r) -> + let rules = List.rev r in + let pr_pos fmt pos = print_opt fmt print_string pos in + let pr_prd fmt prd = print_list fmt print_prod prd in + fprintf fmt "let () =@ @[Pcoq.grammar_extend@ %s@ @[(Pcoq.Reuse (%a, %a))@]@]@ in@ " + e.gentry_name pr_pos pos pr_prd rules +| GDataFresh (pos, rules) -> + let print_rules fmt rules = print_list fmt print_rule rules in + let pr_check fmt () = match pos with + | None -> fprintf fmt "let () =@ @[assert@ (Pcoq.Entry.is_empty@ %s)@]@ in@\n" e.gentry_name + | Some _ -> fprintf fmt "" + in + let pos = match pos with None -> First | Some pos -> pos in + fprintf fmt "%alet () =@ @[Pcoq.grammar_extend@ %s@ @[(Pcoq.Fresh@ (%a, %a))@]@]@ in@ " + pr_check () e.gentry_name print_position pos print_rules rules + +let print_ast fmt ext = + let () = fprintf fmt "let _ = @[" in + let () = fprintf fmt "@[%a@]" print_local ext in + let () = List.iter (fun e -> print_entry fmt e) ext.gramext_entries in + let () = fprintf fmt "()@]@\n" in + () + +end + +module VernacExt : +sig + +val print_ast : Format.formatter -> vernac_ext -> unit + +end = +struct + +let print_rule_classifier fmt r = match r.vernac_class with +| None -> fprintf fmt "None" +| Some f -> + let no_binder = function ExtTerminal _ -> true | ExtNonTerminal _ -> false in + if List.for_all no_binder r.vernac_toks then + fprintf fmt "Some @[%a@]" print_code f + else + fprintf fmt "Some @[(fun %a-> %a)@]" print_binders r.vernac_toks print_code f + +(* let print_atts fmt = function *) +(* | None -> fprintf fmt "@[let () = Attributes.unsupported_attributes atts in@] " *) +(* | Some atts -> *) +(* let rec print_left fmt = function *) +(* | [] -> assert false *) +(* | [x,_] -> fprintf fmt "%s" x *) +(* | (x,_) :: rem -> fprintf fmt "(%s, %a)" x print_left rem *) +(* in *) +(* let rec print_right fmt = function *) +(* | [] -> assert false *) +(* | [_,y] -> fprintf fmt "%s" y *) +(* | (_,y) :: rem -> fprintf fmt "(%s ++ %a)" y print_right rem *) +(* in *) +(* let nota = match atts with [_] -> "" | _ -> "Attributes.Notations." in *) +(* fprintf fmt "@[let %a = Attributes.parse %s(%a) atts in@] " *) +(* print_left atts nota print_right atts *) + +let print_atts_left fmt = function + | None -> fprintf fmt "()" + | Some atts -> + let rec aux fmt = function + | [] -> assert false + | [x,_] -> fprintf fmt "%s" x + | (x,_) :: rem -> fprintf fmt "(%s, %a)" x aux rem + in + aux fmt atts + +let print_atts_right fmt = function + | None -> fprintf fmt "(Attributes.unsupported_attributes atts)" + | Some atts -> + let rec aux fmt = function + | [] -> assert false + | [_,y] -> fprintf fmt "%s" y + | (_,y) :: rem -> fprintf fmt "(%s ++ %a)" y aux rem + in + let nota = match atts with [_] -> "" | _ -> "Attributes.Notations." in + fprintf fmt "(Attributes.parse %s%a atts)" nota aux atts + +let understand_state = function + | "close_proof" -> "vtcloseproof", false + | "open_proof" -> "vtopenproof", true + | "proof" -> "vtmodifyproof", false + | "proof_opt_query" -> "vtreadproofopt", false + | "proof_query" -> "vtreadproof", false + | "read_program" -> "vtreadprogram", false + | "program" -> "vtmodifyprogram", false + | "declare_program" -> "vtdeclareprogram", false + | "program_interactive" -> "vtopenproofprogram", false + | s -> fatal ("unsupported state specifier: " ^ s) + +let print_body_state state fmt r = + let state = match r.vernac_state with Some _ as s -> s | None -> state in + match state with + | None -> fprintf fmt "Vernacextend.vtdefault (fun () -> %a)" print_code r.vernac_body + | Some "CUSTOM" -> print_code fmt r.vernac_body + | Some state -> + let state, unit_wrap = understand_state state in + fprintf fmt "Vernacextend.%s (%s%a)" state (if unit_wrap then "fun () ->" else "") + print_code r.vernac_body + +let print_body_fun state fmt r = + fprintf fmt "let coqpp_body %a%a = @[%a@] in " + print_binders r.vernac_toks print_atts_left r.vernac_atts (print_body_state state) r + +let print_body state fmt r = + fprintf fmt "@[(%afun %a?loc ~atts ()@ -> coqpp_body %a%a)@]" + (print_body_fun state) r print_binders r.vernac_toks + print_binders r.vernac_toks print_atts_right r.vernac_atts + +let rec print_sig fmt = function +| [] -> fprintf fmt "@[Vernacextend.TyNil@]" +| ExtTerminal s :: rem -> + fprintf fmt "@[Vernacextend.TyTerminal (\"%s\", %a)@]" s print_sig rem +| ExtNonTerminal (symb, _) :: rem -> + fprintf fmt "@[Vernacextend.TyNonTerminal (%a, %a)@]" + print_symbol symb print_sig rem + +let print_rule state fmt r = + fprintf fmt "Vernacextend.TyML (%b, %a, %a, %a)" + r.vernac_depr print_sig r.vernac_toks (print_body state) r print_rule_classifier r + +let print_rules state fmt rules = + print_list fmt (fun fmt r -> fprintf fmt "(%a)" (print_rule state) r) rules + +let print_classifier fmt = function +| ClassifDefault -> fprintf fmt "" +| ClassifName "QUERY" -> + fprintf fmt "~classifier:(fun _ -> Vernacextend.classify_as_query)" +| ClassifName "SIDEFF" -> + fprintf fmt "~classifier:(fun _ -> Vernacextend.classify_as_sideeff)" +| ClassifName s -> fatal (Printf.sprintf "Unknown classifier %s" s) +| ClassifCode c -> fprintf fmt "~classifier:(%s)" c.code + +let print_entry fmt = function +| None -> fprintf fmt "None" +| Some e -> fprintf fmt "(Some (%s))" e.code + +let print_ast fmt ext = + let pr fmt () = + fprintf fmt "Vernacextend.vernac_extend ~command:\"%s\" %a ?entry:%a %a" + ext.vernacext_name print_classifier ext.vernacext_class + print_entry ext.vernacext_entry (print_rules ext.vernacext_state) ext.vernacext_rules + in + let () = fprintf fmt "let () = @[%a@]@\n" pr () in + () + +end + +module TacticExt : +sig + +val print_ast : Format.formatter -> tactic_ext -> unit + +end = +struct + +let rec print_clause fmt = function +| [] -> fprintf fmt "@[Tacentries.TyNil@]" +| ExtTerminal s :: cl -> fprintf fmt "@[Tacentries.TyIdent (\"%s\", %a)@]" s print_clause cl +| ExtNonTerminal (g, _) :: cl -> + fprintf fmt "@[Tacentries.TyArg (%a, %a)@]" + print_symbol g print_clause cl + +let print_rule fmt r = + fprintf fmt "@[Tacentries.TyML (%a, @[(fun %aist@ -> %a)@])@]" + print_clause r.tac_toks print_binders r.tac_toks print_code r.tac_body + +let print_rules fmt rules = + print_list fmt (fun fmt r -> fprintf fmt "(%a)" print_rule r) rules + +let print_ast fmt ext = + let deprecation fmt = + function + | None -> () + | Some { code } -> fprintf fmt "~deprecation:(%s) " code + in + let pr fmt () = + let level = match ext.tacext_level with None -> 0 | Some i -> i in + fprintf fmt "Tacentries.tactic_extend %s \"%s\" ~level:%i %a%a" + plugin_name ext.tacext_name level + deprecation ext.tacext_deprecated + print_rules ext.tacext_rules + in + let () = fprintf fmt "let () = @[%a@]\n" pr () in + () + +end + +module VernacArgumentExt : +sig + +val print_ast : Format.formatter -> vernac_argument_ext -> unit +val print_rules : Format.formatter -> string * tactic_rule list -> unit + +end = +struct + +let terminal s = + let p = + if s <> "" && s.[0] >= '0' && s.[0] <= '9' then "CLexer.terminal_number" + else "CLexer.terminal" in + let c = Printf.sprintf "Pcoq.Symbol.token (%s \"%s\")" p s in + SymbQuote c + +let rec parse_symb self = function +| Ulist1 s -> SymbList1 (parse_symb self s, None) +| Ulist1sep (s, sep) -> SymbList1 (parse_symb self s, Some (terminal sep)) +| Ulist0 s -> SymbList0 (parse_symb self s, None) +| Ulist0sep (s, sep) -> SymbList0 (parse_symb self s, Some (terminal sep)) +| Uopt s -> SymbOpt (parse_symb self s) +| Uentry e -> if e = self then SymbSelf else SymbEntry (e, None) +| Uentryl (e, l) -> + assert (e = "tactic"); + if l = 5 then SymbEntry ("Pltac.binder_tactic", None) + else SymbEntry ("Pltac.ltac_expr", Some (string_of_int l)) + +let parse_token self = function +| ExtTerminal s -> (terminal s, None) +| ExtNonTerminal (e, TokNone) -> (parse_symb self e, None) +| ExtNonTerminal (e, TokName s) -> (parse_symb self e, Some s) + +let parse_rule self r = + let symbs = List.map (fun t -> parse_token self t) r.tac_toks in + let symbs, vars = List.split symbs in + (symbs, vars, r.tac_body) + +let print_rules fmt (name, rules) = + (* Rules are reversed. *) + let rules = List.rev rules in + let rules = List.map (fun r -> parse_rule name r) rules in + let pr fmt l = print_list fmt (fun fmt r -> fprintf fmt "(%a)" GramExt.print_extrule r) l in + match rules with + | [([SymbEntry (e, None)], [Some s], { code = c } )] when String.trim c = s -> + (* This is a horrible hack to work around limitations of camlp5 regarding + factorization of parsing rules. It allows to recognize rules of the + form [ entry(x) ] -> [ x ] so as not to generate a proxy entry and + reuse the same entry directly. *) + fprintf fmt "@[Vernacextend.Arg_alias (%s)@]" e + | _ -> fprintf fmt "@[Vernacextend.Arg_rules (%a)@]" pr rules + +let print_printer fmt = function +| None -> fprintf fmt "@[fun _ -> Pp.str \"missing printer\"@]" +| Some f -> print_code fmt f + +let print_ast fmt arg = + let name = arg.vernacargext_name in + let pr fmt () = + fprintf fmt "Vernacextend.vernac_argument_extend ~name:%a @[{@\n\ + Vernacextend.arg_parsing = %a;@\n\ + Vernacextend.arg_printer = fun env sigma -> %a;@\n}@]" + print_string name print_rules (name, arg.vernacargext_rules) + print_printer arg.vernacargext_printer + in + fprintf fmt "let (wit_%s, %s) = @[%a@]@\nlet _ = (wit_%s, %s)@\n" + name name pr () name name + +end + +module ArgumentExt : +sig + +val print_ast : Format.formatter -> argument_ext -> unit + +end = +struct + +let rec print_argtype fmt = function +| ExtraArgType s -> + fprintf fmt "Geninterp.val_tag (Genarg.topwit wit_%s)" s +| PairArgType (arg1, arg2) -> + fprintf fmt "Geninterp.Val.Pair (@[(%a)@], @[(%a)@])" print_argtype arg1 print_argtype arg2 +| ListArgType arg -> + fprintf fmt "Geninterp.Val.List @[(%a)@]" print_argtype arg +| OptArgType arg -> + fprintf fmt "Geninterp.Val.Opt @[(%a)@]" print_argtype arg + +let rec print_wit fmt = function +| ExtraArgType s -> + fprintf fmt "wit_%s" s +| PairArgType (arg1, arg2) -> + fprintf fmt "Genarg.PairArg (@[(%a)@], @[(%a)@])" print_wit arg1 print_wit arg2 +| ListArgType arg -> + fprintf fmt "Genarg.ListArg @[(%a)@]" print_wit arg +| OptArgType arg -> + fprintf fmt "Genarg.OptArg @[(%a)@]" print_wit arg + +let print_ast fmt arg = + let name = arg.argext_name in + let pr_tag fmt t = print_opt fmt print_argtype t in + let intern fmt () = match arg.argext_glob, arg.argext_type with + | Some f, (None | Some _) -> + fprintf fmt "@[Tacentries.ArgInternFun ((fun f ist v -> (ist, f ist v)) (%a))@]" print_code f + | None, Some t -> + fprintf fmt "@[Tacentries.ArgInternWit (%a)@]" print_wit t + | None, None -> + fprintf fmt "@[Tacentries.ArgInternFun (fun ist v -> (ist, v))@]" + in + let subst fmt () = match arg.argext_subst, arg.argext_type with + | Some f, (None | Some _) -> + fprintf fmt "@[Tacentries.ArgSubstFun (%a)@]" print_code f + | None, Some t -> + fprintf fmt "@[Tacentries.ArgSubstWit (%a)@]" print_wit t + | None, None -> + fprintf fmt "@[Tacentries.ArgSubstFun (fun s v -> v)@]" + in + let interp fmt () = match arg.argext_interp, arg.argext_type with + | Some (None, f), (None | Some _) -> + fprintf fmt "@[Tacentries.ArgInterpSimple (%a)@]" print_code f + | Some (Some "legacy", f), (None | Some _) -> + fprintf fmt "@[Tacentries.ArgInterpLegacy (%a)@]" print_code f + | Some (Some kind, f), (None | Some _) -> + fatal (Printf.sprintf "Unknown kind %s of interpretation function" kind) + | None, Some t -> + fprintf fmt "@[Tacentries.ArgInterpWit (%a)@]" print_wit t + | None, None -> + fprintf fmt "@[Tacentries.ArgInterpRet@]" + in + let default_printer = mk_code "fun _ _ _ _ -> Pp.str \"missing printer\"" in + let rpr = match arg.argext_rprinter, arg.argext_tprinter with + | Some f, (None | Some _) -> f + | None, Some f -> f + | None, None -> default_printer + in + let gpr = match arg.argext_gprinter, arg.argext_tprinter with + | Some f, (None | Some _) -> f + | None, Some f -> f + | None, None -> default_printer + in + let tpr = match arg.argext_tprinter with + | Some f -> f + | None -> default_printer + in + let pr fmt () = + fprintf fmt "Tacentries.argument_extend ~name:%a @[{@\n\ + Tacentries.arg_parsing = %a;@\n\ + Tacentries.arg_tag = @[%a@];@\n\ + Tacentries.arg_intern = @[%a@];@\n\ + Tacentries.arg_subst = @[%a@];@\n\ + Tacentries.arg_interp = @[%a@];@\n\ + Tacentries.arg_printer = @[((fun env sigma -> %a), (fun env sigma -> %a), (fun env sigma -> %a))@];@\n}@]" + print_string name + VernacArgumentExt.print_rules (name, arg.argext_rules) + pr_tag arg.argext_type + intern () subst () interp () print_code rpr print_code gpr print_code tpr + in + fprintf fmt "let (wit_%s, %s) = @[%a@]@\nlet _ = (wit_%s, %s)@\n" + name name pr () name name + +end + +let declare_plugin fmt name = + fprintf fmt "let %s = \"%s\"@\n" plugin_name name; + fprintf fmt "let _ = Mltop.add_known_module %s@\n" plugin_name + +let pr_ast fmt = function +| Code s -> fprintf fmt "%a@\n" print_code s +| Comment s -> fprintf fmt "%s@\n" s +| DeclarePlugin name -> declare_plugin fmt name +| GramExt gram -> fprintf fmt "%a@\n" GramExt.print_ast gram +| VernacExt vernac -> fprintf fmt "%a@\n" VernacExt.print_ast vernac +| VernacArgumentExt arg -> fprintf fmt "%a@\n" VernacArgumentExt.print_ast arg +| TacticExt tac -> fprintf fmt "%a@\n" TacticExt.print_ast tac +| ArgumentExt arg -> fprintf fmt "%a@\n" ArgumentExt.print_ast arg + +let help () = + Format.eprintf "Usage: coqpp file.mlg@\n%!"; + exit 1 + +let parse () = + let () = + if Array.length Sys.argv <> 2 + then help () + in + match Sys.argv.(1) with + | "-help" | "--help" -> help () + | file -> file + +let output_name file = + try + Filename.chop_extension file ^ ".ml" + with + | Invalid_argument _ -> + fatal "Input file must have an extension for coqpp [input.ext -> input.ml]" + +let () = + let file = parse () in + let output = output_name file in + let ast = parse_file file in + let chan = open_out output in + let fmt = formatter_of_out_channel chan in + let iter ast = Format.fprintf fmt "@[%a@]%!"pr_ast ast in + let () = List.iter iter ast in + let () = close_out chan in + exit 0 diff -Nru coq-doc-8.6/coqpp/coqpp_parse.mly coq-doc-8.15.0/coqpp/coqpp_parse.mly --- coq-doc-8.6/coqpp/coqpp_parse.mly 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqpp/coqpp_parse.mly 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,482 @@ +/************************************************************************/ +/* * The Coq Proof Assistant / The Coq Development Team */ +/* v * Copyright INRIA, CNRS and contributors */ +/* None +| Some s -> ends s pat2 + +let without_sep k sep r = + if sep <> "" then raise Parsing.Parse_error else k r + +let parse_user_entry s sep = + let table = [ + "ne_", "_list", without_sep (fun r -> Ulist1 r); + "ne_", "_list_sep", (fun sep r -> Ulist1sep (r, sep)); + "", "_list", without_sep (fun r -> Ulist0 r); + "", "_list_sep", (fun sep r -> Ulist0sep (r, sep)); + "", "_opt", without_sep (fun r -> Uopt r); + ] in + let rec parse s sep = function + | [] -> + let () = without_sep ignore sep () in + begin match starts s "tactic" with + | Some ("0"|"1"|"2"|"3"|"4"|"5" as s) -> Uentryl ("tactic", int_of_string s) + | Some _ | None -> Uentry s + end + | (pat1, pat2, k) :: rem -> + match between s pat1 pat2 with + | None -> parse s sep rem + | Some s -> + let r = parse s "" table in + k sep r + in + parse s sep table + +let no_code = { code = ""; loc = { loc_start=Lexing.dummy_pos; loc_end=Lexing.dummy_pos} } + +%} + +%token CODE +%token COMMENT +%token IDENT QUALID +%token STRING +%token INT +%token VERNAC TACTIC GRAMMAR DOC_GRAMMAR EXTEND END DECLARE PLUGIN DEPRECATED ARGUMENT +%token RAW_PRINTED GLOB_PRINTED +%token COMMAND CLASSIFIED STATE PRINTED TYPED INTERPRETED GLOBALIZED SUBSTITUTED BY AS +%token BANGBRACKET HASHBRACKET LBRACKET RBRACKET PIPE ARROW FUN COMMA EQUAL STAR +%token LPAREN RPAREN COLON SEMICOLON +%token GLOBAL TOP FIRST LAST BEFORE AFTER LEVEL LEFTA RIGHTA NONA +%token EOF + +%type file +%start file + +%% + +file: +| nodes EOF + { $1 } +; + +nodes: +| + { [] } +| node nodes + { $1 :: $2 } +; + +node: +| CODE { Code $1 } +| COMMENT { Comment $1 } +| declare_plugin { $1 } +| grammar_extend { $1 } +| vernac_extend { $1 } +| tactic_extend { $1 } +| argument_extend { $1 } +| doc_gram { $1 } +; + +declare_plugin: +| DECLARE PLUGIN STRING { DeclarePlugin $3 } +; + +grammar_extend: +| GRAMMAR EXTEND qualid_or_ident globals gram_entries END + { GramExt { gramext_name = $3; gramext_globals = $4; gramext_entries = $5 } } +; + +argument_extend: +| ARGUMENT EXTEND IDENT + typed_opt + printed_opt + interpreted_opt + globalized_opt + substituted_opt + raw_printed_opt + glob_printed_opt + tactic_rules + END + { ArgumentExt { + argext_name = $3; + argext_rules = $11; + argext_rprinter = $9; + argext_gprinter = $10; + argext_tprinter = $5; + argext_interp = $6; + argext_glob = $7; + argext_subst = $8; + argext_type = $4; + } } +| VERNAC ARGUMENT EXTEND IDENT printed_opt tactic_rules END + { VernacArgumentExt { + vernacargext_name = $4; + vernacargext_printer = $5; + vernacargext_rules = $6; + } } +; + +printed_opt: +| { None } +| PRINTED BY CODE { Some $3 } +; + +raw_printed_opt: +| { None } +| RAW_PRINTED BY CODE { Some $3 } +; + +glob_printed_opt: +| { None } +| GLOB_PRINTED BY CODE { Some $3 } +; + +interpreted_modifier_opt: +| { None } +| LBRACKET IDENT RBRACKET { Some $2 } +; + +interpreted_opt: +| { None } +| INTERPRETED interpreted_modifier_opt BY CODE { Some ($2,$4) } +; + +globalized_opt: +| { None } +| GLOBALIZED BY CODE { Some $3 } +; + +substituted_opt: +| { None } +| SUBSTITUTED BY CODE { Some $3 } +; + +typed_opt: +| { None } +| TYPED AS argtype { Some $3 } +; + +argtype: +| IDENT { ExtraArgType $1 } +| argtype IDENT { + match $2 with + | "list" -> ListArgType $1 + | "option" -> OptArgType $1 + | _ -> raise Parsing.Parse_error + } +| LPAREN argtype STAR argtype RPAREN { PairArgType ($2, $4) } +; + +vernac_extend: +| VERNAC vernac_entry EXTEND IDENT vernac_classifier vernac_state vernac_rules END + { VernacExt { + vernacext_name = $4; + vernacext_entry = $2; + vernacext_class = $5; + vernacext_state = $6; + vernacext_rules = $7; + } } +; + +vernac_entry: +| COMMAND { None } +| CODE { Some $1 } +; + +vernac_classifier: +| { ClassifDefault } +| CLASSIFIED BY CODE { ClassifCode $3 } +| CLASSIFIED AS IDENT { ClassifName $3 } +; + +vernac_state: +| { None } +| STATE IDENT { Some $2 } +; + +vernac_rules: +| vernac_rule { [$1] } +| vernac_rule vernac_rules { $1 :: $2 } +; + +vernac_rule: +| PIPE vernac_attributes_opt rule_state LBRACKET ext_tokens RBRACKET rule_deprecation rule_classifier ARROW CODE + { { + vernac_atts = $2; + vernac_state = $3; + vernac_toks = $5; + vernac_depr = $7; + vernac_class= $8; + vernac_body = $10; + } } +; + +rule_state: +| { None } +| BANGBRACKET IDENT RBRACKET { Some $2 } +; + +vernac_attributes_opt: +| { None } +| HASHBRACKET vernac_attributes RBRACKET { Some $2 } +; + +vernac_attributes: +| vernac_attribute { [$1] } +| vernac_attribute SEMICOLON { [$1] } +| vernac_attribute SEMICOLON vernac_attributes { $1 :: $3 } +; + +vernac_attribute: +| qualid_or_ident EQUAL qualid_or_ident { ($1, $3) } +| qualid_or_ident { ($1, $1) } +; + +rule_deprecation: +| { false } +| DEPRECATED { true } +; + +rule_classifier: +| { None } +| FUN CODE { Some $2 } +; + +tactic_extend: +| TACTIC EXTEND IDENT tactic_deprecated tactic_level tactic_rules END + { TacticExt { tacext_name = $3; tacext_deprecated = $4; tacext_level = $5; tacext_rules = $6 } } +; + +tactic_deprecated: +| { None } +| DEPRECATED CODE { Some $2 } +; + +tactic_level: +| { None } +| LEVEL INT { Some $2 } +; + +tactic_rules: +| { [] } +| tactic_rule tactic_rules { $1 :: $2 } +; + +tactic_rule: +| PIPE LBRACKET ext_tokens RBRACKET ARROW CODE + { { tac_toks = $3; tac_body = $6 } } +; + +ext_tokens: +| { [] } +| ext_token ext_tokens { $1 :: $2 } +; + +ext_token: +| STRING { ExtTerminal $1 } +| IDENT { + let e = parse_user_entry $1 "" in + ExtNonTerminal (e, TokNone) + } +| IDENT LPAREN IDENT RPAREN { + let e = parse_user_entry $1 "" in + ExtNonTerminal (e, TokName $3) + } +| IDENT LPAREN IDENT COMMA STRING RPAREN { + let e = parse_user_entry $1 $5 in + ExtNonTerminal (e, TokName $3) +} +; + +qualid_or_ident: +| QUALID { $1 } +| IDENT { $1 } +; + +globals: +| { [] } +| GLOBAL COLON idents SEMICOLON { $3 } +; + +idents: +| { [] } +| qualid_or_ident idents { $1 :: $2 } +; + +gram_entries: +| { [] } +| gram_entry gram_entries { $1 :: $2 } +; + +gram_entry: +| qualid_or_ident COLON reuse LBRACKET LBRACKET rules_opt RBRACKET RBRACKET SEMICOLON + { { gentry_name = $1; gentry_rules = GDataReuse ($3, $6); } } +| qualid_or_ident COLON position_opt LBRACKET levels RBRACKET SEMICOLON + { { gentry_name = $1; gentry_rules = GDataFresh ($3, $5); } } +; + +reuse: +| TOP { None } +| LEVEL STRING { Some $2 } +; + +position_opt: +| { None } +| position { Some $1 } +; + +position: +| FIRST { First } +| LAST { Last } +| BEFORE STRING { Before $2 } +| AFTER STRING { After $2 } +; + +string_opt: +| { None } +| STRING { Some $1 } +; + +assoc_opt: +| { None } +| assoc { Some $1 } +; + +assoc: +| LEFTA { LeftA } +| RIGHTA { RightA } +| NONA { NonA } +; + +levels: +| level { [$1] } +| level PIPE levels { $1 :: $3 } +; + +level: +| string_opt assoc_opt LBRACKET rules_opt RBRACKET + { { grule_label = $1; grule_assoc = $2; grule_prods = $4; } } +; + +rules_opt: +| { [] } +| rules { $1 } +; + +rules: +| rule { [$1] } +| rule PIPE rules { $1 :: $3 } +; + +rule: +| symbols_opt ARROW CODE + { { gprod_symbs = $1; gprod_body = $3; } } +; + +symbols_opt: +| { [] } +| symbols { $1 } +; + +symbols: +| symbol { [$1] } +| symbol SEMICOLON symbols { $1 :: $3 } +; + +symbol: +| IDENT EQUAL gram_tokens { (Some $1, $3) } +| gram_tokens { (None, $1) } +; + +gram_token: +| qualid_or_ident { GSymbQualid ($1, None) } +| qualid_or_ident LEVEL STRING { GSymbQualid ($1, Some $3) } +| LPAREN gram_tokens RPAREN { GSymbParen $2 } +| LBRACKET rules RBRACKET { GSymbProd $2 } +| STRING { GSymbString $1 } +; + +gram_tokens: +| gram_token { [$1] } +| gram_token gram_tokens { $1 :: $2 } +; + +doc_gram: +| DOC_GRAMMAR doc_gram_entries + { GramExt { gramext_name = ""; gramext_globals=[]; gramext_entries = $2 } } + +doc_gram_entries: +| { [] } +| doc_gram_entry doc_gram_entries { $1 :: $2 } +; + +doc_gram_entry: +| qualid_or_ident COLON LBRACKET PIPE doc_gram_rules RBRACKET + { { gentry_name = $1; + gentry_rules = GDataFresh (None, [{ grule_label = None; grule_assoc = None; grule_prods = $5; }]) } } +| qualid_or_ident COLON LBRACKET RBRACKET + { { gentry_name = $1; + gentry_rules = GDataFresh (None, [{ grule_label = None; grule_assoc = None; grule_prods = []; }]) } } +; + +doc_gram_rules: +| doc_gram_rule { [$1] } +| doc_gram_rule PIPE doc_gram_rules { $1 :: $3 } +; + +doc_gram_rule: +| doc_gram_symbols_opt { { gprod_symbs = $1; gprod_body = no_code; } } +; + +doc_gram_symbols_opt: +| { [] } +| doc_gram_symbols { $1 } +| doc_gram_symbols SEMICOLON { $1 } +; + +doc_gram_symbols: +| doc_gram_symbol { [$1] } +| doc_gram_symbols SEMICOLON doc_gram_symbol { $1 @ [$3] } +; + +doc_gram_symbol: +| IDENT EQUAL doc_gram_gram_tokens { (Some $1, $3) } +| doc_gram_gram_tokens { (None, $1) } +; + +doc_gram_gram_tokens: +| doc_gram_gram_token { [$1] } +| doc_gram_gram_token doc_gram_gram_tokens { $1 :: $2 } +; + +doc_gram_gram_token: +| qualid_or_ident { GSymbQualid ($1, None) } +| LPAREN doc_gram_gram_tokens RPAREN { GSymbParen $2 } +| LBRACKET doc_gram_rules RBRACKET { GSymbProd $2 } +| STRING { GSymbString $1 } +; diff -Nru coq-doc-8.6/coqpp/coqpp_parser.ml coq-doc-8.15.0/coqpp/coqpp_parser.ml --- coq-doc-8.6/coqpp/coqpp_parser.ml 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqpp/coqpp_parser.ml 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,44 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* + let () = close_in chan in + let () = Printf.eprintf "%s\n%!" (pr_loc loc) in + fatal msg + | Parsing.Parse_error -> + let () = close_in chan in + let loc = Coqpp_lex.loc lexbuf in + let () = Printf.eprintf "%s\n%!" (pr_loc loc) in + fatal "syntax error" + in + let () = close_in chan in + ans diff -Nru coq-doc-8.6/coqpp/coqpp_parser.mli coq-doc-8.15.0/coqpp/coqpp_parser.mli --- coq-doc-8.6/coqpp/coqpp_parser.mli 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqpp/coqpp_parser.mli 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,15 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * Copyright INRIA, CNRS and contributors *) +(* string + +val fatal : string -> unit + +val parse_file : string -> Coqpp_ast.t diff -Nru coq-doc-8.6/coqpp/dune coq-doc-8.15.0/coqpp/dune --- coq-doc-8.6/coqpp/dune 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coqpp/dune 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,15 @@ +(ocamllex coqpp_lex) +(ocamlyacc coqpp_parse) + +(library + (name coqpp) + (wrapped false) + (modules coqpp_ast coqpp_lex coqpp_parse coqpp_parser) + (modules_without_implementation coqpp_ast)) + +(executable + (name coqpp_main) + (public_name coqpp) + (package coq-core) + (libraries coqpp) + (modules coqpp_main)) diff -Nru coq-doc-8.6/coq-stdlib.opam coq-doc-8.15.0/coq-stdlib.opam --- coq-doc-8.6/coq-stdlib.opam 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/coq-stdlib.opam 2022-01-13 11:55:53.000000000 +0000 @@ -0,0 +1,44 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "dev" +synopsis: "The Coq Proof Assistant -- Standard Library" +description: """ +Coq is a formal proof management system. It provides +a formal language to write mathematical definitions, executable +algorithms and theorems together with an environment for +semi-interactive development of machine-checked proofs. + +Typical applications include the certification of properties of +programming languages (e.g. the CompCert compiler certification +project, or the Bedrock verified low-level programming library), the +formalization of mathematics (e.g. the full formalization of the +Feit-Thompson theorem or homotopy type theory) and teaching. + +This package includes the Coq Standard Library, that is to say, the +set of modules usually bound to the Coq.* namespace.""" +maintainer: ["The Coq development team "] +authors: ["The Coq development team, INRIA, CNRS, and contributors"] +license: "LGPL-2.1-only" +homepage: "https://coq.inria.fr/" +doc: "https://coq.github.io/doc/" +bug-reports: "https://github.com/coq/coq/issues" +depends: [ + "dune" {>= "2.5"} + "coq-core" {= version} +] +build: [ + # Requires dune 2.8 due to https://github.com/ocaml/dune/issues/3219 + # ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/coq/coq.git" diff -Nru coq-doc-8.6/CREDITS coq-doc-8.15.0/CREDITS --- coq-doc-8.6/CREDITS 2016-12-08 15:13:52.000000000 +0000 +++ coq-doc-8.15.0/CREDITS 2022-01-13 11:55:53.000000000 +0000 @@ -1,24 +1,24 @@ The "Coq proof assistant" was jointly developed by -- INRIA Formel, Coq, LogiCal, ProVal, TypiCal, Marelle, pi.r2 projects - (starting 1985), +- INRIA Formel, Coq, LogiCal, ProVal, TypiCal, Marelle, + pi.r2, Ascola, Galinette projects (starting 1985), - Laboratoire de l'Informatique du Parallelisme (LIP) associated to CNRS and ENS Lyon (Sep. 1989 to Aug. 1997), - Laboratoire de Recherche en Informatique (LRI) associated to CNRS and university Paris Sud (since Sep. 1997), - Laboratoire d'Informatique de l'Ecole Polytechnique (LIX) associated to CNRS and Ecole Polytechnique (since Jan. 2003). -- Laboratoire PPS associated to CNRS and university Paris 7 (since Jan. 2009). - -All files of the "Coq proof assistant" in directories or sub-directories of - - config dev ide interp intf kernel lib library parsing pretyping proofs - 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-2010, -The Coq development team, CNRS, INRIA and Université Paris Sud. - -Files from the directory doc are distributed as indicated in file doc/LICENCE. +- Laboratoire PPS associated to CNRS and University Paris Diderot + (Jan. 2009 - Dec. 2015 when it was merged into IRIF). +- Institut de Recherche en Informatique Fondamentale (IRIF), + associated to CNRS and University Paris Diderot (since Jan. 2016). +- And many contributors from various institutions. + +All files but the material of the reference manual are distributed +under the term of the GNU Lesser General Public License Version 2.1. + +The material of the reference manual is distributed under the terms of +the Open Publication License v1.0 or above, as indicated in file +doc/LICENCE. The following directories contain independent contributions supported by the Coq development team. All of them are released under the terms of @@ -27,43 +27,35 @@ plugins/cc developed by Pierre Corbineau (ENS Cachan, 2001, LRI, 2001-2005, Radboud University at Nijmegen, 2005-2008, Grenoble 1, 2010-2014) -plugins/decl_mode - developed by Pierre Corbineau (Radboud University at Nijmegen, 2005-2008, - Grenoble 1, 2009-2011) plugins/extraction developed by Pierre Letouzey (LRI, 2000-2004, PPS, 2005-now) plugins/firstorder developed by Pierre Corbineau (LRI, 2003-2008) -plugins/fourier - developed by Loïc Pottier (INRIA-Lemme, 2001) plugins/funind - developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2004-2008), - Julien Forest (INRIA-Everest, 2006, CNAM, 2007-2008) + developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2006-now), + Julien Forest (INRIA-Everest, 2006, CNAM, 2007-2008, ENSIIE, 2008-now) and Yves Bertot (INRIA-Marelle, 2005-2006) -plugins/omega - developed by Pierre Crégut (France Telecom R&D, 1996) +plugins/micromega + developed by Frédéric Besson (IRISA/INRIA, 2006-now), with some + extensions by Evgeny Makarov (INRIA, 2007); sum-of-squares solver and + interface to the csdp solver uses code from John Harrison (University + of Cambridge, 1998) plugins/nsatz developed by Loïc Pottier (INRIA-Marelle, 2009-2011) -plugins/quote - developed by Patrick Loiseleur (LRI, 1997-1999) -plugins/romega - developed by Pierre Crégut (France Telecom R&D, 2001-2004) +plugins/omega + developed by Pierre Crégut (France Telecom R&D, 1996) plugins/rtauto developed by Pierre Corbineau (LRI, 2005) -plugins/setoid_ring +plugins/ring developed by Benjamin Grégoire (INRIA-Everest, 2005-2006), Assia Mahboubi, Laurent Théry (INRIA-Marelle, 2006) and Bruno Barras (INRIA LogiCal, 2005-2006), +plugins/ssr + developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2013, Inria, 2013-now), + Assia Mahboubi and Enrico Tassi (Inria, 2011-now). plugins/ssrmatching - developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2011), + developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2011, Inria, 2013-now), and Enrico Tassi (Inria-Marelle, 2011-now) -plugins/subtac - developed by Matthieu Sozeau (LRI, 2005-2008) -plugins/micromega - developed by Frédéric Besson (IRISA/INRIA, 2006-2008), with some - extensions by Evgeny Makarov (INRIA, 2007); sum-of-squares solver and - interface to the csdp solver uses code from John Harrison (University - of Cambridge, 1998) theories/ZArith started by Pierre Crégut (France Telecom R&D, 1996) theories/Strings @@ -84,6 +76,7 @@ J.-P. Jouannaud, S. Lescuyer, A. Miquel, J.-F. Monin, P.-Y. Strub the Foundations Group (Radboud University, Nijmegen, The Netherlands), Laboratoire J.-A. Dieudonné (University of Nice-Sophia Antipolis), + L. Lee (https://orcid.org/0000-0002-7128-9257, 2018), INRIA-Gallium project, the CS dept at Yale, the CIS dept at U. Penn, the CSE dept at Harvard, the CS dept at Princeton, the CS dept at MIT @@ -94,32 +87,50 @@ Bruno Barras (INRIA, 1995-now) Yves Bertot (INRIA, 2000-now) - Pierre Boutillier (INRIA-PPS, 2010-now) + Pierre Boutillier (INRIA-PPS, 2010-2015) Xavier Clerc (INRIA, 2012-2014) + Tej Chajed (MIT, 2016-now) Jacek Chrzaszcz (LRI, 1998-2003) Thierry Coquand (INRIA, 1985-1989) Pierre Corbineau (LRI, 2003-2005, Nijmegen, 2005-2008, Grenoble 1, 2008-2011) Cristina Cornes (INRIA, 1993-1996) Yann Coscoy (INRIA Sophia-Antipolis, 1995-1996) + Pierre Courtieu (CNAM, 2006-now) David Delahaye (INRIA, 1997-2002) Maxime Dénès (INRIA, 2013-now) - Daniel de Rauglaudre (INRIA, 1996-1998) + Daniel de Rauglaudre (INRIA, 1996-1998, 2012, 2016) Olivier Desmettre (INRIA, 2001-2003) Gilles Dowek (INRIA, 1991-1994) + Jim Fehrle (2018-now) Amy Felty (INRIA, 1993) Jean-Christophe Filliâtre (ENS Lyon, 1994-1997, LRI, 1997-2008) + Emilio Jesús Gallego Arias (MINES ParisTech 2015-now) + Gaetan Gilbert (INRIA-Galinette, 2016-now) Eduardo Giménez (ENS Lyon, 1993-1996, INRIA, 1997-1998) Stéphane Glondu (INRIA-PPS, 2007-2013) Benjamin Grégoire (INRIA, 2003-2011) + Jason Gross (MIT 2013-now) Hugo Herbelin (INRIA, 1996-now) Sébastien Hinderer (INRIA, 2014) Gérard Huet (INRIA, 1985-1997) - Pierre Letouzey (LRI, 2000-2004, PPS, 2005-2008, INRIA-PPS, 2009-now) + Konstantinos Kallas (U. Penn, 2019) + Matej Košík (INRIA, 2015-2017) + Leonidas Lampropoulos (University of Pennsylvania, 2018) + Pierre Letouzey (LRI, 2000-2004, PPS, 2005-2008, + INRIA-PPS then IRIF, 2009-2018) + Yao Li (ORCID: https://orcid.org/0000-0001-8720-883X, + University of Pennsylvania, 2018) + Yishuai Li (ORCID: https://orcid.org/0000-0002-5728-5903 + U. Penn, 2018-2019) Patrick Loiseleur (Paris Sud, 1997-1999) + Andreas Lynge (Aarhus University, 2019) Evgeny Makarov (INRIA, 2007) + Gregory Malecha (Harvard University 2013-2015, + University of California, San Diego 2016) + Cyprien Mangin (INRIA-PPS then IRIF, 2015-now) Pascal Manoury (INRIA, 1993) - Micaela Mayero (INRIA, 1997-2002) Claude Marché (INRIA, 2003-2004 & LRI, 2004) + Micaela Mayero (INRIA, 1997-2002) Guillaume Melquiond (INRIA, 2009-now) Benjamin Monate (LRI, 2003) César Muñoz (INRIA, 1994-1995) @@ -129,18 +140,30 @@ Catherine Parent-Vigouroux (ENS Lyon, 1992-1995) Christine Paulin-Mohring (INRIA, 1985-1989, ENS Lyon, 1989-1997, LRI, 1997-2006) - Pierre-Marie Pédrot (INRIA-PPS, 2011-now) + Pierre-Marie Pédrot (INRIA-PPS, 2011-2015, INRIA-Ascola, 2015-2016, + University of Ljubljana, 2016-2017, + MPI-SWS, 2017-2018, INRIA 2018-now) + Clément Pit-Claudel (MIT, 2015-now) Matthias Puech (INRIA-Bologna, 2008-2011) - Yann Régis-Gianas (INRIA-PPS, 2009-now) + Yann Régis-Gianas (INRIA-PPS then IRIF, 2009-2016) Clément Renard (INRIA, 2001-2004) + Talia Ringer (University of Washington, 2019) Claudio Sacerdoti Coen (INRIA, 2004-2005) Amokrane Saïbi (INRIA, 1993-1998) + Vincent Semeria (2018-now) Vincent Siles (INRIA, 2007) Élie Soubiran (INRIA, 2007-2010) Matthieu Sozeau (INRIA, 2005-now) - Arnaud Spiwack (INRIA, 2006-now) + Arnaud Spiwack (INRIA-LIX-Chalmers University, 2006-2010, + INRIA, 2011-2014, MINES ParisTech 2014-2015, + Tweag/IO 2015-now) + Paul Steckler (MIT 2016-2018) Enrico Tassi (INRIA, 2011-now) + Amin Timany (Katholieke Universiteit Leuven, 2017) Benjamin Werner (INRIA, 1989-1994) + Nickolai Zeldovich (MIT 2014-2016) + Théo Zimmermann (ORCID: https://orcid.org/0000-0002-3580-8806, + INRIA-PPS then IRIF, 2015-now) *************************************************************************** INRIA refers to: diff -Nru coq-doc-8.6/debian/changelog coq-doc-8.15.0/debian/changelog --- coq-doc-8.6/debian/changelog 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/changelog 2022-02-22 13:02:25.000000000 +0000 @@ -1,3 +1,29 @@ +coq-doc (8.15.0-3) unstable; urgency=medium + + * Fix b-deps again (Closes: #1005920). + + -- Julien Puydt Tue, 22 Feb 2022 14:02:25 +0100 + +coq-doc (8.15.0-2) unstable; urgency=medium + + * Fix b-deps (Closes: #1005920). + + -- Julien Puydt Thu, 17 Feb 2022 13:27:49 +0100 + +coq-doc (8.15.0-1) unstable; urgency=medium + + * Switch from debian/compat to depend on debhelper-compat + (and level 13). + * Bump standards-version to 4.6.0. + * Declare d/rules doesn't require root. + * Simplify d/rules. + * Rewrite d/watch following the main coq package. + * Package new upstream (closes: #1003539). + * No more fac, rectutorial or tutorial (closes: #543548). + * Add myself to uploaders. + + -- Julien Puydt Tue, 08 Feb 2022 17:10:12 +0100 + coq-doc (8.6-1) unstable; urgency=medium * Team upload. diff -Nru coq-doc-8.6/debian/compat coq-doc-8.15.0/debian/compat --- coq-doc-8.6/debian/compat 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/compat 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -9 diff -Nru coq-doc-8.6/debian/control coq-doc-8.15.0/debian/control --- coq-doc-8.6/debian/control 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/control 2022-02-22 13:02:25.000000000 +0000 @@ -2,35 +2,45 @@ Section: non-free/doc Priority: optional Maintainer: Debian OCaml Maintainers -Uploaders: - Samuel Mimram , - Stéphane Glondu , - Hendrik Tews -Standards-Version: 4.0.0 -Build-Depends: debhelper (>= 9) -Build-Depends-Indep: - texlive, - texlive-base, - texlive-latex-extra, - texlive-science, - texlive-lang-french, - texlive-humanities, - hevea (>= 1.05), - imagemagick, - fig2dev, - camlp5, - ocaml-nox, - ocaml-findlib +Uploaders: Samuel Mimram , + Stéphane Glondu , + Hendrik Tews , + Julien Puydt +Standards-Version: 4.6.0 +Build-Depends: debhelper-compat (= 13), dune +Build-Depends-Indep: camlp5, + fig2dev, + fonts-freefont-otf, + hevea (>= 1.05), + imagemagick, + latexmk, + libzarith-ocaml-dev, + ocaml-findlib, + ocaml-nox, + python3-antlr4, + python3-bs4, + python3-pexpect, + python3-sphinxcontrib.bibtex, + python3-sphinx-rtd-theme, + sphinx, + texlive, + texlive-base, + texlive-fonts-recommended, + texlive-humanities, + texlive-lang-french, + texlive-latex-extra, + texlive-science, + texlive-xetex Homepage: http://coq.inria.fr/ -Vcs-Git: https://anonscm.debian.org/cgit/pkg-ocaml-maint/packages/coq-doc.git -Vcs-Browser: https://anonscm.debian.org/gitweb/?p=pkg-ocaml-maint/packages/coq-doc.git +Rules-Requires-Root: no +Vcs-Git: https://salsa.debian.org/ocaml-team/coq-doc.git +Vcs-Browser: https://salsa.debian.org/ocaml-team/coq-doc Package: coq-doc Architecture: all -Depends: - coq-doc-html (>= ${source:Version}), - coq-doc-pdf (>= ${source:Version}), - ${misc:Depends} +Depends: coq-doc-html (>= ${source:Version}), + coq-doc-pdf (>= ${source:Version}), + ${misc:Depends} Description: documentation for Coq Coq is a proof assistant for higher-order logic, which allows the development of computer programs consistent with their formal @@ -41,7 +51,7 @@ Package: coq-doc-html Architecture: all -Depends: ${misc:Depends} +Depends: ${misc:Depends}, ${sphinxdoc:Depends} Replaces: coq-doc (<= 8.0pl1.0-1) Description: documentation for Coq in html format Coq is a proof assistant for higher-order logic, which allows the diff -Nru coq-doc-8.6/debian/copyright coq-doc-8.15.0/debian/copyright --- coq-doc-8.6/debian/copyright 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/copyright 2022-02-22 13:02:25.000000000 +0000 @@ -17,8 +17,8 @@ contributors, see /usr/share/coq-doc/CREDITS.gz and the credits section in the introduction of the Reference Manual. -Files: doc/refman/* -Copyright: 1999-2006, INRIA +Files: doc/* +Copyright: 1999-2019, INRIA, CNRS and contributors License: OPL-1.0 Comment: The Coq Reference Manual is a collective work from the Coq @@ -32,64 +32,12 @@ http://www.opencontent.org/openpub/). Options A and B are *not* elected. -Files: doc/tutorial/* -Copyright: 1999-2006, INRIA -License: OPL-1.0 -Comment: - The Coq Tutorial is a work by Gérard Huet, Gilles Kahn and Christine - Paulin-Mohring. All documents (the LaTeX source and the PostScript, - PDF and html outputs) are copyright (c) INRIA 1999-2006. The - material connected to the Coq Tutorial 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. - -Files: doc/stdlib/* -Copyright: 1999-2006, INRIA -License: LGPL-2.1 -Comment: - The Coq Standard Library is a collective work from the Coq - Development Team whose members are listed in the file CREDITS of the - Coq source package. All related documents (the Coq vernacular source - files and the PostScript, PDF and html outputs) are copyright (c) - INRIA 1999-2006. The material connected to the Standard Library is - distributed under the terms of the Lesser General Public License - version 2.1 or later. - -Files: doc/faq/* -Copyright: 2004-2006, INRIA -License: OPL-1.0 -Comment: - The FAQ (Coq for the Clueless) is a work by Pierre Castéran, Hugo - Herbelin, Florent Kirchner, Benjamin Monate, and Julien Narboux. All - documents (the LaTeX source and the PostScript, PDF and html - outputs) are copyright (c) INRIA 2004-2006. The material connected - to the FAQ (Coq for the Clueless) 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. - -Files: doc/RecTutorial/* -Copyright: 1997-2006, INRIA -License: OPL-1.0 -Comment: - The Tutorial on [Co-]Inductive Types in Coq is a work by Pierre - Castéran and Eduardo Gimenez. All related documents (the LaTeX and - BibTeX sources and the PostScript, PDF and html outputs) are - copyright (c) INRIA 1997-2006. The material connected to the - Tutorial on [Co-]Inductive Types in Coq 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. - Files: debian/* Copyright: 1999, Fernando Sanchez 2002, Judicaël Courant 2004-2010, Samuel Mimram 2010-2014, Stéphane Glondu + 2022 Julien Puydt License: LGPL-2.1 License: LGPL-2.1 diff -Nru coq-doc-8.6/debian/coq-doc-html.doc-base.faq coq-doc-8.15.0/debian/coq-doc-html.doc-base.faq --- coq-doc-8.6/debian/coq-doc-html.doc-base.faq 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/coq-doc-html.doc-base.faq 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -Document: coq-faq-html -Title: Coq Version 8.4 for the Clueless (FAQ) -Author: Pierre Castéran, Hugo Herbelin, Florent Kirchner, Benjamin Monate, Julien Narboux -Abstract: This note intends to provide an easy way to get acquainted with the Coq theorem prover. It tries to formulate appropriate answers to some of the questions any newcomers will face, and to give pointers to other references when possible. -Section: Science/Mathematics - -Format: HTML -Index: /usr/share/doc/coq-doc-html/FAQ.v.html -Files: /usr/share/doc/coq-doc-html/FAQ.v.html diff -Nru coq-doc-8.6/debian/coq-doc-html.doc-base.manual coq-doc-8.15.0/debian/coq-doc-html.doc-base.manual --- coq-doc-8.6/debian/coq-doc-html.doc-base.manual 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/coq-doc-html.doc-base.manual 2022-02-22 13:02:25.000000000 +0000 @@ -1,7 +1,7 @@ Document: coq-manual-html Title: The Coq Proof Assistant Reference Manual Author: The Coq Development Team -Abstract: Reference Manual of version 8.6 of the Coq proof assistant, which is a system designed to develop mathematical proofs, and especially to write formal specifications, programs and to verify that programs are correct with respect to their specification. +Abstract: Reference Manual of version 8.15.0 of the Coq proof assistant, which is a system designed to develop mathematical proofs, and especially to write formal specifications, programs and to verify that programs are correct with respect to their specification. Section: Science/Mathematics Format: HTML diff -Nru coq-doc-8.6/debian/coq-doc-html.doc-base.rectutorial coq-doc-8.15.0/debian/coq-doc-html.doc-base.rectutorial --- coq-doc-8.6/debian/coq-doc-html.doc-base.rectutorial 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/coq-doc-html.doc-base.rectutorial 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -Document: coq-rectutorial-html -Title: The Coq Proof Assistant -- A Tutorial on [Co-]Inductive types in Coq -Author: Eduardo Giménez and Pierre Castéran -Abstract: This document is an introduction to the definition and use of inductive and co-inductive types in the Coq proof environment. It explains how types like natural numbers and infinite streams are defined in Coq, and the kind of proof techniques that can be used to reason about them (case analysis, induction, inversion of predicates, co-induction, etc). Each technique is illustrated through an executable and self-contained Coq script. -Section: Science/Mathematics - -Format: HTML -Index: /usr/share/doc/coq-doc-html/RecTutorial.html -Files: /usr/share/doc/coq-doc-html/RecTutorial.html diff -Nru coq-doc-8.6/debian/coq-doc-html.doc-base.tutorial coq-doc-8.15.0/debian/coq-doc-html.doc-base.tutorial --- coq-doc-8.6/debian/coq-doc-html.doc-base.tutorial 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/coq-doc-html.doc-base.tutorial 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -Document: coq-tutorial-html -Title: The Coq Proof Assistant -- A Tutorial -Author: Gérard Huet, Gilles Kahn and Christine Paulin-Mohring -Abstract: This documents presents in the most elementary manner a tutorial on the basic specification language of the Coq proof-assistant, called Gallina, in which formal axiomatisations may be developed, and on the main proof tools. -Section: Science/Mathematics - -Format: HTML -Index: /usr/share/doc/coq-doc-html/Tutorial.v.html -Files: /usr/share/doc/coq-doc-html/Tutorial.v.html diff -Nru coq-doc-8.6/debian/coq-doc-html.install coq-doc-8.15.0/debian/coq-doc-html.install --- coq-doc-8.6/debian/coq-doc-html.install 2017-07-05 20:29:28.000000000 +0000 +++ coq-doc-8.15.0/debian/coq-doc-html.install 2022-02-22 13:02:25.000000000 +0000 @@ -1,5 +1 @@ -doc/refman/html/* usr/share/doc/coq-doc-html/refman -doc/tutorial/Tutorial.v.html usr/share/doc/coq-doc-html -doc/faq/FAQ.v.html usr/share/doc/coq-doc-html -doc/faq/axioms.png usr/share/doc/coq-doc-html -doc/RecTutorial/RecTutorial.html usr/share/doc/coq-doc-html +_build/default/doc/refman-html/* usr/share/doc/coq-doc-html/refman diff -Nru coq-doc-8.6/debian/coq-doc-html.lintian-overrides coq-doc-8.15.0/debian/coq-doc-html.lintian-overrides --- coq-doc-8.6/debian/coq-doc-html.lintian-overrides 1970-01-01 00:00:00.000000000 +0000 +++ coq-doc-8.15.0/debian/coq-doc-html.lintian-overrides 2022-02-22 13:02:25.000000000 +0000 @@ -0,0 +1,2 @@ +# Debian doesn't have MathJax 3 yet +coq-doc-html: privacy-breach-generic [