pax_global_header00006660000000000000000000000064145152305150014513gustar00rootroot0000000000000052 comment=26626fa42c0c8a488522781bf867607531c4528e coq-ext-lib-0.12.0/000077500000000000000000000000001451523051500137175ustar00rootroot00000000000000coq-ext-lib-0.12.0/.github/000077500000000000000000000000001451523051500152575ustar00rootroot00000000000000coq-ext-lib-0.12.0/.github/workflows/000077500000000000000000000000001451523051500173145ustar00rootroot00000000000000coq-ext-lib-0.12.0/.github/workflows/docker-action.yml000066400000000000000000000037501451523051500225660ustar00rootroot00000000000000name: Docker CI on: push: branches: - master pull_request: branches: - '**' jobs: build: # the OS must be GNU/Linux to be able to use the docker-coq-action runs-on: ubuntu-latest strategy: matrix: coq: - '8.9' - '8.11' - '8.12' - '8.13' - '8.14' - '8.15' - '8.16' - '8.17' - 'dev' fail-fast: false steps: - uses: actions/checkout@v3 with: submodules: recursive - uses: coq-community/docker-coq-action@v1 with: opam_file: 'coq-ext-lib.opam' coq_version: ${{ matrix.coq }} before_script: | startGroup "Workaround permission issue" sudo chown -R coq:coq . endGroup after_script: | set -o pipefail # recommended if the script uses pipes startGroup "Generate Coqdoc" make -j`nproc` html endGroup startGroup "Test dependants" opam install conf-clang PINS=$(opam list -s --pinned --columns=package | xargs | tr ' ' ,) PACKAGES=`opam list -s --depends-on coq-ext-lib --coinstallable-with $PINS` for PACKAGE in $PACKAGES do DEPS_FAILED=false opam install --deps-only $PACKAGE || DEPS_FAILED=true [ $DEPS_FAILED == true ] || opam install -t $PACKAGE done endGroup export: 'OPAMWITHTEST OPAMCONFIRMLEVEL' env: OPAMWITHTEST: true OPAMCONFIRMLEVEL: unsafe-yes - name: Revert permissions # to avoid a warning at cleanup time if: ${{ always() }} run: sudo chown -R 1001:116 . - uses: actions/upload-artifact@v3 with: name: coqdoc path: html # See also: # https://github.com/coq-community/docker-coq-action#readme # https://github.com/erikmd/docker-coq-github-action-demo coq-ext-lib-0.12.0/.github/workflows/stale.yml000066400000000000000000000004061451523051500211470ustar00rootroot00000000000000name: 'Close stale issues and PRs' on: schedule: - cron: '30 1 * * 1-5' permissions: issues: write pull-requests: write jobs: stale: runs-on: ubuntu-latest steps: - uses: actions/stale@v8 with: days-before-close: -1 coq-ext-lib-0.12.0/.gitignore000066400000000000000000000003211451523051500157030ustar00rootroot00000000000000*.vo *.glob *.v.d *.cmi *.cmx *.cmxs *.native *.o *.aux Makefile.coq* Makefile.opam.coq *~ \#* .#* .dir-locals.el deps.dot deps.pdf .coqdeps.d .DS_Store html index.md index.html *.coq.d *.vok *.vos .lia.cache coq-ext-lib-0.12.0/.gitmodules000066400000000000000000000002751451523051500161000ustar00rootroot00000000000000[submodule "coqdocjs"] path = coqdocjs url = https://github.com/coq-community/coqdocjs.git [submodule "templates"] path = templates url = https://github.com/coq-community/templates.git coq-ext-lib-0.12.0/LICENSE000066400000000000000000000024631451523051500147310ustar00rootroot00000000000000BSD 2-Clause License Copyright (c) 2013, Gregory M. Malecha All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. coq-ext-lib-0.12.0/Makefile000066400000000000000000000016021451523051500153560ustar00rootroot00000000000000all: theories examples COQDOCJS_LN?=true -include coqdocjs/Makefile.doc COQMAKEFILE?=Makefile.coq theories: $(COQMAKEFILE) $(MAKE) -f $(COQMAKEFILE) $(COQMAKEFILE): $(COQBIN)coq_makefile -f _CoqProject -o $(COQMAKEFILE) install: $(COQMAKEFILE) $(MAKE) -f $(COQMAKEFILE) install examples: theories $(MAKE) -C examples clean: if [ -e $(COQMAKEFILE) ] ; then $(MAKE) -f $(COQMAKEFILE) cleanall ; fi $(MAKE) -C examples clean @rm -f $(COQMAKEFILE) $(COQMAKEFILE).conf uninstall: $(MAKE) -f $(COQMAKEFILE) uninstall dist: @ git archive --prefix coq-ext-lib/ HEAD -o $(PROJECT_NAME).tgz .PHONY: all clean dist theories examples html TEMPLATES ?= templates index.html: index.md pandoc -s $^ -o $@ index.md: meta.yml $(TEMPLATES)/generate.sh $@ publish%: opam publish --packages-directory=released/packages \ --repo=coq/opam-coq-archive --tag=v$* -v $* coq-community/coq-ext-lib coq-ext-lib-0.12.0/README.md000066400000000000000000000065621451523051500152070ustar00rootroot00000000000000 # coq-ext-lib [![Docker CI][docker-action-shield]][docker-action-link] [![Contributing][contributing-shield]][contributing-link] [![Code of Conduct][conduct-shield]][conduct-link] [![Zulip][zulip-shield]][zulip-link] [docker-action-shield]: https://github.com/coq-community/coq-ext-lib/workflows/Docker%20CI/badge.svg?branch=master [docker-action-link]: https://github.com/coq-community/coq-ext-lib/actions?query=workflow:"Docker%20CI" [contributing-shield]: https://img.shields.io/badge/contributions-welcome-%23f7931e.svg [contributing-link]: https://github.com/coq-community/manifesto/blob/master/CONTRIBUTING.md [conduct-shield]: https://img.shields.io/badge/%E2%9D%A4-code%20of%20conduct-%23f15a24.svg [conduct-link]: https://github.com/coq-community/manifesto/blob/master/CODE_OF_CONDUCT.md [zulip-shield]: https://img.shields.io/badge/chat-on%20zulip-%23c1272d.svg [zulip-link]: https://coq.zulipchat.com/#narrow/stream/237663-coq-community-devs.20.26.20users A collection of theories and plugins that may be useful in other Coq developments. ## Meta - Author(s): - Gregory Malecha (initial) - Coq-community maintainer(s): - Gregory Malecha ([**@gmalecha**](https://github.com/gmalecha)) - Yishuai Li ([**@liyishuai**](https://github.com/liyishuai)) - License: [BSD 2-Clause "Simplified" License](LICENSE) - Compatible Coq versions: Coq 8.11 or later or 8.9 - Additional dependencies: none - Coq namespace: `ExtLib` - Related publication(s): none ## Building and installation instructions The easiest way to install the latest released version of coq-ext-lib is via [OPAM](https://opam.ocaml.org/doc/Install.html): ```shell opam repo add coq-released https://coq.inria.fr/opam/released opam install coq-ext-lib ``` To instead build and install manually, do: ``` shell git clone --recurse-submodules https://github.com/coq-community/coq-ext-lib.git cd coq-ext-lib make theories # or make -j theories make install ``` Ideas ----- - Embrace new features, e.g. universe polymorphism, primitive projections, etc. - Use modules for controlling namespaces. - Use first-class abstractions where appropriate, e.g. type classes, canonical structures, etc. - The library is mostly built around type clases - Notations should be hidden by modules that are explicitly opened. - This avoids clashes between precedence. - TB: Actually, this does not completely avoid clashes, if we have to open two modules at the same time (for instance, I often need to open Equality, to get dependent destruction, which conflicts with the rest of my development) - TB: I like the idea of having to prefix operations by the name of the module (e.g., DList.fold, DList.map, DList.T), and yet to benefit from the support of notations, without opening this module. I implement that by having a module DList that contains the operations, inside the file DList. The notations live in the file DList, and I do Require Import DList everywhere... - Avoid the use of the 'core' hint database. - Avoid the use of dependent functions, e.g. dependendent decidable equality, in favor of their boolen counter-parts. Use type-classes to expose the proofs. - File Structure -------------- * theories/ - Base directory to the provided theories coq-ext-lib-0.12.0/_CoqProject000066400000000000000000000062201451523051500160520ustar00rootroot00000000000000-Q theories ExtLib theories/ExtLib.v theories/Tactics.v theories/Core/Any.v theories/Core/CmpDec.v theories/Core/EquivDec.v theories/Core/RelDec.v theories/Core/Decision.v theories/Structures/Applicative.v theories/Structures/BinOps.v theories/Structures/CoFunctor.v theories/Structures/CoMonad.v theories/Structures/CoMonadLaws.v theories/Structures/EqDep.v theories/Structures/Foldable.v theories/Structures/FunctorLaws.v theories/Structures/Functor.v theories/Structures/Maps.v theories/Structures/MonadCont.v theories/Structures/MonadExc.v theories/Structures/MonadFix.v theories/Structures/MonadLaws.v theories/Structures/MonadPlus.v theories/Structures/MonadReader.v theories/Structures/MonadState.v theories/Structures/Monads.v theories/Structures/MonadTrans.v theories/Structures/Monad.v theories/Structures/MonadWriter.v theories/Structures/MonadZero.v theories/Structures/Monoid.v theories/Structures/Reducible.v theories/Structures/Sets.v theories/Structures/Traversable.v theories/Data/Bool.v theories/Data/Char.v theories/Data/Checked.v theories/Data/Eq.v theories/Data/Eq/UIP_trans.v theories/Data/Fin.v theories/Data/Fun.v theories/Data/HList.v theories/Data/LazyList.v theories/Data/Lazy.v theories/Data/ListFirstnSkipn.v theories/Data/ListNth.v theories/Data/List.v theories/Data/Member.v theories/Data/Nat.v theories/Data/N.v theories/Data/Option.v theories/Data/Pair.v theories/Data/Positive.v theories/Data/PreFun.v theories/Data/Prop.v theories/Data/SigT.v theories/Data/Stream.v theories/Data/String.v theories/Data/SumN.v theories/Data/Sum.v theories/Data/Tuple.v theories/Data/Unit.v theories/Data/Vector.v theories/Data/Z.v theories/Data/POption.v theories/Data/PList.v theories/Data/PPair.v theories/Generic/Data.v theories/Generic/DerivingData.v theories/Generic/Func.v theories/Generic/Ind.v theories/Programming/Eqv.v theories/Programming/Extras.v theories/Programming/Injection.v theories/Programming/Le.v theories/Programming/Show.v theories/Programming/With.v theories/Recur/Facts.v theories/Recur/GenRec.v theories/Recur/Measure.v theories/Recur/Relation.v theories/Relations/Compose.v theories/Relations/TransitiveClosure.v theories/Tactics/BoolTac.v theories/Tactics/Cases.v theories/Tactics/Consider.v theories/Tactics/EqDep.v theories/Tactics/Equality.v theories/Tactics/Forward.v theories/Tactics/Injection.v theories/Tactics/MonadTac.v theories/Tactics/Parametric.v theories/Tactics/Reify.v theories/Tactics/Hide.v theories/Data/Graph/BuildGraph.v theories/Data/Graph/GraphAdjList.v theories/Data/Graph/GraphAlgos.v theories/Data/Graph/Graph.v theories/Data/Map/FMapAList.v theories/Data/Map/FMapPositive.v theories/Data/Map/FMapTwoThreeK.v theories/Data/Monads/ContMonad.v theories/Data/Monads/EitherMonad.v theories/Data/Monads/FuelMonadLaws.v theories/Data/Monads/FuelMonad.v theories/Data/Monads/IdentityMonadLaws.v theories/Data/Monads/IdentityMonad.v theories/Data/Monads/OptionMonadLaws.v theories/Data/Monads/OptionMonad.v theories/Data/Monads/ReaderMonadLaws.v theories/Data/Monads/ReaderMonad.v theories/Data/Monads/StateMonad.v theories/Data/Monads/WriterMonad.v theories/Data/Set/ListSet.v theories/Data/Set/SetMap.v theories/Data/Set/TwoThreeTrees.v coq-ext-lib-0.12.0/coq-ext-lib.opam000066400000000000000000000013511451523051500167210ustar00rootroot00000000000000opam-version: "2.0" maintainer: "gmalecha@gmail.com" homepage: "https://github.com/coq-community/coq-ext-lib" dev-repo: "git+https://github.com/coq-community/coq-ext-lib.git" bug-reports: "https://github.com/coq-community/coq-ext-lib/issues" authors: ["Gregory Malecha"] license: "BSD-2-Clause" build: [ [make "-j%{jobs}%" "theories"] ] run-test: [ [make "-j%{jobs}%" "examples"] ] install: [ [make "install"] ] depends: [ "ocaml" "coq" { >= "8.9" < "8.10" | >= "8.11" } ] synopsis: "A library of Coq definitions, theorems, and tactics" description: """ A collection of theories and plugins that may be useful in other Coq developments.""" tags: [ "logpath:ExtLib" ] url { src: "git+https://github.com/coq-community/coq-ext-lib" } coq-ext-lib-0.12.0/coqdocjs/000077500000000000000000000000001451523051500155245ustar00rootroot00000000000000coq-ext-lib-0.12.0/examples/000077500000000000000000000000001451523051500155355ustar00rootroot00000000000000coq-ext-lib-0.12.0/examples/ConsiderDemo.v000066400000000000000000000013431451523051500203000ustar00rootroot00000000000000Require Import Coq.Bool.Bool. Require Import Arith.PeanoNat. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Data.Nat. Require Import Coq.ZArith.ZArith. Require Import Coq.micromega.Lia. Set Implicit Arguments. Set Strict Implicit. (** Some tests *) Section test. Goal forall x y z, (Nat.ltb x y && Nat.ltb y z) = true -> Nat.ltb x z = true. intros x y z. consider (Nat.ltb x y && Nat.ltb y z). consider (Nat.ltb x z); auto. intros. exfalso. lia. Qed. Goal forall x y z, Nat.ltb x y = true -> Nat.ltb y z = true -> Nat.ltb x z = true. Proof. intros. consider (Nat.ltb x y); consider (Nat.ltb y z); consider (Nat.ltb x z); intros; auto. exfalso; lia. Qed. End test. coq-ext-lib-0.12.0/examples/EvalWithExc.v000066400000000000000000000053561451523051500201200ustar00rootroot00000000000000Require Import Coq.Strings.String. (** Require the monad definitions **) Require Import ExtLib.Structures.Monads. (** Use the instances for exceptions **) Require Import ExtLib.Data.Monads.EitherMonad. (** Strings will be used for error messages **) Require Import ExtLib.Data.String. Set Implicit Arguments. Set Strict Implicit. (** Syntax and values of a simple language **) Inductive value : Type := | Int : nat -> value | Bool : bool -> value. Inductive exp : Type := | ConstI : nat -> exp | ConstB : bool -> exp | Plus : exp -> exp -> exp | If : exp -> exp -> exp -> exp. Section monadic. (** Going to work over any monad [m] that is: ** 1) a Monad, i.e. [Monad m] ** 2) has string-valued exceptions, i.e. [MonadExc string m] **) Variable m : Type -> Type. Context {Monad_m : Monad m}. Context {MonadExc_m : MonadExc string m}. (** Use the notation for monads **) Import MonadNotation. Local Open Scope monad_scope. (** Functions that get [nat] or [bool] values from a [value] **) Definition asInt (v : value) : m nat := match v with | Int n => ret n | _ => (** if we don't have an integer, signal an error using ** [raise] from the MoandExc instance **) raise ("expected integer got bool")%string end. Definition asBool (v : value) : m bool := match v with | Bool b => ret b | _ => raise ("expected bool got integer")%string end. (** The main evaluator routine returns a [value], but since we are ** working in the [m] monad, we return [m value] **) Fixpoint eval' (e : exp) : m value := match e with (** when there is no error, we can just return (i.e. [ret]) ** the answer **) | ConstI i => ret (Int i) | ConstB b => ret (Bool b) | Plus l r => (** evaluate the sub-terms to numbers **) l <- eval' l ;; l <- asInt l ;; r <- eval' r ;; r <- asInt r ;; (** Combine the result **) ret (Int (l + r)) | If t tr fa => (** evaluate the test condition to a boolean **) t <- eval' t ;; t <- asBool t ;; (** case split and perform the appropriate recursion **) if (t : bool) then eval' tr else eval' fa end. End monadic. (** Wrap the [eval] function up with the monad instance that we ** want to use **) Definition eval : exp -> string + value := eval' (m := sum string). (** Some tests **) Eval compute in eval (Plus (ConstI 1) (ConstI 2)). Eval compute in eval (Plus (ConstI 1) (ConstB false)). (** Other useful monads: ** * Reader - for handling lexicographic environments ** * State - for handling non-lexical state, like a heap ** * MonadFix - for handling unbounded recursion **) coq-ext-lib-0.12.0/examples/Makefile000066400000000000000000000003701451523051500171750ustar00rootroot00000000000000coq: Makefile.coq $(MAKE) -f Makefile.coq clean: if [ -e Makefile.coq ] ; then $(MAKE) -f Makefile.coq cleanall ; fi rm -f Makefile.coq Makefile.coq.conf Makefile.coq: Makefile _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq coq-ext-lib-0.12.0/examples/MonadReasoning.v000066400000000000000000000026001451523051500206260ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.MonadLaws. Require Import ExtLib.Data.PreFun. Require Import ExtLib.Data.Fun. Set Implicit Arguments. Set Strict Implicit. (** Currently not ported due to universes *) (* Section with_m. Variable m : Type -> Type. Variable Monad_m : Monad m. Variable meq : forall {T}, type T -> type (m T). Variable meqOk : forall {T} (tT : type T), typeOk tT -> typeOk (meq tT). Variable MonadLaws_m : @MonadLaws m Monad_m meq. Variable T : Type. Variable type_T : type T. Variable typeOk_T : typeOk type_T. Lemma proper_eta : forall T U (f : T -> U) (type_T : type T) (type_U : type U), proper f -> proper (fun x => f x). Proof. intros; do 3 red; intros. eapply H. assumption. Qed. Goal forall x : T, proper x -> equal (bind (ret x) (fun x => ret x)) (ret x). Proof. intros. etransitivity. { eapply bind_of_return; eauto. eapply proper_eta. eapply ret_proper; eauto. } { eapply ret_proper; eauto. eapply equiv_prefl; eauto. } Qed. Goal forall x : T, proper x -> equal (bind (ret x) (fun x => ret x)) (ret x). Proof. intros. etransitivity. { eapply bind_of_return; eauto. eapply proper_eta. eapply ret_proper; eauto. } { eapply ret_proper; eauto. eapply equiv_prefl; eauto. } Qed. End with_m. *) coq-ext-lib-0.12.0/examples/Notations.v000066400000000000000000000011601451523051500177000ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Generalizable All Variables. Module NotationExample. Import MonadNotation. Open Scope monad_scope. Fixpoint repeatM `{Monad M} (n : nat) `(x : A) (p : A -> M A) : M unit := match n with | O => ret tt | S n => y <- p x;; repeatM n y p end. End NotationExample. Module LetNotationExample. Import MonadLetNotation. Open Scope monad_scope. Fixpoint repeatM `{Monad M} (n : nat) `(x : A) (p : A -> M A) : M unit := match n with | O => ret tt | S n => let* y := p x in repeatM n y p end. End LetNotationExample. coq-ext-lib-0.12.0/examples/Printing.v000066400000000000000000000022651451523051500175230ustar00rootroot00000000000000Require Import Coq.Strings.String. Require Import ExtLib.Structures.MonadWriter. Require Import ExtLib.Data.PPair. Require Import ExtLib.Data.Monads.WriterMonad. Require Import ExtLib.Data.Monads.IdentityMonad. Require Import ExtLib.Programming.Show. Definition PrinterMonad : Type -> Type := writerT (@show_mon _ ShowScheme_string_compose) ident. Definition print {T : Type} {ST : Show T} (val : T) : PrinterMonad unit := @MonadWriter.tell _ (@show_mon _ ShowScheme_string_compose) _ _ (@show _ ST val _ show_inj (@show_mon _ ShowScheme_string_compose)). Definition printString (str : string) : PrinterMonad unit := @MonadWriter.tell _ (@show_mon _ ShowScheme_string_compose) _ _ (@show_exact str _ show_inj (@show_mon _ ShowScheme_string_compose)). Definition runPrinter {T : Type} (c : PrinterMonad T) : T * string := let '(ppair val str) := unIdent (runWriterT c) in (val, str ""%string). Eval compute in runPrinter (Monad.bind (print 1) (fun _ => print 2)). Eval compute in runPrinter (Monad.bind (print "hello "%string) (fun _ => print 2)). Eval compute in runPrinter (Monad.bind (printString "hello "%string) (fun _ => print 2)).coq-ext-lib-0.12.0/examples/StateGame.v000066400000000000000000000030711451523051500175770ustar00rootroot00000000000000(* State monad example adapted from https://wiki.haskell.org/State_Monad Example use of State monad Passes a string of dictionary {a,b,c} Game is to produce a number from the string. By default the game is off, a C toggles the game on and off. A 'a' gives +1 and a b gives -1. E.g 'ab' = 0 'ca' = 1 'cabca' = 0 State = game is on or off & current score = (Bool, Int) *) Require Import Coq.ZArith.ZArith_base Coq.Strings.String Coq.Strings.Ascii. Require Import ExtLib.Data.Monads.StateMonad ExtLib.Structures.Monads. Section StateGame. Import MonadNotation. Local Open Scope Z_scope. Local Open Scope char_scope. Local Open Scope monad_scope. Definition GameValue : Type := Z. Definition GameState : Type := (prod bool Z). Variable m : Type -> Type. Context {Monad_m: Monad m}. Context {State_m: MonadState GameState m}. Fixpoint playGame (s: string) {struct s}: m GameValue := match s with | EmptyString => v <- get ;; let '(on, score) := v in ret score | String x xs => v <- get ;; let '(on, score) := v in match x, on with | "a", true => put (on, score + 1) | "b", true => put (on, score - 1) | "c", _ => put (negb on, score) | _, _ => put (on, score) end ;; playGame xs end. Definition startState: GameState := (false, 0). End StateGame. Definition main : GameValue := (@evalState GameState GameValue (playGame (state GameState) "abcaaacbbcabbab") startState). (* The following should return '2%Z' *) Compute main. coq-ext-lib-0.12.0/examples/StateTMonad.v000066400000000000000000000006421451523051500201110ustar00rootroot00000000000000From ExtLib Require Import Monad OptionMonad StateMonad. (** [Monad_stateT] is not in context, so this definition fails *) Fail Definition foo : stateT unit option unit := ret tt. (** Use [Existing Instance] to bring the Local [Monad_stateT] instance into context *) #[global] Existing Instance Monad_stateT. (** Now the definition succeeds *) Definition foo : stateT unit option unit := ret tt. coq-ext-lib-0.12.0/examples/UsingSets.v000066400000000000000000000015241451523051500176520ustar00rootroot00000000000000Require Import Coq.Bool.Bool. Require Import ExtLib.Structures.Sets. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Structures.Functor. Set Implicit Arguments. Set Strict Implicit. (** Program with respect to the set interface **) Section with_set. Variable V : Type. Context {set : Type}. Context {Set_set : DSet set V}. Definition contains_both (v1 v2 : V) (s : set) : bool := contains v1 s && contains v2 s. (** Iteration requires foldability **) Context {Foldable_set : Foldable set V}. Definition toList (s : set) : list V := fold (@cons _) nil s. End with_set. (** Instantiate the set **) Require Import ExtLib.Data.Set.ListSet. Require Import ExtLib.ExtLib. Eval compute in contains_both 0 1 empty. Eval compute in toList (add true (add true empty)). Eval compute in fmap negb (add true empty).coq-ext-lib-0.12.0/examples/WithDemo.v000066400000000000000000000012351451523051500174450ustar00rootroot00000000000000Require Import List. Require Import ExtLib.Programming.With. Record RTest : Set := mkRTest { a : bool ; b : nat ; c : bool }. Bind Scope struct_scope with RTest. Global Instance Struct_RTest : Struct RTest := { fields := ((@existT _ _ _ a) :: (@existT _ _ _ b) :: (@existT _ _ _ c):: nil) ; ctor := mkRTest }. Global Instance Acc_RTest_a : Accessor a := { acc := Here }. Global Instance Acc_RTest_b : Accessor b := { acc := Next Here }. Global Instance Acc_RTest_c : Accessor c := { acc := Next (Next Here) }. Eval compute in {$ mkRTest true 1 true with c := false $}%record. Eval compute in forall x : RTest, c {$ x with c := false $}%record = false. coq-ext-lib-0.12.0/examples/_CoqProject000066400000000000000000000002251451523051500176670ustar00rootroot00000000000000-Q ../theories ExtLib -Q . ExtLibExamples ConsiderDemo.v EvalWithExc.v MonadReasoning.v Printing.v UsingSets.v WithDemo.v Notations.v StateTMonad.v coq-ext-lib-0.12.0/meta.yml000066400000000000000000000056351451523051500154010ustar00rootroot00000000000000--- fullname: coq-ext-lib shortname: coq-ext-lib opam_name: coq-ext-lib organization: coq-community community: true action: false ci_test_dependants: true submodule: true synopsis: A library of Coq definitions, theorems, and tactics description: A collection of theories and plugins that may be useful in other Coq developments. authors: - name: Gregory Malecha initial: true maintainers: - name: Gregory Malecha nickname: gmalecha - name: Yishuai Li nickname: liyishuai opam-file-maintainer: "gmalecha@gmail.com" license: fullname: BSD 2-Clause "Simplified" License identifier: BSD-2-Clause supported_coq_versions: text: Coq 8.11 or later or 8.9 opam: '{ >= "8.9" < "8.10" | >= "8.11" }' tested_coq_opam_versions: - version: '8.9' - version: '8.11' - version: '8.12' - version: '8.13' - version: '8.14' - version: '8.15' - version: '8.16' - version: '8.17' - version: 'dev' make_target: theories test_target: examples namespace: ExtLib circleci_after_script: |2- - run: name: Generate Coqdoc command: | make -j`nproc` html tar cfz coqdoc.tgz html - store_artifacts: path: coqdoc.tgz action_appendix: |2- export: 'OPAMWITHTEST' env: OPAMWITHTEST: true documentation: | Ideas ----- - Embrace new features, e.g. universe polymorphism, primitive projections, etc. - Use modules for controlling namespaces. - Use first-class abstractions where appropriate, e.g. type classes, canonical structures, etc. - The library is mostly built around type clases - Notations should be hidden by modules that are explicitly opened. - This avoids clashes between precedence. - TB: Actually, this does not completely avoid clashes, if we have to open two modules at the same time (for instance, I often need to open Equality, to get dependent destruction, which conflicts with the rest of my development) - TB: I like the idea of having to prefix operations by the name of the module (e.g., DList.fold, DList.map, DList.T), and yet to benefit from the support of notations, without opening this module. I implement that by having a module DList that contains the operations, inside the file DList. The notations live in the file DList, and I do Require Import DList everywhere... - Avoid the use of the 'core' hint database. - Avoid the use of dependent functions, e.g. dependendent decidable equality, in favor of their boolen counter-parts. Use type-classes to expose the proofs. - File Structure -------------- * theories/ - Base directory to the provided theories coqdoc_index: | - [0.11.8](v0.11.8/toc.html) - [0.11.7](v0.11.7/toc.html) - [0.11.6](v0.11.6/toc.html) - [0.11.5](v0.11.5/toc.html) - [0.11.4](v0.11.4/toc.html) - [0.11.3](v0.11.3/toc.html) - [0.11.2](v0.11.2/toc.html) - [0.11.1](v0.11.1/toc.html) - [0.11.0](v0.11.0/toc.html) - [0.10.3](v0.10.3/toc.html) --- coq-ext-lib-0.12.0/scratch/000077500000000000000000000000001451523051500153465ustar00rootroot00000000000000coq-ext-lib-0.12.0/scratch/FunctorFromMonad.v000066400000000000000000000120241451523051500207570ustar00rootroot00000000000000Require Import Relations. Require Import ExtLib.Data.Fun. Require Import ExtLib.Structures.Proper. Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.FunctorRelations. Require Import ExtLib.Structures.MonadLaws. Set Implicit Arguments. Set Strict Implicit. Section stuff. Variable m : Type -> Type. Variable Monad_m : Monad m. Variable mleq : forall T, (T -> T -> Prop) -> m T -> m T -> Prop. Variable mproper : forall T (rT : relation T), Proper rT -> Proper (mleq rT). Variable FunctorOrder_mleq : FunctorOrder m mleq mproper. Variable MonadLaws_mleq : MonadLaws Monad_m mleq mproper. Definition compose (A B C : Type) (f : A -> B) (g : B -> C) : A -> C := fun x => g (f x). Definition pure (T : Type) : T -> m T := @ret _ _ _. Definition fapply (T U : Type) (f : m (T -> U)) (x : m T) : m U := bind f (fun f => bind x (fun x => ret (f x))). Existing Instance fun_trans. Existing Instance fun_refl. Variables A B C : Type. Context (rA : relation A) (rB : relation B) (rC : relation C) (pA : Proper rA) (pB : Proper rB) (pC : Proper rC). Context (Ra : PReflexive rA) (Rb : PReflexive rB) (Rc : PReflexive rC). Context (Ta : PTransitive rA) (Tb : PTransitive rB) (Tc : PTransitive rC). Instance fun_app_proper (A B : Type) (rA : relation A) (rB : relation B) (pA : Proper rA) (pB : Proper rB) (f : A -> B) x : proper f -> proper x -> proper (f x). Proof. intros. apply H. auto. Qed. Instance fun_abs (A B : Type) (rA : relation A) (rB : relation B) (pA : Proper rA) (pB : Proper rB) (f : A -> B) : (forall x, proper x -> proper (f x)) -> (forall x y, proper x -> proper y -> rA x y -> rB (f x) (f y)) -> proper (fun x => f x). Proof. intros. split; auto; eapply H. Qed. Ltac prove_proper x k := match x with | _ => match goal with | [ H : proper x |- _ ] => k H end | bind ?A ?B => prove_proper A ltac:(fun a => prove_proper B ltac:(fun b => let H := fresh in assert (H : proper x); [ eapply bind_proper; eauto with typeclass_instances | k H ])) | ret ?A => prove_proper A ltac:(fun a => let H := fresh in assert (H : proper x); [ eapply ret_proper; eauto with typeclass_instances | k H ]) | (fun x => _) => let H := fresh in assert (H : proper x); [ eapply fun_abs; intros; [ propers | repeat red; intros; prove_mleq ] | k H ] | _ => let H := fresh in assert (H : proper x); [ eauto with typeclass_instances | k H ] end with prove_mleq := try match goal with | |- proper (fun x => _) => eapply fun_abs; intros; [ propers | repeat red; intros; prove_mleq ] | [ R : _ , H' : pfun_ext ?R _ ?F ?G |- ?R (?F _) (?G _) ] => eapply H'; [ propers | propers | prove_mleq ] | [ H' : proper ?F |- ?R (?F _) (?F _) ] => eapply H'; [ propers | propers | try assumption; prove_mleq ] | [ |- mleq _ (bind _ _) (bind _ _) ] => eapply bind_respectful_leq; [ eauto with typeclass_instances | eauto with typeclass_instances | prove_mleq | intros; prove_mleq ] | [ |- mleq _ (ret _) (ret _) ] => eapply ret_respectful_leq; [ eauto with typeclass_instances | eauto with typeclass_instances | prove_mleq ] | [ H : proper ?f |- pfun_ext _ _ ?f ?f ] => apply H | [ H : proper ?f |- pfun_ext _ _ (fun x => _) (fun y => _) ] => red; intros; prove_mleq | _ => eassumption end with propers := match goal with | |- proper ?X => prove_proper X ltac:(fun x => eapply x) | |- mleq _ ?X ?Y => prove_proper X ltac:(fun x => prove_proper Y ltac:(fun x => idtac)) end. Instance PReflexive_stuff : PReflexive (pfun_ext (pfun_ext (pfun_ext rC pA) (Proper_pfun pB pC)) (Proper_pfun pA pB)). Proof. intuition. Qed. Theorem bind_law : forall (f : A -> B) (g : B -> C), proper f -> proper g -> mleq (pfun_ext rC pA) (fapply (fapply (pure (@compose A B C)) (pure f)) (pure g)) (pure (compose f g)). Proof. unfold fapply, pure, compose; simpl; intros. propers. (eapply ptransitive; [ | | | | eapply (@bind_associativity _ _ _ _ MonadLaws_mleq) | ]); eauto with typeclass_instances; propers. (eapply ptransitive; [ | | | | eapply (@bind_of_return _ _ _ _ MonadLaws_mleq) | ]); eauto with typeclass_instances; propers. (eapply ptransitive; [ | | | | eapply (@bind_associativity _ _ _ _ MonadLaws_mleq) | ]); eauto with typeclass_instances; propers. (eapply ptransitive; [ | | | | eapply (@bind_of_return _ _ _ _ MonadLaws_mleq) | ]); eauto with typeclass_instances; propers. (eapply ptransitive; [ | | | | eapply (@bind_of_return _ _ _ _ MonadLaws_mleq) | ]); eauto with typeclass_instances; propers. (eapply ptransitive; [ | | | | eapply (@bind_of_return _ _ _ _ MonadLaws_mleq) | ]); eauto with typeclass_instances; propers. eapply preflexive; eauto with typeclass_instances. Qed. End stuff. Print Assumptions bind_law. coq-ext-lib-0.12.0/scratch/notation.md000066400000000000000000000013311451523051500175210ustar00rootroot00000000000000Module | Notation | Definition | Level | Associativity ---|---|---|---|--- `FunNotation` | `begin e1 end` | `e1` | 0 | `FunctorNotation` | `f <$> x` | `fmap f x` | 52 | left `ApplicativeNotation` | `f <*> x` | `ap f x` | 52 | left `MonadPlusNotation` | `x <+> y` | `mplus x y` | 54 | left `MonadNotation` | `c >>= f` | `bind c f` | 58 | left `MonadNotation` | `f =<< c` | `bind c f` | 61 | right `MonadNotation` | `f >=> g` | `mcompose f g` | 61 | right `MonadNotation` | `x <- c1 ;; c2` | `bind c1 (fun x => c2)` | 61 | right `MonadNotation` | `' pat <- c1 ;; c2` | `bind c1 (fun x => match x with pat => c2)` | 61 | right `MonadNotation` | `e1 ;; e2` | `_ <- e1 ;; e2` | 61 | right `FunNotation` | `f $ x` | `f x` | 99 | right coq-ext-lib-0.12.0/templates/000077500000000000000000000000001451523051500157155ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/000077500000000000000000000000001451523051500155415ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Core/000077500000000000000000000000001451523051500164315ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Core/Any.v000066400000000000000000000005651451523051500173550ustar00rootroot00000000000000Set Implicit Arguments. Set Strict Implicit. (** This class should be used when no requirements are needed **) Polymorphic Class Any (T : Type) : Prop. Global Polymorphic Instance Any_a (T : Type) : Any T := {}. Polymorphic Definition RESOLVE (T : Type) : Type := T. Existing Class RESOLVE. #[global] Hint Extern 0 (RESOLVE _) => unfold RESOLVE : typeclass_instances. coq-ext-lib-0.12.0/theories/Core/CmpDec.v000066400000000000000000000032641451523051500177600ustar00rootroot00000000000000Require Import Coq.Bool.Bool. Require Import Coq.Classes.RelationClasses. Require Import ExtLib.Tactics.Consider. Set Implicit Arguments. Set Strict Implicit. Class CmpDec (T : Type) (equ : T -> T -> Prop) (ltu : T -> T -> Prop) : Type := { cmp_dec : T -> T -> comparison }. Class CmpDec_Correct T (equ ltu : T -> T -> Prop) (ED : CmpDec equ ltu) : Prop := { cmp_dec_correct : forall x y : T, match cmp_dec x y with | Eq => equ x y | Lt => ltu x y | Gt => ltu y x end }. Inductive cmp_case (P Q R : Prop) : comparison -> Prop := | CaseEq : P -> cmp_case P Q R Eq | CaseLt : Q -> cmp_case P Q R Lt | CaseGt : R -> cmp_case P Q R Gt. Section pair. Variable T U : Type. Variables eqt ltt : T -> T -> Prop. Variables equ ltu : U -> U -> Prop. Definition eq_pair (a b : T * U) : Prop := eqt (fst a) (fst b) /\ equ (snd a) (snd b). Definition lt_pair (a b : T * U) : Prop := ltt (fst a) (fst b) \/ (eqt (fst a) (fst b) /\ ltu (snd a) (snd b)). Variable cdt : CmpDec eqt ltt. Variable cdu : CmpDec equ ltu. Instance CmpDec_pair : CmpDec eq_pair lt_pair := { cmp_dec := fun a b => let '(al,ar) := a in let '(bl,br) := b in match cmp_dec al bl with | Eq => cmp_dec ar br | x => x end }. Variable cdtC : CmpDec_Correct cdt. Variable cduC : CmpDec_Correct cdu. Variable Symmetric_eqt : Symmetric eqt. Instance CmpDec_Correct_pair : CmpDec_Correct CmpDec_pair. Proof. constructor. destruct x; destruct y; unfold eq_pair, lt_pair; simpl in *. generalize (cmp_dec_correct t t0); destruct (cmp_dec t t0); simpl; intros; auto. generalize (cmp_dec_correct u u0); destruct (cmp_dec u u0); simpl; intros; auto. Qed. End pair. coq-ext-lib-0.12.0/theories/Core/Decision.v000066400000000000000000000014451451523051500203610ustar00rootroot00000000000000Require Import Coq.Classes.DecidableClass. Definition decideP (P : Prop) {D : Decidable P} : {P} + {~P} := match @Decidable_witness P D as X return (X = true -> P) -> (X = false -> ~P) -> {P} + {~P} with | true => fun pf _ => left (pf eq_refl) | false => fun _ pf => right (pf eq_refl) end (@Decidable_sound _ D) (@Decidable_complete_alt _ D). Ltac cases_ifd Hn := match goal with |- context[if ?d then ?tt else ?ff] => let Hnt := fresh Hn "t" in let Hnf := fresh Hn "f" in destruct d as [Hnt | Hnf] end. Lemma decide_decideP {P:Prop }`{Decidable P} {R:Type} (a b : R) : (if (decide P) then a else b) = (if (decideP P) then a else b). Proof. symmetry. unfold decide. destruct (decideP P). - rewrite Decidable_complete; auto. - rewrite Decidable_sound_alt; auto. Qed. coq-ext-lib-0.12.0/theories/Core/EquivDec.v000066400000000000000000000005521451523051500203270ustar00rootroot00000000000000Require Import Coq.Classes.EquivDec. Theorem EquivDec_refl_left {T : Type} {c : EqDec T (@eq T)} : forall (n : T), equiv_dec n n = left (refl_equal _). Proof. intros. destruct (equiv_dec n n); try congruence. Require Eqdep_dec. rewrite (Eqdep_dec.UIP_dec (A := T) (@equiv_dec _ _ _ c) e (refl_equal _)). reflexivity. Qed. Export Coq.Classes.EquivDec.coq-ext-lib-0.12.0/theories/Core/RelDec.v000066400000000000000000000107121451523051500177570ustar00rootroot00000000000000Require Import Coq.Bool.Bool. Require Import Coq.Classes.RelationClasses. Require Coq.Setoids.Setoid. Set Implicit Arguments. Set Strict Implicit. Class RelDec (T : Type) (equ : T -> T -> Prop) : Type := { rel_dec : T -> T -> bool }. Arguments rel_dec {_} {equ} {_} _ _. Arguments rel_dec _ _ _ !x !y. Class RelDec_Correct T (equ : T -> T -> Prop) (ED : RelDec equ) : Prop := { rel_dec_correct : forall x y : T, rel_dec x y = true <-> equ x y }. Notation "a ?[ r ] b" := (@rel_dec _ r _ a b) (at level 30, b at next level). Definition eq_dec {T : Type} {ED : RelDec (@eq T)} := rel_dec. Section neg_rel_dec_correct. Context {T} {R:T -> T -> Prop} {RD:RelDec R} {RDC:RelDec_Correct RD}. Definition neg_rel_dec_correct : forall {x y}, ~R x y <-> rel_dec x y = false. Proof. intros x y. destruct (bool_dec (rel_dec x y) true) ; constructor ; intros ; repeat match goal with | [ |- ~ _ ] => unfold not ; intros | [ H1 : ?P, H2 : ~?P |- _ ] => specialize (H2 H1) ; contradiction | [ H1 : ?P = true, H2 : ?P = false |- _ ] => rewrite H1 in H2 ; discriminate | [ H1 : ?P <> true |- ?P = false ] => apply not_true_is_false ; exact H1 | [ H1 : ?rel_dec ?a ?b = true, H2 : ~?R ?a ?b |- _ ] => apply rel_dec_correct in H1 | [ H1 : ?rel_dec ?a ?b = false, H2 : ?R ?a ?b |- _ ] => apply rel_dec_correct in H2 end. Qed. End neg_rel_dec_correct. Section rel_dec_p. Context {T} {R:T -> T -> Prop} {RD:RelDec R} {RDC:RelDec_Correct RD}. Definition rel_dec_p (x:T) (y:T) : {R x y} + {~R x y}. Proof. destruct (bool_dec (rel_dec x y) true) as [H | H]. apply rel_dec_correct in H ; eauto. apply not_true_is_false in H ; apply neg_rel_dec_correct in H ; eauto. Qed. Definition neg_rel_dec_p (x:T) (y:T) : {~R x y} + {R x y}. Proof. destruct (rel_dec_p x y) ; [ right | left ] ; auto. Qed. End rel_dec_p. Section lemmas. Variable T : Type. Variable eqt : T -> T -> Prop. Variable r : RelDec eqt. Variable rc : RelDec_Correct r. Theorem rel_dec_eq_true : forall x y, eqt x y -> rel_dec x y = true. Proof. intros. eapply rel_dec_correct in H. assumption. Qed. Theorem rel_dec_neq_false : forall x y, ~eqt x y -> rel_dec x y = false. Proof. intros. remember (x ?[ eqt ] y). symmetry in Heqb. destruct b; try reflexivity. exfalso. eapply (@rel_dec_correct _ _ _ rc) in Heqb. auto. Qed. Theorem rel_dec_sym : Symmetric eqt -> forall x y, x ?[ eqt ] y = y ?[ eqt ] x. Proof. intros. remember (x ?[ eqt ] y); remember (y ?[ eqt ] x); intuition. destruct b; destruct b0; auto. { symmetry in Heqb; symmetry in Heqb0. eapply (@rel_dec_correct _ _ _ rc) in Heqb. symmetry in Heqb. eapply (@rel_dec_correct _ _ _ rc) in Heqb. congruence. } { symmetry in Heqb; symmetry in Heqb0. eapply (@rel_dec_correct _ _ _ rc) in Heqb0. symmetry in Heqb0. eapply (@rel_dec_correct _ _ _ rc) in Heqb0. congruence. } Qed. End lemmas. Section RelDec_from_dec. Context {T} (R : T -> T -> Prop). Variable (f : forall a b : T, {R a b} + {~R a b}). Definition RelDec_from_dec : RelDec R := {| rel_dec := fun a b => match f a b with | left _ => true | right _ => false end |}. Global Instance RelDec_Correct_eq_typ : RelDec_Correct RelDec_from_dec. Proof. constructor. intros. unfold rel_dec; simpl. destruct (f x y). - tauto. - split. + inversion 1. + intro. apply n in H. tauto. Qed. End RelDec_from_dec. (* Section SumEq. Variable T : Type. Variable U : Type. Variable EDT : RelDec (@eq T). Variable EDU : RelDec (@eq U). (** Specialization for equality **) Global Instance RelDec_eq_sum : RelDec (@eq (T + U)) := { rel_dec := fun x y => match x , y with | inl x , inl y => eq_dec x y | inr x , inr y => eq_dec x y | _ , _ => false end }. Variable EDCT : RelDec_Correct EDT. Variable EDCU : RelDec_Correct EDU. Global Instance RelDec_Correct_eq_sum : RelDec_Correct RelDec_eq_sum. Proof. constructor; destruct x; destruct y; split; simpl in *; intros; try congruence; f_equal; try match goal with | [ H : context [ eq_dec ?X ?Y ] |- _ ] => consider (eq_dec X Y) | [ |- context [ eq_dec ?X ?Y ] ] => consider (eq_dec X Y) end; auto; congruence. Qed. End SumEq. *) coq-ext-lib-0.12.0/theories/Data/000077500000000000000000000000001451523051500164125ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Data/Bool.v000066400000000000000000000007261451523051500175010ustar00rootroot00000000000000Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. Global Instance RelDec_eq : RelDec (@eq bool) := { rel_dec := fun x y => match x , y with | true , true | false , false => true | _ , _=> false end }. Global Instance RelDec_Correct_eq_bool : RelDec_Correct RelDec_eq. constructor. destruct x; destruct y; auto; simpl; intuition. Qed.coq-ext-lib-0.12.0/theories/Data/Char.v000066400000000000000000000037111451523051500174600ustar00rootroot00000000000000Require Import Coq.Strings.Ascii. Require Import ExtLib.Data.Bool. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. Definition deprecated_ascii_dec (l r : Ascii.ascii) : bool := match l , r with | Ascii.Ascii l1 l2 l3 l4 l5 l6 l7 l8 , Ascii.Ascii r1 r2 r3 r4 r5 r6 r7 r8 => if Bool.eqb l1 r1 then if Bool.eqb l2 r2 then if Bool.eqb l3 r3 then if Bool.eqb l4 r4 then if Bool.eqb l5 r5 then if Bool.eqb l6 r6 then if Bool.eqb l7 r7 then if Bool.eqb l8 r8 then true else false else false else false else false else false else false else false else false end. #[deprecated(since="8.9",note="Use Ascii.eqb instead.")] Notation ascii_dec := deprecated_ascii_dec. Theorem deprecated_ascii_dec_sound : forall l r, ascii_dec l r = true <-> l = r. Proof. unfold ascii_dec. intros. destruct l; destruct r. repeat match goal with | [ |- (if ?X then _ else _) = true <-> _ ] => consider X; intros; subst end; split; congruence. Qed. #[deprecated(since="8.9",note="Use Ascii.eqb_eq instead.")] Notation ascii_dec_sound := deprecated_ascii_dec_sound. Global Instance RelDec_ascii : RelDec (@eq Ascii.ascii) := { rel_dec := Ascii.eqb }. Global Instance RelDec_Correct_ascii : RelDec_Correct RelDec_ascii. Proof. constructor; auto using Ascii.eqb_eq. Qed. Global Instance Reflect_ascii_dec a b : Reflect (Ascii.eqb a b) (a = b) (a <> b). Proof. apply iff_to_reflect; auto using Ascii.eqb_eq. Qed. Definition digit2ascii (n:nat) : Ascii.ascii := match n with | 0 => "0" | 1 => "1" | 2 => "2" | 3 => "3" | 4 => "4" | 5 => "5" | 6 => "6" | 7 => "7" | 8 => "8" | 9 => "9" | n => ascii_of_nat (n - 10 + nat_of_ascii "A") end%char. Definition chr_newline : ascii := Eval compute in ascii_of_nat 10. Export Ascii. coq-ext-lib-0.12.0/theories/Data/Checked.v000066400000000000000000000021721451523051500201310ustar00rootroot00000000000000Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. Section checked. Context {T : Type}. Variable F : T -> Type. Inductive Checked : option T -> Type := | Success : forall {v}, F v -> Checked (Some v) | Failure : Checked None. Definition succeeded (o : option T) (d : Checked o) : bool := match d with | Success _ _ => true | Failure => false end. Definition failed (o : option T) (d : Checked o) : bool := match d with | Success _ _ => false | Failure => true end. Definition asOption (o : option T) (d : Checked o) : option (match o with | None => False | Some x => F x end) := match d in Checked o return option match o with | None => False | Some x => F x end with | Success _ x => Some x | Failure => None end. End checked.coq-ext-lib-0.12.0/theories/Data/Eq.v000066400000000000000000000056061451523051500171550ustar00rootroot00000000000000(** This file gives some equational properties for manipulating matches. **) Set Implicit Arguments. Set Strict Implicit. (** For backwards compatibility with hint locality attributes. *) Set Warnings "-unsupported-attributes". Create HintDb eq_rw discriminated. Lemma eq_sym_eq : forall T (a b : T) (pf : a = b) (F : T -> Type) val, match eq_sym pf in _ = x return F x with | eq_refl => val end = match pf in _ = x return F x -> F a with | eq_refl => fun x => x end val. Proof. destruct pf. reflexivity. Defined. Lemma match_eq_sym_eq : forall T (a b : T) (pf : a = b) F X, match pf in _ = t return F t with | eq_refl => match eq_sym pf in _ = t return F t with | eq_refl => X end end = X. Proof. destruct pf. reflexivity. Defined. #[global] Hint Rewrite match_eq_sym_eq : eq_rw. Lemma match_eq_sym_eq' : forall T (a b : T) (pf : a = b) F X, match eq_sym pf in _ = t return F t with | eq_refl => match pf in _ = t return F t with | eq_refl => X end end = X. Proof. destruct pf. reflexivity. Defined. #[global] Hint Rewrite match_eq_sym_eq' : eq_rw. Lemma match_eq_match_eq : forall T F (a b : T) (pf : a = b) X Y, X = Y -> match pf in _ = T return F T with | eq_refl => X end = match pf in _ = T return F T with | eq_refl => Y end. Proof. intros. subst. auto. Defined. Lemma eq_sym_eq_trans : forall T (a b c : T) (pf : a = b) (pf' : b = c), eq_sym (eq_trans pf pf') = eq_trans (eq_sym pf') (eq_sym pf). Proof. clear. destruct pf. destruct pf'. reflexivity. Defined. (** Particular Instances **) Lemma eq_Const_eq : forall T (a b : T) (pf : a = b) (R : Type) val, match pf in _ = x return R with | eq_refl => val end = val. Proof. destruct pf. reflexivity. Defined. #[global] Hint Rewrite eq_Const_eq : eq_rw. Lemma eq_Arr_eq : forall T (a b : T) (pf : a = b) (F G : T -> Type) val x, match pf in _ = x return F x -> G x with | eq_refl => val end x = match pf in _ = x return G x with | eq_refl => val match eq_sym pf in _ = x return F x with | eq_refl => x end end. Proof. destruct pf. reflexivity. Defined. #[global] Hint Rewrite eq_Arr_eq : eq_rw. Lemma eq_sym_eq_sym : forall (T : Type) (a b : T) (pf : a = b), eq_sym (eq_sym pf) = pf. Proof. destruct pf. reflexivity. Defined. #[global] Hint Rewrite eq_sym_eq_sym : eq_rw. Ltac autorewrite_eq_rw := repeat progress (autorewrite with eq_rw; repeat match goal with | |- context [ match ?X in @eq _ _ _ return _ -> _ with | eq_refl => _ end ] => rewrite (eq_Arr_eq X) end). Require Export ExtLib.Data.Eq.UIP_trans. coq-ext-lib-0.12.0/theories/Data/Eq/000077500000000000000000000000001451523051500167575ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Data/Eq/UIP_trans.v000066400000000000000000000051011451523051500210070ustar00rootroot00000000000000(** The contents in this file are reconstructed from the proof of Bruno Barras in the Coq standard library. It is duplicated so that the definitions can be made transparent, and therefore computable. See Coq.Logic.Eqdep_dec for complete information **) Section uip_trans. Context {A : Type}. Definition uip_prop_trans (dec : forall x y : A, x = y \/ x <> y) {x : A} : forall {y : A} (pf pf' : x = y), pf = pf' := let comp := fun (x y y' : A) (eq1 : x = y) (eq2 : x = y') => eq_ind x (fun a : A => a = y') eq2 y eq1 in let eq_dec := dec x in let nu := fun (y : A) (u : x = y) => match eq_dec y with | or_introl eqxy => eqxy | or_intror neqxy => False_ind (x = y) (neqxy u) end in let nu_constant := fun (y : A) (u v : x = y) => let o := eq_dec y in match o as o0 return (match o0 with | or_introl eqxy => eqxy | or_intror neqxy => False_ind (x = y) (neqxy u) end = match o0 with | or_introl eqxy => eqxy | or_intror neqxy => False_ind (x = y) (neqxy v) end) with | or_introl Heq => eq_refl | or_intror Hneq => match Hneq u as f return (False_ind (x = y) f = False_ind (x = y) (Hneq v)) with end end in let nu_inv := fun (y : A) (v : x = y) => comp x x y (nu x eq_refl) v in let trans_sym_eq := fun (x y : A) (u : x = y) => match u as e in (_ = y0) return (comp x y0 y0 e e = eq_refl) with | eq_refl => eq_refl end in let nu_left_inv_on := fun (y : A) (u : x = y) => match u as e in (_ = y0) return (nu_inv y0 (nu y0 e) = e) with | eq_refl => trans_sym_eq _ _ (nu _ eq_refl) end in fun (y : A) (p1 p2 : x = y) => eq_ind (nu_inv y (nu y p1)) (fun p3 : x = y => p3 = p2) (eq_ind (nu_inv y (nu y p2)) (fun p3 : x = y => nu_inv y (nu y p1) = p3) (eq_ind (nu y p1) (fun e : x = y => nu_inv y (nu y p1) = nu_inv y e) eq_refl (nu y p2) (nu_constant y p1 p2)) p2 (nu_left_inv_on _ p2)) p1 (nu_left_inv_on _ p1). Definition uip_trans (dec : forall x y : A, {x = y} + {x <> y}) := @uip_prop_trans (fun a b => match dec a b with | left pf => or_introl pf | right pf' => or_intror pf' end). End uip_trans. coq-ext-lib-0.12.0/theories/Data/Fin.v000066400000000000000000000061101451523051500173130ustar00rootroot00000000000000(** Numbers up to @n@ **) Require Coq.Lists.List. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.EqDep. Require Import ExtLib.Tactics.Injection. Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. (** `fin n` corresponds to "naturals less than `n`", i.e. a finite set of size n **) Inductive fin : nat -> Type := | F0 : forall {n}, fin (S n) | FS : forall {n}, fin n -> fin (S n). Fixpoint fin_all (n : nat) : list (fin n) := match n as n return list (fin n) with | 0 => nil | S n => @F0 n :: List.map (@FS _) (fin_all n) end%list. Theorem fin_all_In : forall {n} (f : fin n), List.In f (fin_all n). Proof. induction n; intros. inversion f. remember (S n). destruct f. simpl; firstorder. inversion Heqn0. subst. simpl. right. apply List.in_map. auto. Qed. Theorem fin_case : forall n (f : fin (S n)), f = F0 \/ exists f', f = FS f'. Proof. intros. generalize (fin_all_In f). intros. destruct H; auto. eapply List.in_map_iff in H. right. destruct H. exists x. intuition. Qed. Definition fin0_elim (f : fin 0) : forall T, T := match f in fin n return match n with | 0 => forall T, T | _ => unit end with | F0 _ => tt | FS _ _ => tt end. Fixpoint pf_lt (n m : nat) : Prop := match n , m with | 0 , S _ => True | S n , S m => pf_lt n m | _ , _ => False end. Fixpoint make (m n : nat) {struct m} : pf_lt n m -> fin m := match n as n , m as m return pf_lt n m -> fin m with | 0 , 0 => @False_rect _ | 0 , S n => fun _ => F0 | S n , 0 => @False_rect _ | S n , S m => fun pf => FS (make m n pf) end. Notation "'##' n" := (@make _ n I) (at level 0). Global Instance Injective_FS {n : nat} (a b : fin n) : Injective (FS a = FS b). refine {| result := a = b |}. abstract (intro ; inversion H ; eapply inj_pair2 in H1 ; assumption). Defined. Fixpoint fin_eq_dec {n} (x : fin n) {struct x} : fin n -> bool := match x in fin n' return fin n' -> bool with | F0 _ => fun y => match y with | F0 _ => true | _ => false end | FS n' x' => fun y : fin (S n') => match y in fin n'' return (match n'' with | 0 => unit | S n'' => fin n'' end -> bool) -> bool with | F0 _ => fun _ => false | FS _ y' => fun f => f y' end (fun y => fin_eq_dec x' y) end. Global Instance RelDec_fin_eq (n : nat) : RelDec (@eq (fin n)) := { rel_dec := fin_eq_dec }. Global Instance RelDec_Correct_fin_eq (n : nat) : RelDec_Correct (RelDec_fin_eq n). Proof. constructor. induction x. simpl. intro. destruct (fin_case y) ; subst. intuition. destruct H ; subst. intuition ; try congruence. (* inversion H.*) intro ; destruct (fin_case y) ; subst ; simpl. intuition ; try congruence. inversion H. destruct H ; subst. split ; intro. f_equal ; eauto. eapply IHx. eapply H. inv_all ; subst. apply IHx. reflexivity. Qed. coq-ext-lib-0.12.0/theories/Data/Fun.v000066400000000000000000000026721451523051500173400ustar00rootroot00000000000000Require Import ExtLib.Data.PreFun. Require Import ExtLib.Structures.Functor. Require Import ExtLib.Structures.Applicative. Require Import ExtLib.Structures.CoFunctor. Require Import ExtLib.Structures.Monoid. Set Implicit Arguments. Set Strict Implicit. Section functors. Variable A : Type. Global Instance Functor_Fun : Functor (Fun A) := { fmap _A _B g f x := g (f x) }. Local Instance CoFunctor_Fun T : CoFunctor (fun x => x -> T) := {| cofmap := fun _ _ g f => fun x => f (g x) |}. Local Instance Functor_functor F G (fF : Functor F) (fG : Functor G) : Functor (fun x => F (G x)) := {| fmap := fun _ _ g => @fmap F _ _ _ (@fmap G _ _ _ g) |}. Local Instance CoFunctor_functor F G (fF : Functor F) (fG : CoFunctor G) : CoFunctor (fun x => F (G x)) := {| cofmap := fun _ _ g => @fmap F _ _ _ (@cofmap G _ _ _ g) |}. Local Instance Functor_cofunctor F G (fF : CoFunctor F) (fG : Functor G) : CoFunctor (fun x => F (G x)) := {| cofmap := fun _ _ g => @cofmap F _ _ _ (@fmap G _ _ _ g) |}. Local Instance CoFunctor_cofunctor F G (fF : CoFunctor F) (fG : CoFunctor G) : Functor (fun x => F (G x)) := {| fmap := fun _ _ g => @cofmap F _ _ _ (@cofmap G _ _ _ g) |}. Global Instance Applicative_Fun : Applicative (Fun A) := { pure := fun _ x _ => x ; ap := fun _ _ f x y => (f y) (x y) }. End functors. Definition Monoid_compose T : Monoid (T -> T) := {| monoid_plus g f x := g (f x) ; monoid_unit x := x |}. Export PreFun. coq-ext-lib-0.12.0/theories/Data/Graph/000077500000000000000000000000001451523051500174535ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Data/Graph/BuildGraph.v000066400000000000000000000025731451523051500216720ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Data.Monads.StateMonad. Set Implicit Arguments. Set Strict Implicit. Section Graph. Variable V : Type. Variable G : Type. Class BuildGraph : Type := { emptyGraph : G ; addVertex : V -> G -> G ; addEdge : V -> V -> G -> G }. End Graph. Arguments emptyGraph {_} {_} {_}. Arguments addVertex {_} {_} {_} _ _. Arguments addEdge {_} {_} {_} _ _ _. (** A State Monad simplifies things **) Section Monadic. Variable m : Type -> Type. Context {Monad_m : Monad m}. Variable V : Type. Variable G : Type. Variable BuildGraph_VG : BuildGraph V G. Definition GraphBuilderT (T : Type) : Type := stateT G m T. Global Instance Monad_GraphBuilder : Monad GraphBuilderT := Monad_stateT _ _. Global Instance MonadT_GraphBuilder : MonadT GraphBuilderT m := MonadT_stateT _ _. Instance State_GraphBuilder : MonadState G GraphBuilderT := MonadState_stateT _ _. Import MonadNotation. Local Open Scope monad_scope. Definition newEdge (f t : V) : GraphBuilderT unit := g <- get ;; put (addEdge f t g). Definition newVertex (v : V) : GraphBuilderT unit := g <- get ;; put (addVertex v g). Definition buildGraph {v} (c : GraphBuilderT v) (g : G) : m G := execStateT c g. End Monadic. Arguments newEdge {_} {_} {_} {_} {_} (_) (_). Arguments newVertex {_} {_} {_} {_} {_} (_).coq-ext-lib-0.12.0/theories/Data/Graph/Graph.v000066400000000000000000000004401451523051500207010ustar00rootroot00000000000000Set Implicit Arguments. Set Strict Implicit. Section Graph. Variable V : Type. Variable G : Type. Class Graph : Type := { verticies : G -> list V ; successors : G -> V -> list V }. End Graph. Arguments verticies {V} {G} {Graph} _. Arguments successors {V} {G} {Graph} _ _.coq-ext-lib-0.12.0/theories/Data/Graph/GraphAdjList.v000066400000000000000000000035301451523051500221570ustar00rootroot00000000000000Require Import ExtLib.Core.RelDec. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Monoid. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Structures.Maps. Require Import ExtLib.Data.List. Require Import ExtLib.Data.PPair. Require Import ExtLib.Data.Monads.WriterMonad. Require Import ExtLib.Data.Monads.IdentityMonad. Require Import ExtLib.Data.Graph.Graph. Require Import ExtLib.Data.Graph.BuildGraph. Set Implicit Arguments. Set Strict Implicit. Section GraphImpl. Variable V : Type. Variable map : Type. Variable Map : Map V (list V) map. Variable FMap : Foldable map (V * (list V)). Variable RelDec_V : RelDec (@eq V). Definition adj_graph : Type := map. Definition verts (g : adj_graph) : list V := let c := foldM (m := writerT (Monoid_list_app) ident) (fun k_v _ => let k := fst k_v in tell (k :: nil)) (ret tt) g in psnd (unIdent (runWriterT c)). Definition succs (g : adj_graph) (v : V) : list V := match lookup v g with | None => nil | Some vs => vs end. Global Instance Graph_adj_graph : Graph V adj_graph := { verticies := verts ; successors := succs }. Definition add_vertex (v : V) (g : adj_graph) : adj_graph := if contains v g then g else add v nil g. (** TODO: Move this **) Fixpoint list_in_dec v (ls : list V) : bool := match ls with | nil => false | l :: ls => if eq_dec l v then true else list_in_dec v ls end. Definition add_edge (f t : V) (g : adj_graph) : adj_graph := match lookup f g with | None => add f (t :: nil) g | Some vs => if list_in_dec t vs then g else add f (t :: vs) g end. Global Instance GraphBuilder_adj_graph : BuildGraph V adj_graph := { emptyGraph := empty ; addVertex := add_vertex ; addEdge := add_edge }. End GraphImpl. coq-ext-lib-0.12.0/theories/Data/Graph/GraphAlgos.v000066400000000000000000000031361451523051500216740ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.PArith.BinPos. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Data.Graph.Graph. Require Import ExtLib.Data.Monads.FuelMonad. Require Import ExtLib.Data.Monads.IdentityMonad. Require Import ExtLib.Data.List. Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. Section GraphAlgos. Variable V : Type. Variable RelDec_V : RelDec (@eq V). Variable G : Type. Context {graph : Graph V G}. Section Traverse. Variable g : G. Fixpoint list_in_dec v (ls : list V) : bool := match ls with | nil => false | l :: ls => if eq_dec l v then true else list_in_dec v ls end. Section monadic. Variable m : Type -> Type. Context {Monad_m : Monad m} {MonadFix_m : MonadFix m}. Definition dfs' : V -> list V -> m (list V) := mfix_multi (V :: list V :: nil) (list V) (fun rec from seen => if list_in_dec from seen then ret (m:=m) seen else foldM (fun v acc => if list_in_dec v acc then ret (m:=m) acc else rec v acc) (ret (m:=m) seen) (successors g from)). End monadic. Definition dfs (from : V) : list V := let count := Npos (List.fold_left (fun acc _ => Pos.succ acc) (verticies g) 1%positive) in let res := runGFix (dfs' from nil) count in match res with | Diverge => (** This should never happen! **) verticies g | Term v => v end. End Traverse. End GraphAlgos.coq-ext-lib-0.12.0/theories/Data/HList.v000066400000000000000000000761271451523051500176410ustar00rootroot00000000000000Require Import Coq.Lists.List Coq.Arith.PeanoNat. Require Import Relations RelationClasses. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Data.SigT. Require Import ExtLib.Data.Member. Require Import ExtLib.Data.ListNth. Require Import ExtLib.Data.Option. Require Import ExtLib.Tactics. Require Import Coq.Classes.Morphisms. Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. Set Universe Polymorphism. Set Printing Universes. Lemma app_ass_trans@{X} : forall {T : Type@{X} } (a b c : list T), (a ++ b) ++ c = a ++ b ++ c. Proof. induction a; simpl. reflexivity. intros. destruct (IHa b c). reflexivity. Defined. Lemma app_nil_r_trans : forall {T : Type} (a : list T), a ++ nil = a. Proof. induction a; simpl. reflexivity. refine match IHa in _ = X return _ = _ :: X with | eq_refl => eq_refl end. Defined. Monomorphic Universe hlist_large. (** Core Type and Functions **) Section hlist. Polymorphic Universe Ui Uv. Context {iT : Type@{Ui}}. Variable F : iT -> Type@{Uv}. Inductive hlist : list iT -> Type := | Hnil : hlist nil | Hcons : forall l ls, F l -> hlist ls -> hlist (l :: ls). Definition hlist_hd {a b} (hl : hlist (a :: b)) : F a := match hl in hlist x return match x return Type@{Uv} with | nil => unit | l :: _ => F l end with | Hnil => tt | Hcons _ _ x _ => x end. Definition hlist_tl {a b} (hl : hlist (a :: b)) : hlist b := match hl in hlist x return match x return Type@{hlist_large} with | nil => unit | _ :: ls => hlist ls end with | Hnil => tt | Hcons _ _ _ x => x end. Lemma hlist_eta : forall ls (h : hlist ls), h = match ls as ls return hlist ls -> hlist ls with | nil => fun _ => Hnil | a :: b => fun h => Hcons (hlist_hd h) (hlist_tl h) end h. Proof. intros. destruct h; auto. Qed. Fixpoint hlist_app ll lr (h : hlist ll) : hlist lr -> hlist (ll ++ lr) := match h in hlist ll return hlist lr -> hlist (ll ++ lr) with | Hnil => fun x => x | Hcons _ _ hd tl => fun r => Hcons hd (hlist_app tl r) end. Lemma hlist_app_nil_r : forall ls (h : hlist ls), hlist_app h Hnil = match eq_sym (app_nil_r_trans ls) in _ = t return hlist t with | eq_refl => h end. Proof. induction h; simpl; intros; auto. rewrite IHh at 1. unfold eq_trans. unfold f_equal. unfold eq_sym. clear. revert h. generalize dependent (app_nil_r_trans ls). destruct e. reflexivity. Qed. Fixpoint hlist_rev' ls ls' (h : hlist ls) : hlist ls' -> hlist (rev ls ++ ls') := match h in hlist ls return hlist ls' -> hlist (rev ls ++ ls') with | Hnil => fun h => h | Hcons l ls0 x h' => fun hacc => match app_ass_trans (rev ls0) (l :: nil) ls' in _ = t return hlist t -> hlist _ with | eq_refl => fun x => x end (@hlist_rev' _ (l :: ls') h' (Hcons x hacc)) end. Definition hlist_rev ls (h : hlist ls) : hlist (rev ls) := match app_nil_r_trans (rev ls) in _ = t return hlist t with | eq_refl => hlist_rev' h Hnil end. Lemma hlist_rev_nil : hlist_rev Hnil = Hnil. Proof. reflexivity. Qed. (** TODO: I need hlist_rev_cons **) (** Equivalence **) (** TODO: This should change to relations **) Section equiv. Variable eqv : forall x, relation (F x). Inductive equiv_hlist : forall ls, hlist ls -> hlist ls -> Prop := | hlist_eqv_nil : equiv_hlist Hnil Hnil | hlist_eqv_cons : forall l ls x y h1 h2, eqv x y -> equiv_hlist h1 h2 -> @equiv_hlist (l :: ls) (Hcons x h1) (Hcons y h2). Global Instance Reflexive_equiv_hlist (R : forall t, Reflexive (@eqv t)) ls : Reflexive (@equiv_hlist ls). Proof. red. induction x; constructor; auto. reflexivity. Qed. Global Instance Symmetric_equiv_hlist (R : forall t, Symmetric (@eqv t)) ls : Symmetric (@equiv_hlist ls). Proof. red. induction 1. { constructor. } { constructor. symmetry. assumption. auto. } Qed. Global Instance Transitive_equiv_hlist (R : forall t, Transitive (@eqv t)) ls : Transitive (@equiv_hlist ls). Proof. red. induction 1. { intro; assumption. } { rewrite (hlist_eta z). refine (fun H' => match H' in @equiv_hlist ls X Y return match ls as ls return hlist ls -> hlist ls -> Prop with | nil => fun _ _ : hlist nil => True | l :: ls => fun (X Y : hlist (l :: ls)) => forall Z x xs, eqv (hlist_hd Z) (hlist_hd X) -> equiv_hlist xs (hlist_tl X) -> (forall z : hlist ls, equiv_hlist (hlist_tl X) z -> equiv_hlist (hlist_tl Z) z) -> @equiv_hlist (l :: ls) Z Y end X Y with | hlist_eqv_nil => I | hlist_eqv_cons l ls x y h1 h2 pf pf' => _ end (Hcons x h1) x _ H H0 (@IHequiv_hlist)). intros. rewrite (hlist_eta Z). constructor. simpl in *. etransitivity. eassumption. eassumption. eapply H3. simpl in *. eassumption. } Qed. Lemma equiv_hlist_Hcons : forall ls i a b (c : hlist ls) d, equiv_hlist (Hcons a c) (@Hcons i ls b d) -> (@eqv i a b /\ equiv_hlist c d). Proof. clear. intros. refine match H in @equiv_hlist ls' l r return match ls' as ls' return hlist ls' -> hlist ls' -> _ with | nil => fun _ _ => True | l :: ls => fun l r => eqv (hlist_hd l) (hlist_hd r) /\ equiv_hlist (hlist_tl l) (hlist_tl r) end l r with | hlist_eqv_nil => I | hlist_eqv_cons _ _ _ _ _ _ pf pf' => conj pf pf' end. Defined. Lemma equiv_hlist_app : forall a b (c c' : hlist a) (d d' : hlist b), (equiv_hlist c c' /\ equiv_hlist d d') <-> equiv_hlist (hlist_app c d) (hlist_app c' d'). Proof. clear. split. - destruct 1. induction H. + assumption. + simpl. constructor; auto. - induction c. + rewrite (hlist_eta c'). simpl; intros; split; auto. constructor. + rewrite (hlist_eta c'); simpl. specialize (IHc (hlist_tl c')). intro. eapply equiv_hlist_Hcons in H. intuition. constructor; auto. Qed. Global Instance Injection_equiv_hlist_cons ls i a b (c : hlist ls) d : Injective (equiv_hlist (Hcons a c) (@Hcons i ls b d)) := { result := @eqv i a b /\ equiv_hlist c d ; injection := @equiv_hlist_Hcons _ _ _ _ _ _ }. Global Instance Injection_equiv_hlist_app a b (c c' : hlist a) (d d' : hlist b) : Injective (equiv_hlist (hlist_app c d) (hlist_app c' d')) := { result := equiv_hlist c c' /\ equiv_hlist d d' ; injection := fun x => proj2 (@equiv_hlist_app _ _ _ _ _ _) x }. End equiv. Lemma hlist_nil_eta : forall (h : hlist nil), h = Hnil. Proof. intros; rewrite (hlist_eta h); reflexivity. Qed. Lemma hlist_cons_eta : forall a b (h : hlist (a :: b)), h = Hcons (hlist_hd h) (hlist_tl h). Proof. intros; rewrite (hlist_eta h); reflexivity. Qed. Lemma Hcons_inv : forall l ls a b c d, @eq (hlist (l :: ls)) (Hcons a b) (Hcons c d) -> a = c /\ b = d. Proof. intros. refine ( match H as K in _ = Z return match Z in hlist LS return match LS with | nil => Prop | l :: ls => F l -> hlist ls -> Prop end with | Hcons X Y x y => fun a b => a = x /\ b = y | Hnil => True end a b with | eq_refl => conj eq_refl eq_refl end). Qed. Global Instance Injection_hlist_cons ls t (a : F t) (b : hlist ls) c d : Injective (Hcons a b = Hcons c d) := { result := a = c /\ b = d ; injection := @Hcons_inv t ls a b c d }. Theorem equiv_eq_eq : forall ls (x y : hlist ls), equiv_hlist (fun x => @eq _) x y <-> x = y. Proof. induction x; simpl; intros. { split. inversion 1. rewrite hlist_nil_eta. reflexivity. intros; subst; constructor. } { split. { intro. rewrite (hlist_eta y). specialize (IHx (hlist_tl y)). refine (match H in @equiv_hlist _ LS X Y return match X in hlist LS return F match LS with | nil => l | l :: _ => l end -> hlist match LS with | nil => ls | _ :: ls => ls end -> Prop with | Hnil => fun _ _ => True | Hcons a b c d => fun x y => (equiv_hlist (fun x0 : iT => eq) d y <-> d = y) -> @Hcons a b c d = Hcons x y end (match LS as LS return hlist LS -> F match LS with | nil => l | l :: _ => l end with | nil => fun _ => f | l :: ls => hlist_hd end Y) (match LS as LS return hlist LS -> hlist match LS with | nil => ls | _ :: ls => ls end with | nil => fun _ => x | l :: ls => hlist_tl end Y) with | hlist_eqv_nil => I | hlist_eqv_cons l ls x y h1 h2 pf1 pf2 => _ end IHx). simpl. subst. intros. f_equal. apply H0. assumption. } { intros; subst. constructor; auto. reflexivity. } } Qed. Fixpoint hlist_get ls a (m : member a ls) : hlist ls -> F a := match m in member _ ls return hlist ls -> F a with | MZ _ => hlist_hd | MN _ _ r => fun hl => hlist_get r (hlist_tl hl) end. Fixpoint hlist_nth_error {ls} (hs : hlist ls) (n : nat) : option (match nth_error ls n with | None => unit | Some x => F x end) := match hs in hlist ls return option (match nth_error ls n with | None => unit | Some x => F x end) with | Hnil => None | Hcons l ls h hs => match n as n return option (match nth_error (l :: ls) n with | None => unit | Some x => F x end) with | 0 => Some h | S n => hlist_nth_error hs n end end. Polymorphic Fixpoint hlist_nth ls (h : hlist ls) (n : nat) : match nth_error ls n return Type with | None => unit | Some t => F t end := match h in hlist ls , n as n return match nth_error ls n with | None => unit | Some t => F t end with | Hnil , 0 => tt | Hnil , S _ => tt | Hcons _ _ x _ , 0 => x | Hcons _ _ _ h , S n => hlist_nth h n end. Fixpoint nth_error_hlist_nth ls (n : nat) : option (hlist ls -> match nth_error ls n with | None => Empty_set | Some x => F x end) := match ls as ls return option (hlist ls -> match nth_error ls n with | None => Empty_set | Some x => F x end) with | nil => None | l :: ls => match n as n return option (hlist (l :: ls) -> match nth_error (l :: ls) n with | None => Empty_set | Some x => F x end) with | 0 => Some hlist_hd | S n => match nth_error_hlist_nth ls n with | None => None | Some f => Some (fun h => f (hlist_tl h)) end end end. Definition cast1 T l : forall (l' : list T) n v, nth_error l n = Some v -> Some v = nth_error (l ++ l') n. Proof. induction l. intros. { exfalso. destruct n; inversion H. } { destruct n; simpl; intros; auto. } Defined. Definition cast2 T l : forall (l' : list T) n, nth_error l n = None -> nth_error l' (n - length l) = nth_error (l ++ l') n. Proof. induction l; simpl. { destruct n; simpl; auto. } { destruct n; simpl; auto. inversion 1. } Defined. Theorem hlist_nth_hlist_app : forall l l' (h : hlist l) (h' : hlist l') n, hlist_nth (hlist_app h h') n = match nth_error l n as k return nth_error l n = k -> match nth_error (l ++ l') n return Type with | None => unit | Some t => F t end with | Some _ => fun pf => match cast1 _ _ _ pf in _ = z , eq_sym pf in _ = w return match w return Type with | None => unit | Some t => F t end -> match z return Type with | None => unit | Some t => F t end with | eq_refl , eq_refl => fun x => x end (hlist_nth h n) | None => fun pf => match cast2 _ _ _ pf in _ = z return match z with | Some t => F t | None => unit end with | eq_refl => hlist_nth h' (n - length l) end end eq_refl. Proof. induction h; simpl; intros. { destruct n; simpl in *; reflexivity. } { destruct n; simpl. { reflexivity. } { rewrite IHh. reflexivity. } } Qed. Section type. Lemma hlist_app_assoc : forall ls ls' ls'' (a : hlist ls) (b : hlist ls') (c : hlist ls''), hlist_app (hlist_app a b) c = match eq_sym (app_ass_trans ls ls' ls'') in _ = t return hlist t with | eq_refl => hlist_app a (hlist_app b c) end. Proof. intros ls ls' ls''. generalize (eq_sym (app_assoc_reverse ls ls' ls'')). induction ls; simpl; intros. { rewrite (hlist_eta a); simpl. reflexivity. } { rewrite (hlist_eta a0). simpl. inversion H. erewrite (IHls H1). unfold f_equal. unfold eq_trans. unfold eq_sym. generalize (app_ass_trans ls ls' ls''). rewrite <- H1. clear. intro. generalize dependent (hlist_app (hlist_tl a0) (hlist_app b c)). destruct e. reflexivity. } Qed. Lemma hlist_app_assoc' : forall (ls ls' ls'' : list iT) (a : hlist ls) (b : hlist ls') (c : hlist ls''), hlist_app a (hlist_app b c) = match app_ass_trans ls ls' ls'' in (_ = t) return (hlist t) with | eq_refl => hlist_app (hlist_app a b) c end. Proof. clear. intros. generalize (hlist_app_assoc a b c). generalize (hlist_app (hlist_app a b) c). generalize (hlist_app a (hlist_app b c)). destruct (app_ass_trans ls ls' ls''). simpl. auto. Qed. Fixpoint hlist_split ls ls' : hlist (ls ++ ls') -> hlist ls * hlist ls' := match ls as ls return hlist (ls ++ ls') -> hlist ls * hlist ls' with | nil => fun h => (Hnil, h) | l :: ls => fun h => let (a,b) := @hlist_split ls ls' (hlist_tl h) in (Hcons (hlist_hd h) a, b) end. Lemma hlist_app_hlist_split : forall ls' ls (h : hlist (ls ++ ls')), hlist_app (fst (hlist_split ls ls' h)) (snd (hlist_split ls ls' h)) = h. Proof. induction ls; simpl; intros; auto. rewrite (hlist_eta h); simpl. specialize (IHls (hlist_tl h)). destruct (hlist_split ls ls' (hlist_tl h)); simpl in *; auto. f_equal. auto. Qed. Lemma hlist_split_hlist_app : forall ls' ls (h : hlist ls) (h' : hlist ls'), hlist_split _ _ (hlist_app h h') = (h,h'). Proof. induction ls; simpl; intros. { rewrite (hlist_eta h); simpl; auto. } { rewrite (hlist_eta h); simpl. rewrite IHls. reflexivity. } Qed. End type. Lemma hlist_hd_fst_hlist_split : forall t (xs ys : list _) (h : hlist (t :: xs ++ ys)), hlist_hd (fst (hlist_split (t :: xs) ys h)) = hlist_hd h. Proof. simpl. intros. match goal with | |- context [ match ?X with _ => _ end ] => destruct X end. reflexivity. Qed. Lemma hlist_tl_fst_hlist_split : forall t (xs ys : list _) (h : hlist (t :: xs ++ ys)), hlist_tl (fst (hlist_split (t :: xs) ys h)) = fst (hlist_split xs ys (hlist_tl h)). Proof. simpl. intros. match goal with | |- context [ match ?X with _ => _ end ] => remember X end. destruct p. simpl. change h0 with (fst (h0, h1)). f_equal; trivial. Qed. Lemma hlist_tl_snd_hlist_split : forall t (xs ys : list _) (h : hlist (t :: xs ++ ys)), snd (hlist_split xs ys (hlist_tl h)) = snd (hlist_split (t :: xs) ys h). Proof. simpl. intros. match goal with | |- context [ match ?X with _ => _ end ] => remember X end. destruct p. simpl. change h1 with (snd (h0, h1)). rewrite Heqp. reflexivity. Qed. Polymorphic Fixpoint nth_error_get_hlist_nth (ls : list iT) (n : nat) {struct ls} : option {t : iT & hlist ls -> F t} := match ls as ls0 return option {t : iT & hlist ls0 -> F t} with | nil => None | l :: ls0 => match n as n0 return option {t : iT & hlist (l :: ls0) -> F t} with | 0 => Some (@existT _ (fun t => hlist (l :: ls0) -> F t) l (@hlist_hd _ _)) | S n0 => match nth_error_get_hlist_nth ls0 n0 with | Some (existT x f) => Some (@existT _ (fun t => hlist _ -> F t) x (fun h : hlist (l :: ls0) => f (hlist_tl h))) | None => None end end end. Theorem nth_error_get_hlist_nth_Some : forall ls n s, nth_error_get_hlist_nth ls n = Some s -> exists pf : nth_error ls n = Some (projT1 s), forall h, projT2 s h = match pf in _ = t return match t return Type with | Some t => F t | None => unit end with | eq_refl => hlist_nth h n end. Proof. induction ls; simpl; intros; try congruence. { destruct n. { inv_all; subst; simpl. exists (eq_refl). intros. rewrite (hlist_eta h). reflexivity. } { forward. inv_all; subst. destruct (IHls _ _ H0); clear IHls. simpl in *. exists x0. intros. rewrite (hlist_eta h). simpl. auto. } } Qed. Theorem nth_error_get_hlist_nth_None : forall ls n, nth_error_get_hlist_nth ls n = None <-> nth_error ls n = None. Proof. induction ls; simpl; intros; try congruence. { destruct n; intuition. } { destruct n; simpl; try solve [ intuition congruence ]. specialize (IHls n). forward. } Qed. Lemma nth_error_get_hlist_nth_weaken : forall ls ls' n x, nth_error_get_hlist_nth ls n = Some x -> exists z, nth_error_get_hlist_nth (ls ++ ls') n = Some (@existT iT (fun t => hlist (ls ++ ls') -> F t) (projT1 x) z) /\ forall h h', projT2 x h = z (hlist_app h h'). Proof. intros ls ls'. revert ls. induction ls; simpl; intros; try congruence. { destruct n; inv_all; subst. { simpl. eexists; split; eauto. intros. rewrite (hlist_eta h). reflexivity. } { forward. inv_all; subst. simpl. apply IHls in H0. forward_reason. rewrite H. eexists; split; eauto. intros. rewrite (hlist_eta h). simpl in *. auto. } } Qed. Lemma nth_error_get_hlist_nth_appL : forall tvs' tvs n, n < length tvs -> exists x, nth_error_get_hlist_nth (tvs ++ tvs') n = Some x /\ exists y, nth_error_get_hlist_nth tvs n = Some (@existT _ _ (projT1 x) y) /\ forall vs vs', (projT2 x) (hlist_app vs vs') = y vs. Proof. clear. induction tvs; simpl; intros. { exfalso; inversion H. } { destruct n. { clear H IHtvs. eexists; split; eauto. eexists; split; eauto. simpl. intros. rewrite (hlist_eta vs). reflexivity. } { apply Nat.succ_lt_mono in H. { specialize (IHtvs _ H). forward_reason. rewrite H0. rewrite H1. forward. subst. simpl in *. eexists; split; eauto. eexists; split; eauto. simpl. intros. rewrite (hlist_eta vs). simpl. auto. } } } Qed. Lemma nth_error_get_hlist_nth_appR : forall tvs' tvs n x, n >= length tvs -> nth_error_get_hlist_nth (tvs ++ tvs') n = Some x -> exists y, nth_error_get_hlist_nth tvs' (n - length tvs) = Some (@existT _ _ (projT1 x) y) /\ forall vs vs', (projT2 x) (hlist_app vs vs') = y vs'. Proof. clear. induction tvs; simpl; intros. { rewrite PeanoNat.Nat.sub_0_r. rewrite H0. destruct x. simpl. eexists; split; eauto. intros. rewrite (hlist_eta vs). reflexivity. } { destruct n. { inversion H. } { assert (n >= length tvs) by (eapply le_S_n; eassumption). clear H. { forward. inv_all; subst. simpl in *. specialize (IHtvs _ _ H1 H0). simpl in *. forward_reason. rewrite H. eexists; split; eauto. intros. rewrite (hlist_eta vs). simpl. auto. } } } Qed. End hlist. Arguments Hnil {_ _}. Arguments Hcons {_ _ _ _} _ _. Arguments equiv_hlist {_ F} R {_} _ _ : rename. (** Weak Map This is weak because it does not change the key type **) Section hlist_map. Variable A : Type. Variables F G : A -> Type. Variable ff : forall x, F x -> G x. Fixpoint hlist_map (ls : list A) (hl : hlist F ls) {struct hl} : hlist G ls := match hl in @hlist _ _ ls return hlist G ls with | Hnil => Hnil | Hcons _ _ hd tl => Hcons (ff hd) (hlist_map tl) end. Theorem hlist_app_hlist_map : forall ls ls' (a : hlist F ls) (b : hlist F ls'), hlist_map (hlist_app a b) = hlist_app (hlist_map a) (hlist_map b). Proof. induction a. simpl; auto. simpl. intros. f_equal. auto. Qed. End hlist_map. Arguments hlist_map {_ _ _} _ {_} _. Section hlist_map_rules. Variable A : Type. Variables F G G' : A -> Type. Variable ff : forall x, F x -> G x. Variable gg : forall x, G x -> G' x. Theorem hlist_map_hlist_map : forall ls (hl : hlist F ls), hlist_map gg (hlist_map ff hl) = hlist_map (fun _ x => gg (ff x)) hl. Proof. induction hl; simpl; f_equal. assumption. Defined. Theorem hlist_get_hlist_map : forall ls t (hl : hlist F ls) (m : member t ls), hlist_get m (hlist_map ff hl) = ff (hlist_get m hl). Proof. induction m; simpl. { rewrite (hlist_eta hl). reflexivity. } { rewrite (hlist_eta hl). simpl. auto. } Defined. Lemma hlist_map_ext : forall (ff gg : forall x, F x -> G x), (forall x t, ff x t = gg x t) -> forall ls (hl : hlist F ls), hlist_map ff hl = hlist_map gg hl. Proof. induction hl; simpl; auto. intros. f_equal; auto. Defined. End hlist_map_rules. Lemma equiv_hlist_map : forall T U (F : T -> Type) (R : forall t, F t -> F t -> Prop) (R' : forall t, U t -> U t -> Prop) (f g : forall t, F t -> U t), (forall t (x y : F t), R t x y -> R' t (f t x) (g t y)) -> forall ls (a b : hlist F ls), equiv_hlist R a b -> equiv_hlist R' (hlist_map f a) (hlist_map g b). Proof. clear. induction 2; simpl; intros. - constructor. - constructor; eauto. Qed. (** Linking Heterogeneous Lists and Lists **) Section hlist_gen. Variable A : Type. Variable F : A -> Type. Variable f : forall a, F a. Fixpoint hlist_gen ls : hlist F ls := match ls with | nil => Hnil | cons x ls' => Hcons (f x) (hlist_gen ls') end. Lemma hlist_get_hlist_gen : forall ls t (m : member t ls), hlist_get m (hlist_gen ls) = f t. Proof. induction m; simpl; auto. Qed. (** This function is a generalisation of [hlist_gen] in which the function [f] takes the additional parameter [member a ls]. **) Fixpoint hlist_gen_member ls : (forall a, member a ls -> F a) -> hlist F ls := match ls as ls return ((forall a : A, member a ls -> F a) -> hlist F ls) with | nil => fun _ => Hnil | a :: ls' => fun fm => Hcons (fm a (MZ a ls')) (hlist_gen_member (fun a' (M : member a' ls') => fm a' (MN a M))) end. Lemma hlist_gen_member_hlist_gen : forall ls, hlist_gen_member (fun a _ => f a) = hlist_gen ls. Proof. induction ls; simpl; f_equal; auto. Qed. Lemma hlist_gen_member_ext : forall ls (f g : forall a, member a ls -> F a), (forall x M, f x M = g x M) -> hlist_gen_member f = hlist_gen_member g. Proof. intros. induction ls; simpl; f_equal; auto. Qed. End hlist_gen. Arguments hlist_gen {A F} f ls. Lemma hlist_gen_member_hlist_map : forall A (F G : A -> Type) (ff : forall t, F t -> G t) ls f, hlist_map ff (hlist_gen_member F (ls := ls) f) = hlist_gen_member G (fun a M => ff _ (f _ M)). Proof. intros. induction ls; simpl; f_equal; auto. Qed. Lemma hlist_gen_hlist_map : forall A (F G : A -> Type) (ff : forall t, F t -> G t) f ls, hlist_map ff (hlist_gen f ls) = hlist_gen (fun a => ff _ (f a)) ls. Proof. intros. do 2 rewrite <- hlist_gen_member_hlist_gen. apply hlist_gen_member_hlist_map. Qed. Lemma hlist_gen_ext : forall A F (f g : forall a, F a), (forall x, f x = g x) -> forall ls : list A, hlist_gen f ls = hlist_gen g ls. Proof. intros. do 2 rewrite <- hlist_gen_member_hlist_gen. apply hlist_gen_member_ext. auto. Qed. Global Instance Proper_hlist_gen : forall A F, Proper (forall_relation (fun _ => eq) ==> forall_relation (fun _ => eq)) (@hlist_gen A F). Proof. repeat intro. apply hlist_gen_ext. auto. Qed. Lemma equiv_hlist_gen : forall T (F : T -> Type) (f : forall t, F t) f' (R : forall t, F t -> F t -> Prop), (forall t, R t (f t) (f' t)) -> forall ls, equiv_hlist R (hlist_gen f ls) (hlist_gen f' ls). Proof. induction ls; simpl; constructor; auto. Qed. Global Instance Proper_equiv_hlist_gen : forall A (F : A -> Type) R, Proper (forall_relation R ==> forall_relation (@equiv_hlist _ _ R)) (@hlist_gen A F). Proof. repeat intro. apply equiv_hlist_gen. auto. Qed. Fixpoint hlist_erase {A B} {ls : list A} (hs : hlist (fun _ => B) ls) : list B := match hs with | Hnil => nil | Hcons _ _ x hs' => cons x (hlist_erase hs') end. Lemma hlist_erase_hlist_gen : forall A B ls (f : A -> B), hlist_erase (hlist_gen f ls) = map f ls. Proof. induction ls; simpl; intros; f_equal; auto. Qed. (** Linking Heterogeneous Lists and Predicates **) Section hlist_Forall. Variable A : Type. Variable P : A -> Prop. Fixpoint hlist_Forall ls (hs : hlist P ls) : Forall P ls := match hs with | Hnil => Forall_nil _ | Hcons _ _ H hs' => Forall_cons _ H (hlist_Forall hs') end. End hlist_Forall. (** Heterogeneous Relations **) Section hlist_rel. Variable A : Type. Variables F G : A -> Type. Variable R : forall x : A, F x -> G x -> Prop. Inductive hlist_hrel : forall ls, hlist F ls -> hlist G ls -> Prop := | hrel_Hnil : hlist_hrel Hnil Hnil | hrel_Hcons : forall t ts x y xs ys, @R t x y -> @hlist_hrel ts xs ys -> @hlist_hrel (t :: ts) (Hcons x xs) (Hcons y ys). End hlist_rel. Section hlist_rel_map. Variable A : Type. Variables F G F' G' : A -> Type. Variable R : forall x : A, F x -> G x -> Prop. Variable R' : forall x : A, F' x -> G' x -> Prop. Variable ff : forall x : A, F x -> F' x. Variable gg : forall x : A, G x -> G' x. Hypothesis R_ff_R' : forall t x y, @R t x y -> @R' t (ff x) (gg y). Theorem hlist_hrel_map : forall ls xs ys, @hlist_hrel A F G R ls xs ys -> @hlist_hrel A F' G' R' ls (hlist_map ff xs) (hlist_map gg ys). Proof. induction 1; simpl; constructor; eauto. Qed. Theorem hlist_hrel_cons : forall l ls x xs y ys, @hlist_hrel A F G R (l :: ls) (Hcons x xs) (Hcons y ys) -> @R l x y /\ @hlist_hrel A F G R ls xs ys. Proof. intros. refine match H in @hlist_hrel _ _ _ _ ls' xs' ys' return match ls' as ls' return hlist F ls' -> hlist G ls' -> Prop with | nil => fun _ _ => True | l' :: ls' => fun x y => R (hlist_hd x) (hlist_hd y) /\ hlist_hrel R (hlist_tl x) (hlist_tl y) end xs' ys' with | hrel_Hnil => I | hrel_Hcons _ _ _ _ _ _ pf pf' => conj pf pf' end. Qed. Theorem hlist_hrel_app : forall l ls x xs y ys, @hlist_hrel A F G R (l ++ ls) (hlist_app x xs) (hlist_app y ys) -> @hlist_hrel A F G R l x y /\ @hlist_hrel A F G R ls xs ys. Proof. induction x. + intros xs y ys. rewrite (hlist_eta y). simpl; intros; split; auto. constructor. + intros xs y ys. rewrite (hlist_eta y). intros. eapply hlist_hrel_cons in H. destruct H. apply IHx in H0. intuition. constructor; auto. Qed. End hlist_rel_map. Theorem hlist_hrel_equiv : forall T (F : T -> Type) (R : forall t, F t -> F t -> Prop) ls (h h' : hlist F ls), hlist_hrel R h h' -> equiv_hlist R h h'. Proof. induction 1; constructor; auto. Qed. Theorem hlist_hrel_flip : forall T (F G : T -> Type) (R : forall t, F t -> G t -> Prop) ls (h : hlist F ls) (h' : hlist G ls), hlist_hrel R h h' -> hlist_hrel (fun t a b => R t b a) h' h. Proof. induction 1; constructor; auto. Qed. coq-ext-lib-0.12.0/theories/Data/Lazy.v000066400000000000000000000014521451523051500175220ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.CoMonad. Require Import ExtLib.Structures.Functor. Set Implicit Arguments. Set Strict Implicit. Definition Lazy (t : Type) : Type := unit -> t. (** Note: in order for this to have the right behavior, it must be beta-delta reduced. **) Definition _lazy {T : Type} (l : T) : Lazy T := fun _ => l. Definition force {T : Type} (l : Lazy T) : T := l tt. Global Instance CoMonad_Lazy : CoMonad Lazy := { extract := @force ; extend _A _B b a := fun x : unit => b a }. Global Instance Functor_Lazy : Functor Lazy := { fmap _A _B f l := fun x => f (l x) }. Global Instance Monad_Lazy : Monad Lazy := { ret := @_lazy ; bind _A _B a b := fun x => b (a x) x }. Notation "'lazy' x" := (fun _ : unit => x) (x at next level, at level 50). coq-ext-lib-0.12.0/theories/Data/LazyList.v000066400000000000000000000005031451523051500203520ustar00rootroot00000000000000 Section lazy_list. Variable T : Type. Inductive llist : Type := | lnil : llist | lcons : T -> (unit -> llist) -> llist. Fixpoint force (l : llist) : list T := match l with | lnil => nil | lcons a b => cons a (force (b tt)) end. End lazy_list. Arguments lnil {T}. Arguments lcons {T} _ _.coq-ext-lib-0.12.0/theories/Data/List.v000066400000000000000000000160011451523051500175120ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Coq.Classes.EquivDec. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Structures.Monoid. Require Import ExtLib.Structures.Reducible. Require ExtLib.Data.Nat. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Tactics.Injection. Set Implicit Arguments. Set Strict Implicit. Set Universe Polymorphism. Section EqDec. Universe u. Variable T : Type@{u}. Variable EqDec_T : EquivDec.EqDec _ (@eq T). Global Instance EqDec_list@{} : EquivDec.EqDec _ (@eq (list T)). Proof. red. unfold Equivalence.equiv, RelationClasses.complement. intros. change (x = y -> False) with (x <> y). decide equality. eapply EqDec_T. Qed. End EqDec. (* Specialized induction rules *) Lemma list_ind_singleton@{u} : forall {T : Type@{u}} (P : list T -> Prop) (Hnil : P nil) (Hsingle : forall t, P (t :: nil)) (Hcons : forall t u us, P (u :: us) -> P (t :: u :: us)), forall ls, P ls. Proof. induction ls; eauto. destruct ls. eauto. eauto. Qed. Lemma list_rev_ind@{u} : forall (T : Type@{u}) (P : list T -> Prop), P nil -> (forall l ls, P ls -> P (ls ++ l :: nil)) -> forall ls, P ls. Proof. clear. intros. rewrite <- rev_involutive. induction (rev ls). apply H. simpl. auto. Qed. Section AllB. Universe u. Variable T : Type@{u}. Variable p : T -> bool. Fixpoint allb@{} (ls : list T) : bool := match ls with | nil => true | l :: ls => if p l then allb ls else false end. Fixpoint anyb@{} (ls : list T) : bool := match ls with | nil => false | l :: ls => if p l then true else anyb ls end. End AllB. Lemma Forall_map@{uT uU} : forall (T : Type@{uT}) (U : Type@{uU}) (f : T -> U) P ls, Forall P (List.map f ls) <-> Forall (fun x => P (f x)) ls. Proof. induction ls; simpl. { split; intros; constructor. } { split; inversion 1; intros; subst; constructor; auto. apply IHls. auto. apply IHls. auto. } Qed. Lemma Forall_cons_iff@{u} : forall (T : Type@{u}) (P : T -> Prop) a b, Forall P (a :: b) <-> (P a /\ Forall P b). Proof. clear. split. inversion 1; auto. destruct 1; constructor; auto. Qed. Lemma Forall_nil_iff@{u} : forall (T : Type@{u}) (P : T -> Prop), Forall P nil <-> True. Proof. clear. split; auto. Qed. Global Instance Foldable_list@{u} {T : Type@{u}} : Foldable (list T) T := fun _ f x ls => fold_right f x ls. Require Import ExtLib.Structures.Traversable. Require Import ExtLib.Structures.Functor. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Applicative. Section traversable. Universe u v vF. Context {F : Type@{v} -> Type@{vF}}. Context {Applicative_F : Applicative F}. Context {A : Type@{u}} {B : Type@{v}}. Variable f : A -> F B. Fixpoint mapT_list@{} (ls : list A) : F (list B) := match ls with | nil => pure nil | l :: ls => ap (ap (pure (@cons B)) (f l)) (mapT_list ls) end. End traversable. Global Instance Traversable_list@{} : Traversable list := { mapT := @mapT_list }. Monomorphic Universe listU. Global Instance Monad_list@{} : Monad@{listU listU} list := { ret := fun _ x => x :: nil ; bind := fun _ _ x f => flat_map f x }. Global Instance MonadZero_list : MonadZero list := { mzero := @nil }. Global Instance MonadPlus_list : MonadPlus list := { mplus _A _B a b := List.map inl a ++ List.map inr b }. Section list. Inductive R_list_len@{u} {T : Type@{u}} : list T -> list T -> Prop := | R_l_len : forall n m, length n < length m -> R_list_len n m. Theorem wf_R_list_len@{u} (T : Type@{u}) : well_founded (@R_list_len T). Proof. constructor. intros. refine (@Fix _ _ Nat.wf_R_lt (fun n : nat => forall ls : list T, n = length ls -> Acc R_list_len ls) (fun x rec ls pfls => Acc_intro _ _) _ _ refl_equal). refine ( match ls as ls return x = length ls -> forall z : list T, R_list_len z ls -> Acc R_list_len z with | nil => fun (pfls : x = 0) z pf => _ | cons l ls => fun pfls z pf => rec _ (match pf in R_list_len xs ys return x = length ys -> Nat.R_nat_lt (length xs) x with | R_l_len n m pf' => fun pf_eq => match eq_sym pf_eq in _ = x return Nat.R_nat_lt (length n) x with | refl_equal => Nat.R_lt pf' end end pfls) _ eq_refl end pfls). clear - pf; abstract (inversion pf; subst; simpl in *; inversion H). Defined. End list. Definition Monoid_list_app@{u v} {T : Type@{u}} : Monoid@{v} (list T) := {| monoid_plus := @List.app _ ; monoid_unit := @nil _ |}. Section ListEq. Universe u. Variable T : Type@{u}. Variable EDT : RelDec (@eq T). Fixpoint list_eqb@{} (ls rs : list T) : bool := match ls , rs with | nil , nil => true | cons l ls , cons r rs => if l ?[ eq ] r then list_eqb ls rs else false | _ , _ => false end. (** Specialization for equality **) Global Instance RelDec_eq_list@{} : RelDec (@eq (list T)) := { rel_dec := list_eqb }. Variable EDCT : RelDec_Correct EDT. Global Instance RelDec_Correct_eq_list@{v} : RelDec_Correct RelDec_eq_list. Proof. constructor; induction x; destruct y; split; simpl in *; intros; try reflexivity + discriminate. - destruct (_ : Reflect (rel_dec a t) _ _); try discriminate. replace y with x by (apply IHx; auto); subst; auto. - inversion H; subst. rewrite (rel_dec_eq_true _) by auto. apply IHx; auto. Qed. End ListEq. Global Instance Injective_cons@{u} (T : Type@{u}) (a : T) b c d : Injective (a :: b = c :: d). refine {| result := a = c /\ b = d |}. inversion 1; auto. Defined. Global Instance Injective_cons_nil@{u} (T : Type@{u}) (a : T) b : Injective (a :: b = nil). refine {| result := False |}. inversion 1; auto. Defined. Global Instance Injective_nil_cons@{u} (T : Type@{u}) (a : T) b : Injective (nil = a :: b). refine {| result := False |}. inversion 1; auto. Defined. Global Instance Injective_nil_nil@{u} (T : Type@{u}) : Injective (nil = @nil T). refine {| result := True |}. auto. Defined. Global Instance Injective_app_cons@{u} {T : Type@{u}} (a : list T) b c d : Injective (a ++ b :: nil = (c ++ d :: nil)). Proof. refine {| result := a = c /\ b = d |}. eapply app_inj_tail. Defined. Global Instance Injective_app_same_L@{u} {T : Type@{u}} (a : list T) b c : Injective (b ++ a = b ++ c). Proof. refine {| result := a = c |}. apply app_inv_head. Defined. Global Instance Injective_app_same_R@{u} {T : Type@{u}} (a : list T) b c : Injective (a ++ b = c ++ b). Proof. refine {| result := a = c |}. apply app_inv_tail. Defined. (* Lemma eq_list_eq@{u v} : forall (T : Type@{u}) (a b : T) (pf : a = b) (F : T -> Type@{v}) val, match pf in _ = x return list (F x) with | eq_refl => val end = map (fun val => match pf in _ = x return F x with | eq_refl => val end) val. Proof. destruct pf. intros. rewrite map_id. reflexivity. Qed. Hint Rewrite eq_list_eq : eq_rw. *) Export Coq.Lists.List. coq-ext-lib-0.12.0/theories/Data/ListFirstnSkipn.v000066400000000000000000000043271451523051500217150ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.ZArith.ZArith. Require Import Coq.micromega.Lia. (** For backwards compatibility with hint locality attributes. *) Set Warnings "-unsupported-attributes". Lemma firstn_app_L : forall T n (a b : list T), n <= length a -> firstn n (a ++ b) = firstn n a. Proof. induction n; destruct a; simpl in *; intros; auto. exfalso; lia. f_equal. eapply IHn; eauto. lia. Qed. Lemma firstn_app_R : forall T n (a b : list T), length a <= n -> firstn n (a ++ b) = a ++ firstn (n - length a) b. Proof. induction n; destruct a; simpl in *; intros; auto. exfalso; lia. f_equal. eapply IHn; eauto. lia. Qed. Lemma firstn_all : forall T n (a : list T), length a <= n -> firstn n a = a. Proof. induction n; destruct a; simpl; intros; auto. exfalso; lia. simpl. f_equal. eapply IHn; lia. Qed. Lemma firstn_0 : forall T n (a : list T), n = 0 -> firstn n a = nil. Proof. intros; subst; auto. Qed. Lemma firstn_cons : forall T n a (b : list T), 0 < n -> firstn n (a :: b) = a :: firstn (n - 1) b. Proof. destruct n; intros. lia. simpl. replace (n - 0) with n; [ | lia ]. reflexivity. Qed. #[global] Hint Rewrite firstn_app_L firstn_app_R firstn_all firstn_0 firstn_cons using lia : list_rw. Lemma skipn_app_R : forall T n (a b : list T), length a <= n -> skipn n (a ++ b) = skipn (n - length a) b. Proof. induction n; destruct a; simpl in *; intros; auto. exfalso; lia. eapply IHn. lia. Qed. Lemma skipn_app_L : forall T n (a b : list T), n <= length a -> skipn n (a ++ b) = (skipn n a) ++ b. Proof. induction n; destruct a; simpl in *; intros; auto. exfalso; lia. eapply IHn. lia. Qed. Lemma skipn_0 : forall T n (a : list T), n = 0 -> skipn n a = a. Proof. intros; subst; auto. Qed. Lemma skipn_all : forall T n (a : list T), length a <= n -> skipn n a = nil. Proof. induction n; destruct a; simpl in *; intros; auto. exfalso; lia. apply IHn; lia. Qed. Lemma skipn_cons : forall T n a (b : list T), 0 < n -> skipn n (a :: b) = skipn (n - 1) b. Proof. destruct n; intros. lia. simpl. replace (n - 0) with n; [ | lia ]. reflexivity. Qed. #[global] Hint Rewrite skipn_app_L skipn_app_R skipn_0 skipn_all skipn_cons using lia : list_rw. coq-ext-lib-0.12.0/theories/Data/ListNth.v000066400000000000000000000046261451523051500201760ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.Arith.PeanoNat. Set Implicit Arguments. Set Strict Implicit. Section parametric. Variable T : Type. Lemma nth_error_app_L : forall (A B : list T) n, n < length A -> nth_error (A ++ B) n = nth_error A n. Proof. induction A; destruct n; simpl; intros; auto. { inversion H. } { inversion H. } { eapply IHA. apply Nat.succ_lt_mono; assumption. } Qed. Lemma nth_error_app_R : forall (A B : list T) n, length A <= n -> nth_error (A ++ B) n = nth_error B (n - length A). Proof. induction A; destruct n; simpl; intros; auto. + inversion H. + apply IHA. apply Nat.succ_le_mono; assumption. Qed. Lemma nth_error_weaken : forall ls' (ls : list T) n v, nth_error ls n = Some v -> nth_error (ls ++ ls') n = Some v. Proof. clear. induction ls; destruct n; simpl; intros; unfold value, error in *; try congruence; auto. Qed. Lemma nth_error_nil : forall n, nth_error nil n = @None T. Proof. destruct n; reflexivity. Qed. Lemma nth_error_past_end : forall (ls : list T) n, length ls <= n -> nth_error ls n = None. Proof. clear. induction ls; destruct n; simpl; intros; auto. + inversion H. + apply IHls. apply Nat.succ_le_mono; assumption. Qed. Lemma nth_error_length : forall (ls ls' : list T) n, nth_error (ls ++ ls') (n + length ls) = nth_error ls' n. Proof. induction ls; simpl; intros. rewrite Nat.add_0_r. auto. rewrite <-Nat.add_succ_comm. simpl. eapply IHls. Qed. Theorem nth_error_length_ge : forall T (ls : list T) n, nth_error ls n = None -> length ls <= n. Proof. induction ls; destruct n; simpl in *; auto; simpl in *. + intro. apply Nat.le_0_l. + inversion 1. + intros. apply ->Nat.succ_le_mono. auto. Qed. Lemma nth_error_length_lt : forall {T} (ls : list T) n val, nth_error ls n = Some val -> n < length ls. Proof. induction ls; destruct n; simpl; intros; auto. + inversion H. + inversion H. + apply Nat.lt_0_succ. + apply ->Nat.succ_lt_mono. apply IHls with (1 := H). Qed. Theorem nth_error_map : forall U (f : T -> U) ls n, nth_error (map f ls) n = match nth_error ls n with | None => None | Some x => Some (f x) end. Proof. induction ls; destruct n; simpl; auto. Qed. End parametric. coq-ext-lib-0.12.0/theories/Data/Map/000077500000000000000000000000001451523051500171275ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Data/Map/FMapAList.v000066400000000000000000000162271451523051500211060ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Require Import Coq.Lists.List. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Structures.Maps. Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Structures.Functor. From Coq Require Import Basics. From ExtLib Require Import Extras OptionMonad. Import FunNotation FunctorNotation. Open Scope program_scope. Set Implicit Arguments. Set Strict Implicit. Section keyed. Variable K : Type. Variable R : K -> K -> Prop. Variable RD_K : RelDec R. Variable V : Type. Definition alist : Type := list (K * V). Definition alist_remove (k : K) (m : alist) : alist := List.filter (fun x => negb (k ?[ R ] (fst x))) m. Definition alist_add (k : K) (v : V) (m : alist) : alist := (k, v) :: alist_remove k m. Fixpoint alist_find (k : K) (m : alist) : option V := match m with | nil => None | (k',v) :: ms => if k ?[ R ] k' then Some v else alist_find k ms end. Definition alist_find' (k: K) : alist -> option V := fmap snd ∘ find (rel_dec k ∘ fst). Lemma alist_find_alt (m: alist) : forall k: K, alist_find k m = alist_find' k m. Proof. induction m; intuition. unfold alist_find', compose. simpl. destruct (k ?[ R ] a0) eqn:Heq; [intuition|]. rewrite IHm. reflexivity. Qed. Section fold. Import MonadNotation. Local Open Scope monad_scope. Variables T : Type. Variable f : K -> V -> T -> T. Fixpoint fold_alist (acc : T) (map : alist) : T := match map with | nil => acc | (k,v) :: m => let acc := f k v acc in fold_alist acc m end. Definition fold_alist' : T -> alist -> T := flip $ fold_left (flip $ uncurry f). Lemma fold_alist_alt (map: alist) : forall acc: T, fold_alist acc map = fold_alist' acc map. Proof. induction map; intuition. simpl. rewrite IHmap. reflexivity. Qed. End fold. Definition alist_union (m1 m2 : alist) : alist := fold_alist alist_add m2 m1. Global Instance Map_alist : Map K V alist := { empty := nil ; add := @alist_add ; remove := alist_remove ; lookup := alist_find ; union := @alist_union }. Section proofs. Hypothesis RDC_K : RelDec_Correct RD_K. Hypothesis Refl : Reflexive R. Hypothesis Sym : Symmetric R. Hypothesis Trans : Transitive R. Definition mapsto_alist (m : alist) k v : Prop := alist_find k m = Some v. Lemma mapsto_alist_cons : forall k v m k' v', mapsto_alist ((k',v') :: m) k v <-> ( (mapsto_alist m k v /\ ~R k k') \/ (R k k' /\ v = v')). Proof. unfold mapsto_alist; intuition; simpl in *. { consider (k ?[ R ] k'); intros. { right. inversion H0; auto. } { left. auto. } } { consider (k ?[ R ] k'); intros; intuition. } { consider (k ?[ R ] k'); intros; intuition. congruence. } Qed. Theorem mapsto_lookup_alist : forall (k : K) (v : V) (m : list (K * V)), lookup k m = Some v <-> mapsto_alist m k v. Proof. reflexivity. Qed. Theorem mapsto_remove_eq_alist : forall (m : list (K * V)) (k : K) (v : V), ~mapsto_alist (remove k m) k v. Proof. unfold mapsto_alist, remove, alist_remove; simpl. intros. induction m; simpl; auto. { congruence. } { destruct a; simpl in *. consider (k ?[ R ] k0); auto; intros. simpl. consider (k ?[ R ] k0); auto. } Qed. Theorem mapsto_remove_neq_alist : forall (m : list (K * V)) (k : K), forall k', ~ R k k' -> forall v', (mapsto_alist m k' v' <-> mapsto_alist (remove k m) k' v'). Proof. unfold mapsto_alist, add; simpl. intros. induction m; simpl in *. { intuition. } { destruct a. simpl in *. consider (k' ?[ R ] k0); intros. { consider (k ?[ R ] k0); intros. { exfalso. eauto. } { simpl. consider (k' ?[ R ] k0); intros. { intuition. } { exfalso; auto. } } } { rewrite IHm. consider (k ?[ R ] k0); simpl; intros. { intuition. } { consider (k' ?[ R ] k0); intros. { exfalso; auto. } { intuition. } } } } Qed. Theorem mapsto_add_eq_alist : forall (m : list (K * V)) (k : K) (v : V), mapsto_alist (add k v m) k v. Proof. unfold mapsto_alist, add, alist_add; simpl. intros. consider (k ?[ R ] k); auto. intro. exfalso. apply H. reflexivity. Qed. Theorem mapsto_add_neq_alist : forall (m : list (K * V)) (k : K) (v : V), forall k', ~ R k k' -> forall v', (mapsto_alist m k' v' <-> mapsto_alist (add k v m) k' v'). Proof. unfold mapsto_alist, add; simpl. intros. consider (k' ?[ R ] k); try solve [ intros; exfalso; auto ]. intros. eapply mapsto_remove_neq_alist in H. eapply H. Qed. Theorem remove_eq_alist: forall (m : alist) (k : K), alist_find k (alist_remove k m) = None. Proof. unfold mapsto_alist. induction m; simpl; eauto; try congruence. intros; consider (k ?[ R ] fst a); simpl; intros; eauto. destruct a; simpl in *. consider (k ?[ R ] k0); eauto. tauto. Qed. Theorem remove_neq_alist: forall (m : alist) (k k' : K), ~R k' k -> alist_find k (alist_remove k' m) = alist_find k m. Proof. unfold mapsto_alist. induction m; simpl; eauto; try congruence. destruct a; simpl. intros; consider (k' ?[ R ] k); simpl; intros; eauto. { consider (k0 ?[ R ] k); intros; eauto. exfalso. eapply H. etransitivity; eauto. } { consider (k0 ?[ R ] k); eauto. } Qed. Global Instance MapLaws_alist : MapOk R Map_alist. Proof. refine {| mapsto := fun k v m => mapsto_alist m k v |}; eauto using mapsto_lookup_alist, mapsto_add_eq_alist, mapsto_add_neq_alist. { intros; intro. inversion H. } { unfold mapsto_alist; simpl. intros. rewrite remove_eq_alist. congruence. } { unfold mapsto_alist. simpl; intros. erewrite (@remove_neq_alist m _ _ H). reflexivity. } Defined. End proofs. Global Instance Foldable_alist : Foldable alist (K * V) := fun _ f b => fold_alist (fun k v => f (k,v)) b. End keyed. Global Instance Functor_alist K : Functor (alist K) := { fmap := fun T U f => map (fun x => (fst x, f (snd x))) }. (** Performance Test **) (* Module TEST. Definition m := alist nat nat. Instance Map_m : Map nat (alist nat). apply Map_alist. eauto with typeclass_instances. Defined. Definition z : m := (fix fill n acc : m := let acc := add n n acc in match n with | 0 => acc | S n => fill n acc end) 500 empty. Time Eval compute in let z := z in (fix find_all n : unit := let _ := lookup n z in match n with | 0 => tt | S n => find_all n end) 500. End TEST. *) coq-ext-lib-0.12.0/theories/Data/Map/FMapPositive.v000066400000000000000000000212541451523051500216700ustar00rootroot00000000000000Require Import ExtLib.Structures.Maps. Require Import ExtLib.Structures.Functor. Require Import ExtLib.Data.Option. Require Import ExtLib.Data.Positive. Require Import ExtLib.Tactics.Cases. Set Implicit Arguments. Set Strict Implicit. Section pmap. Variable T : Type. Inductive pmap : Type := | Empty | Branch : option T -> pmap -> pmap -> pmap. Definition pmap_here (m : pmap) : option T := match m with | Empty => None | Branch d _ _ => d end. Definition pmap_left (m : pmap) : pmap := match m with | Empty => Empty | Branch _ l _ => l end. Definition pmap_right (m : pmap) : pmap := match m with | Empty => Empty | Branch _ _ r => r end. Fixpoint pmap_lookup (p : positive) (m : pmap) {struct p} : option T := match m with | Empty => None | Branch d l r => match p with | xH => d | xO p => pmap_lookup p l | xI p => pmap_lookup p r end end. Fixpoint pmap_insert (p : positive) (v : T) (m : pmap) {struct p} : pmap := match p with | xH => Branch (Some v) (pmap_left m) (pmap_right m) | xO p => Branch (pmap_here m) (pmap_insert p v (pmap_left m)) (pmap_right m) | xI p => Branch (pmap_here m) (pmap_left m) (pmap_insert p v (pmap_right m)) end. Definition branch (o : option T) (l r : pmap) : pmap := match o , l , r with | None , Empty , Empty => Empty | _ , _ , _ => Branch o l r end. Fixpoint pmap_remove (p : positive) (m : pmap) {struct p} : pmap := match m with | Empty => Empty | Branch d l r => match p with | xH => branch None l r | xO p => branch d (pmap_remove p l) r | xI p => branch d l (pmap_remove p r) end end. Definition pmap_empty : pmap := Empty. Fixpoint pmap_union (f m : pmap) : pmap := match f with | Empty => m | Branch d l r => Branch (match d with | Some x => Some x | None => pmap_here m end) (pmap_union l (pmap_left m)) (pmap_union r (pmap_right m)) end. Global Instance Map_pmap : Map positive T pmap := { empty := pmap_empty ; add := pmap_insert ; remove := pmap_remove ; lookup := pmap_lookup ; union := pmap_union }. Lemma tilde_1_inj_neg : forall k k', (k~1)%positive <> (k'~1)%positive -> k <> k'. Proof. induction k; destruct k'; intuition; try match goal with | H : _ = _ |- _ => inversion H; clear H; subst end; intuition eauto. Qed. Lemma tilde_0_inj_neg : forall k k', (k~0)%positive <> (k'~0)%positive -> k <> k'. Proof. induction k; destruct k'; intuition; try match goal with | H : _ = _ |- _ => inversion H; clear H; subst end; intuition eauto. Qed. Lemma pmap_lookup_insert_empty : forall k k' v, k <> k' -> pmap_lookup k' (pmap_insert k v Empty) = None. Proof. induction k; destruct k'; simpl; intros; eauto using tilde_0_inj_neg, tilde_1_inj_neg. destruct k'; simpl; auto. destruct k'; simpl; auto. destruct k'; simpl; auto. destruct k'; simpl; auto. congruence. Qed. Lemma lookup_empty : forall k, pmap_lookup k Empty = None. Proof. destruct k; reflexivity. Qed. Hint Rewrite lookup_empty pmap_lookup_insert_empty using (eauto using tilde_1_inj_neg, tilde_1_inj_neg) : pmap_rw. Lemma pmap_lookup_insert_eq : forall (m : pmap) (k : positive) (v : T), pmap_lookup k (pmap_insert k v m) = Some v. Proof. intros m k; revert m. induction k; simpl; intros; forward; Cases.rewrite_all_goal; eauto. Qed. Lemma pmap_lookup_insert_Some_neq : forall (m : pmap) (k : positive) (v : T) (k' : positive), k <> k' -> forall v' : T, pmap_lookup k' m = Some v' <-> pmap_lookup k' (pmap_insert k v m) = Some v'. Proof. intros m k; revert m. induction k; simpl; intros; forward; Cases.rewrite_all_goal; autorewrite with pmap_rw; eauto. { destruct k'; simpl; destruct m; simpl; autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity. erewrite IHk; eauto using tilde_1_inj_neg. reflexivity. } { destruct k'; simpl; destruct m; simpl; autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence. erewrite IHk. reflexivity. eauto using tilde_0_inj_neg. } { destruct k'; simpl; destruct m; simpl; autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence. } Qed. Lemma pmap_lookup_insert_None_neq : forall (m : pmap) (k : positive) (v : T) (k' : positive), k <> k' -> pmap_lookup k' m = None <-> pmap_lookup k' (pmap_insert k v m) = None. Proof. intros m k; revert m. induction k; simpl; intros; forward; Cases.rewrite_all_goal; autorewrite with pmap_rw; eauto. { destruct k'; simpl; destruct m; simpl; autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity. erewrite IHk; eauto using tilde_1_inj_neg. reflexivity. } { destruct k'; simpl; destruct m; simpl; autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence. erewrite IHk. reflexivity. eauto using tilde_0_inj_neg. } { destruct k'; simpl; destruct m; simpl; autorewrite with pmap_rw; Cases.rewrite_all_goal; try reflexivity; try congruence. } Qed. Lemma pmap_lookup_insert_neq : forall (m : pmap) (k : positive) (v : T) (k' : positive), k <> k' -> forall v' : T, pmap_lookup k' (pmap_insert k v m) = pmap_lookup k' m. Proof. intros. remember (pmap_lookup k' m). destruct o; [ apply pmap_lookup_insert_Some_neq; intuition | apply pmap_lookup_insert_None_neq; intuition]. Qed. Lemma pmap_lookup_remove_eq : forall (m : pmap) (k : positive) (v : T), pmap_lookup k (pmap_remove k m) <> Some v. Proof. induction m; destruct k; simpl; intros; try congruence. { destruct o; simpl; eauto. destruct m1; simpl; eauto. destruct (pmap_remove k m2) eqn:?; try congruence. rewrite <- Heqp. eauto. } { destruct o; simpl; eauto. destruct (pmap_remove k m1) eqn:?; try congruence. - destruct m2; try congruence; eauto. destruct k; simpl; congruence. - rewrite <- Heqp. eauto. } { destruct m1; try congruence. destruct m2; try congruence. } Qed. Lemma pmap_lookup_remove_neq : forall (m : pmap) (k k' : positive), k <> k' -> forall v' : T, pmap_lookup k' m = Some v' <-> pmap_lookup k' (pmap_remove k m) = Some v'. Proof. induction m. Local Ltac t := unfold branch; repeat match goal with | |- context [ match ?X with _ => _ end ] => lazymatch X with | match _ with _ => _ end => fail | _ => destruct X eqn:?; subst; try tauto end end. { destruct k; simpl; split; try congruence. } { destruct k', k; simpl; intros; try solve [ t; rewrite lookup_empty; tauto ]. { assert (k <> k') by congruence. rewrite IHm2; eauto. simpl. t. rewrite lookup_empty. tauto. } { assert (k <> k') by congruence. rewrite IHm1; eauto. simpl. t. rewrite lookup_empty. tauto. } } Qed. Global Instance MapOk_pmap : MapOk (@eq _) Map_pmap. Proof. refine {| mapsto := fun k v m => pmap_lookup k m = Some v |}. { abstract (induction k; simpl; congruence). } { abstract (induction k; simpl; intros; forward). } { eauto using pmap_lookup_insert_eq. } { eauto using pmap_lookup_insert_Some_neq. } { eauto using pmap_lookup_remove_eq. } { eauto using pmap_lookup_remove_neq. } Defined. Definition from_list : list T -> pmap := (fix from_list acc i ls {struct ls} := match ls with | nil => acc | List.cons l ls => from_list (pmap_insert i l acc) (Pos.succ i) ls end) Empty 1%positive. End pmap. Arguments Empty {_}. Arguments Branch {_} _ _ _. Section fmap. Variables T U : Type. Variable f : T -> U. Fixpoint fmap_pmap (m : pmap T) : pmap U := match m with | Empty => Empty | Branch h l r => Branch (fmap f h) (fmap_pmap l) (fmap_pmap r) end. Theorem fmap_lookup : forall a b m, mapsto a b m -> mapsto a (f b) (fmap_pmap m). Proof. induction a; destruct m; simpl; intros; try congruence. { eapply IHa. eapply H. } { eapply IHa; eapply H. } { subst. auto. } Qed. Theorem fmap_lookup_bk : forall a b m, mapsto a b (fmap_pmap m) -> exists b', mapsto a b' m /\ f b' = b. Proof. induction a; destruct m; simpl; intros; try congruence. { eapply IHa. eapply H. } { eapply IHa. eapply H. } { destruct o; try congruence. eexists; split; eauto. inversion H; auto. } Qed. End fmap. Global Instance Functor_pmap : Functor pmap := { fmap := fmap_pmap }. coq-ext-lib-0.12.0/theories/Data/Map/FMapTwoThreeK.v000066400000000000000000000137351451523051500217470ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Structures.Maps. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Reducible. Set Implicit Arguments. Set Strict Implicit. Section keyed. Variable K : Type. Variable K_le : K -> K -> Prop. Variable RD_K : K -> K -> comparison. Inductive twothree (T : Type) : Type := | Leaf | Two : twothree T -> K -> T -> twothree T -> twothree T | Three : twothree T -> K -> T -> twothree T -> K -> T -> twothree T -> twothree T. Arguments Leaf {T}. Arguments Two {T} _ _ _ _. Arguments Three {T} _ _ _ _ _ _ _. Section modify. Variable V : Type. Variable k : K. Variable upd : V -> option V. Variable def : option V. Fixpoint remove_greatest (m : twothree V) {T} (k_oops : unit -> T) (k_ok : K -> V -> twothree V -> T) : T := match m with | Leaf => k_oops tt | Two l k v r => remove_greatest r (fun _ => k_ok k v l) (fun k' v' r' => k_ok k' v' (Two l k v r')) | Three l k v m k' v' r => remove_greatest r (fun _ => k_ok k' v' (Two l k v m)) (fun k'' v'' r'' => k_ok k'' v'' (Three l k v m k' v' r'')) end. Fixpoint twothree_modify (m : twothree V) {T} (k_ok : twothree V -> T) (k_splice_up : twothree V -> K -> V -> twothree V -> T) {struct m} : T := match m with | Leaf => match def with | Some v => k_splice_up Leaf k v Leaf | None => k_ok Leaf end | Two l k' v' r => match RD_K k k' with | Eq => match upd v' with | Some v' => k_ok (Two l k v' r) | None => remove_greatest l (fun _ => k_ok r) (fun k v l => k_ok (Two l k v r)) end | Lt => twothree_modify l (fun l => k_ok (Two l k' v' r)) (fun l'' k'' v'' r'' => k_ok (Three l'' k'' v'' r'' k' v' r)) | Gt => twothree_modify r (fun r => k_ok (Two l k' v' r)) (fun l'' k'' v'' r'' => k_ok (Three l k' v' l'' k'' v'' r'')) end | Three l k1 v1 m k2 v2 r => match RD_K k k1 with | Eq => match upd v1 with | Some v' => k_ok (Three l k v' m k2 v2 r) | None => remove_greatest l (fun _ => k_ok (Two m k2 v2 r)) (fun k1 v1 l => k_ok (Three l k1 v2 m k2 v2 r)) end | Lt => twothree_modify l (fun l' => k_ok (Three l' k1 v1 m k2 v2 r)) (fun l' k' v' r' => k_splice_up (Two l' k' v' r') k1 v1 (Two m k2 v2 r)) | Gt => match RD_K k k2 with | Eq => match upd v2 with | Some v2 => k_ok (Three l k1 v1 m k v2 r) | None => remove_greatest m (fun _ => k_ok (Two l k1 v1 r)) (fun k' v' m' => k_ok (Three l k1 v1 m' k' v' r)) end | Lt => twothree_modify m (fun m' => k_ok (Three l k1 v1 m' k2 v2 r)) (fun l' k' v' r' => k_splice_up (Two l k1 v1 l') k' v' (Two r' k2 v2 r)) | Gt => twothree_modify r (fun r' => k_ok (Three l k1 v1 m k2 v2 r')) (fun l' k' v' r' => k_splice_up (Two l k1 v1 m) k2 v2 (Two l' k' v' r')) end end end. End modify. Definition twothree_add {V} (k : K) (v : V) (m : twothree V) : twothree V := twothree_modify k (fun _ => Some v) (Some v) m (fun m => m) Two. Definition twothree_remove {V} (k : K) (m : twothree V) : twothree V := twothree_modify k (fun _ => None) None m (fun m => m) Two. Fixpoint twothree_find {V} (k : K) (m : twothree V) : option V := match m with | Leaf => None | Two l k' v' r => match RD_K k k' with | Eq => Some v' | Lt => twothree_find k l | Gt => twothree_find k r end | Three l k1 v1 m k2 v2 r => match RD_K k k1 with | Eq => Some v1 | Lt => twothree_find k l | Gt => match RD_K k k2 with | Eq => Some v2 | Lt => twothree_find k m | Gt => twothree_find k r end end end. Section fold. Import MonadNotation. Local Open Scope monad_scope. Variables V T : Type. Variable f : K -> V -> T -> T. Fixpoint twothree_fold (acc : T) (map : twothree V) : T := match map with | Leaf => acc | Two l k v r => let acc := twothree_fold acc l in let acc := f k v acc in twothree_fold acc r | Three l k1 v1 m k2 v2 r => let acc := twothree_fold acc l in let acc := f k1 v1 acc in let acc := twothree_fold acc m in let acc := f k2 v2 acc in twothree_fold acc r end. End fold. Definition twothree_union {V} (m1 m2 : twothree V) : twothree V := twothree_fold twothree_add m2 m1. Global Instance Map_twothree V : Map K V (twothree V) := { empty := Leaf ; add := twothree_add ; remove := twothree_remove ; lookup := twothree_find ; union := twothree_union }. Global Instance Foldable_twothree V : Foldable (twothree V) (K * V) := fun _ f b x => twothree_fold (fun k v => f (k,v)) b x. End keyed. (** Performance Test **) (* Module TEST. Definition m := twothree nat nat. Instance Map_m : Map nat (twothree nat). apply Map_twothree. apply Compare_dec.nat_compare. Defined. Definition z : m := (fix fill n acc : m := let acc := add n n acc in match n with | 0 => acc | S n => fill n acc end) 500 empty. Time Eval vm_compute in let z := z in (fix find_all n : unit := let _ := lookup n z in match n with | 0 => tt | S n => find_all n end) 500. End TEST. *) coq-ext-lib-0.12.0/theories/Data/Member.v000066400000000000000000000075171451523051500200220ustar00rootroot00000000000000(** [member] is the proof relevant version of [In] **) Require Import Coq.Lists.List. Require Import Relations RelationClasses. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Data.SigT. Require Import ExtLib.Data.ListNth. Require Import ExtLib.Data.Option. Require Import ExtLib.Tactics.Injection. Require Import ExtLib.Tactics.EqDep. Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. Section member. Context {T : Type}. Inductive member (a : T) : list T -> Type := | MZ : forall ls, member a (a :: ls) | MN : forall l ls, member a ls -> member a (l :: ls). Section to_nat. Variable a : T. Fixpoint to_nat {ls} (m : member a ls) : nat := match m with | MZ _ => 0 | MN _ _ m => S (to_nat m) end. End to_nat. Lemma member_eta : forall x ls (m : member x ls), m = match m in member _ ls return member x ls with | MZ ls => MZ x ls | MN _ _ n => MN _ n end. Proof. destruct m; auto. Qed. Lemma member_case : forall x ls (m : member x ls), match ls as ls return member x ls -> Prop with | nil => fun _ => False | l :: ls' => fun m => (exists (pf : l = x), m = match pf in _ = z return member z (l :: ls') with | eq_refl => MZ _ ls' end) \/ exists m' : member x ls', m = MN _ m' end m. Proof. induction m. { left. exists eq_refl. reflexivity. } { right. eauto. } Qed. Lemma to_nat_eq_member_eq : forall {_ : EqDec T (@eq T)} x ls (a b : member x ls), to_nat a = to_nat b -> a = b. Proof. induction a; intros. { destruct (member_case b). { destruct H0. subst. rewrite (UIP_refl x0). reflexivity. } { destruct H0. subst. simpl in *. congruence. } } { destruct (member_case b). { exfalso. destruct H0. subst. simpl in *. congruence. } { destruct H0. subst. simpl in *. inversion H; clear H; subst. eapply IHa in H1. f_equal. assumption. } } Qed. Fixpoint nth_member (ls : list T) (n : nat) {struct n} : option { x : T & member x ls } := match ls as ls return option { x : T & member x ls } with | nil => None | l :: ls => match n with | 0 => Some (@existT _ (fun x => member x (l :: ls)) l (MZ _ _)) | S n => match nth_member ls n with | Some (existT v m) => Some (@existT _ _ v (MN _ m)) | None => None end end end. Definition get_next ls y x (m : member x (y :: ls)) : option (member x ls) := match m in member _ ls' return match ls' with | nil => unit | l' :: ls' => option (member x ls') end with | MZ _ => None | MN _ _ m => Some m end. Instance Injective_MN x y ls m m' : Injective (@MN x y ls m = @MN x y ls m'). Proof. refine {| result := m = m' |}. intro. assert (get_next (MN y m) = get_next (MN y m')). { rewrite H. reflexivity. } { simpl in *. inversion H0. reflexivity. } Defined. Lemma nth_member_nth_error : forall ls p, nth_member ls (to_nat (projT2 p)) = Some p <-> nth_error ls (to_nat (projT2 p)) = Some (projT1 p). Proof. destruct p. simpl in *. induction m. { simpl. split; auto. } { simpl. split. { intros. destruct (nth_member ls (to_nat m)); try congruence. { destruct s. inv_all. subst. inv_all. subst. apply IHm. reflexivity. } } { intros. eapply IHm in H. rewrite H. reflexivity. } } Qed. Lemma member_In : forall ls (t : T), member t ls -> List.In t ls. Proof. induction 1; simpl; auto. Qed. End member. coq-ext-lib-0.12.0/theories/Data/Monads/000077500000000000000000000000001451523051500176335ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Data/Monads/ContMonad.v000066400000000000000000000034511451523051500217070ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.MonadTrans. Set Implicit Arguments. Set Contextual Implicit. Set Maximal Implicit Insertion. Section ContType. Variable R : Type. (* Record cont (t : Type) : Type := mkCont { runCont : (t -> Ans) -> Ans }. Global Instance Monad_cont : Monad cont := { ret := fun _ v => mkCont (fun k => k v) ; bind := fun _ c1 _ c2 => mkCont (fun k => runCont c1 (fun t => runCont (c2 t) k)) }. Global Instance Cont_cont : Cont cont := { callCC := fun _ _ f => mkCont (fun c => runCont (f (fun x => mkCont (fun _ => c x))) c) }. Definition mapCont (f : Ans -> Ans) {a} (c : cont a) : cont a := mkCont (fun x => f (runCont c x)). Definition withCont {a b} (f : (b -> Ans) -> (a -> Ans)) (c : cont a) : cont b := mkCont (fun x => runCont c (f x)). *) Variable M : Type -> Type. Record contT (A : Type) : Type := mkContT { runContT : (A -> M R) -> M R }. Global Instance Monad_contT : Monad contT := { ret := fun _ x => mkContT (fun k => k x) ; bind := fun _ _ c1 c2 => mkContT (fun c => runContT c1 (fun a => runContT (c2 a) c)) }. Global Instance MonadT_contT {Monad_M : Monad M} : MonadT contT M := { lift := fun _ c => mkContT (bind c) }. (* Definition mapContT (f : m Ans -> m Ans) {a} (c : contT a) : contT a := mkContT (fun x => f (runContT c x)). Definition withContT {a b} (f : (b -> m Ans) -> (a -> m Ans)) (c : contT a) : contT b := mkContT (fun x => runContT c (f x)). *) End ContType. Definition resetT {M} {Monad_M : Monad M} {R R'} (u : contT R M R) : contT R' M R := mkContT (fun k => bind (runContT u ret) k). Definition shiftT {M} {Monad_M : Monad M} {R A} (f : (A -> M R) -> contT R M R) : contT R M A := mkContT (fun k => runContT (f k) ret). coq-ext-lib-0.12.0/theories/Data/Monads/EitherMonad.v000066400000000000000000000055661451523051500222350ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Monoid. Set Implicit Arguments. Set Strict Implicit. Import MonadNotation. Local Open Scope monad_scope. Section except. Variable T : Type. Global Instance Monad_either : Monad (sum T) := { ret := fun _ v => inr v ; bind := fun _ _ c1 c2 => match c1 with | inl v => inl v | inr v => c2 v end }. Global Instance Exception_either : MonadExc T (sum T) := { raise := fun _ v => inl v ; catch := fun _ c h => match c with | inl v => h v | x => x end }. Variable m : Type -> Type. Inductive eitherT A := mkEitherT { unEitherT : m (sum T A) }. Variable M : Monad m. Global Instance Monad_eitherT : Monad eitherT := { ret := fun _ x => mkEitherT (ret (inr x)) ; bind := fun _ _ c f => mkEitherT ( xM <- unEitherT c ;; match xM with | inl x => ret (inl x) | inr x => unEitherT (f x) end ) }. Global Instance Exception_eitherT : MonadExc T eitherT := { raise := fun _ v => mkEitherT (ret (inl v)) ; catch := fun _ c h => mkEitherT ( xM <- unEitherT c ;; match xM with | inl x => unEitherT (h x) | inr x => ret (inr x) end ) }. Global Instance MonadPlus_eitherT : MonadPlus eitherT := { mplus _A _B mA mB := mkEitherT ( x <- unEitherT mA ;; match x with | inl _ => y <- unEitherT mB ;; match y with | inl t => ret (inl t) | inr b => ret (inr (inr b)) end | inr a => ret (inr (inl a)) end ) }. Global Instance MonadT_eitherT : MonadT eitherT m := { lift := fun _ c => mkEitherT (liftM ret c) }. Global Instance MonadState_eitherT {T} (MS : MonadState T m) : MonadState T eitherT := { get := lift get ; put := fun v => lift (put v) }. Global Instance MonadReader_eitherT {T} (MR : MonadReader T m) : MonadReader T eitherT := { ask := lift ask ; local := fun _ f cmd => mkEitherT (local f (unEitherT cmd)) }. Global Instance MonadWriter_eitherT {T} (Mon : Monoid T) (MW : MonadWriter Mon m) : MonadWriter Mon eitherT := { tell := fun x => lift (tell x) ; listen := fun _ c => mkEitherT ( x <- listen (unEitherT c) ;; match x with | (inl l, _) => ret (inl l) | (inr a, t) => ret (inr (a, t)) end) ; pass := fun _ c => mkEitherT ( x <- unEitherT c ;; match x with | inl s => ret (inl s) | inr (a,f) => pass (ret (inr a, f)) end) }. Global Instance MonadFix_eitherT (MF : MonadFix m) : MonadFix eitherT := { mfix := fun _ _ r v => mkEitherT (mfix (fun f x => unEitherT (r (fun x => mkEitherT (f x)) x)) v) }. End except. Arguments mkEitherT {T} {m} {A} (_). Arguments unEitherT {T} {m} {A} (_). coq-ext-lib-0.12.0/theories/Data/Monads/FuelMonad.v000066400000000000000000000032421451523051500216750ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import BinPos. Set Implicit Arguments. Set Strict Implicit. Inductive FixResult (T : Type) := | Term : T -> FixResult T | Diverge : FixResult T. Arguments Diverge {_}. Arguments Term {_} _. (** The GFix monad is like monad fix except that it encapsulates the "gas" that is used as the measure **) Section gfix. (** This is essentially ReaderT (optionT m)) **) Inductive GFix (T : Type) : Type := mkGFix { runGFix : N -> FixResult T }. Global Instance MonadFix_GFix : MonadFix GFix := { mfix := fun T U f v => mkGFix (fun n : N => match n with | N0 => Diverge | Npos g => let F := fix rec (acc : T -> FixResult U) (gas : positive) (x : T) : FixResult U := match gas return FixResult U with | xI p => runGFix (f (fun x => mkGFix (fun n => rec (fun x => rec acc p x) p x)) x) n | xO p => rec (fun x => rec acc p x) p x | xH => runGFix (f (fun x => mkGFix (fun _ => acc x)) x) n end in F (fun x => runGFix (f (fun _ => mkGFix (fun _ => Diverge)) x) n) g v end) }. Global Instance Monad_GFix : Monad GFix := { ret := fun _ v => mkGFix (fun _ => Term v) ; bind := fun _ _ c1 c2 => mkGFix (fun gas => match runGFix c1 gas with | Diverge => Diverge | Term v => runGFix (c2 v) gas end) }. End gfix. (** Demo Require Import ExtLib.Data.Monads.IdentityMonad. Definition foo : nat -> GFix ident nat := mfix (fun recur n => match n with | 0 => ret 0 | S n => recur n end). Eval compute in runGFix (foo 10) 100000000000000000000000. **) coq-ext-lib-0.12.0/theories/Data/Monads/FuelMonadLaws.v000066400000000000000000000120011451523051500225150ustar00rootroot00000000000000Require Import RelationClasses. Require Import Setoid. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Data.Fun. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.MonadLaws. Require Import ExtLib.Data.Monads.FuelMonad. Set Implicit Arguments. Set Strict Implicit. (* Section Laws. Section fixResult_T. Context {T : Type} (e : type T). Definition FixResult_eq (a b : FixResult T) : Prop := match a , b with | Diverge , Diverge => True | Term a , Term b => equal a b | _ , _ => False end. Global Instance type_FixResult : type (FixResult T) := type_from_equal FixResult_eq. Variable tokE : typeOk e. Global Instance typeOk_FixResult : typeOk type_FixResult. Proof. eapply typeOk_from_equal. { unfold proper; simpl. destruct x; destruct y; simpl; intros; auto; try contradiction. apply only_proper in H; auto. destruct H; split; apply tokE; assumption. } { red. destruct x; destruct y; simpl; auto; simpl. symmetry; auto. } { red. destruct x; destruct y; destruct z; simpl; intros; auto; try contradiction. etransitivity; eauto. } Qed. End fixResult_T. Section with_T. Context {T : Type} (e : type T). Variable tokE : typeOk e. Definition fix_meq (l r : GFix T) : Prop := equal (runGFix l) (runGFix r). Global Instance type_GFix : type (GFix T) := type_from_equal fix_meq. Global Instance typeOk_GFix : typeOk type_GFix. Proof. eapply typeOk_from_equal. { destruct x; destruct y; simpl. intros; split; intros. { red; simpl. red in H; red. simpl FuelMonad.runGFix in *. eapply only_proper in H; eauto with typeclass_instances. intros; subst. eapply preflexive with (wf := proper); eauto with typeclass_instances. eapply equiv_prefl; eauto with typeclass_instances. solve_proper; intuition. } { red; simpl. red in H; red; simpl FuelMonad.runGFix in *. eapply only_proper in H; eauto with typeclass_instances. intros; subst. eapply preflexive with (wf := proper); eauto with typeclass_instances. eapply equiv_prefl; eauto with typeclass_instances. solve_proper. intuition. } } { red. destruct x; destruct y; simpl; unfold fix_meq. simpl FuelMonad.runGFix in *. intros. symmetry; auto. } { red; destruct x; destruct y; destruct z; simpl; unfold fix_meq; simpl FuelMonad.runGFix in *. intros. etransitivity; eauto. } Qed. Global Instance proper_runGFix : proper (@runGFix T). Proof. repeat red; simpl; intros. eapply H. subst. reflexivity. Qed. Global Instance proper_mkGFix : proper (@mkGFix T). Proof. repeat red; simpl; intros. eapply H. subst. reflexivity. Qed. End with_T. Require Import ExtLib.Tactics.TypeTac. Global Instance MonadLaws_GFix : MonadLaws Monad_GFix (@type_GFix). Proof. constructor. { (* bind_of_return *) red; simpl; intros. red. simpl runGFix. type_tac. } { (* return_of_bind *) red; simpl; intros. red. simpl runGFix. type_tac. assert (equal (runGFix aM x) (runGFix aM y)) by type_tac. destruct (runGFix aM x); destruct (runGFix aM y); simpl in *; try contradiction; auto. specialize (H0 a x y H2). red. destruct (runGFix (f a) x); simpl in *; auto. etransitivity; eauto. } { (* bind associativity *) red; simpl; intros. red; simpl runGFix. type_tac. assert (equal (runGFix aM x) (runGFix aM y)) by type_tac. destruct (runGFix aM x); destruct (runGFix aM y); simpl in H6; try contradiction; auto. assert (equal (runGFix (f a) x) (runGFix (f a0) y)) by type_tac. destruct (runGFix (f a) x); destruct (runGFix (f a0) y); simpl in H7; try contradiction; type_tac. } { unfold ret; simpl. red. red. Opaque equal. simpl. intros; type_tac. Transparent equal. } { unfold bind; simpl; intros. red; intros. red; intros. red; simpl. red; intros; subst. assert (equal (runGFix x y1) (runGFix y y1)) by type_tac. red in H2. destruct (runGFix x y1); destruct (runGFix y y1); simpl in H3; try contradiction. 2: red; auto. match goal with | |- FixResult_eq _ ?X ?Y => change (equal X Y) end. type_tac. } Qed. (* Theorem Diverge_minimal : forall C (eC : relation C) x, FixResult_leq eC Diverge x. Proof. destruct x; compute; auto. Qed. Theorem Term_maximal : forall C (eC : relation C) x y, FixResult_leq eC (Term x) y -> exists z, y = Term z /\ eC x z. Proof. destruct y; simpl; intros; try contradiction; eauto. Qed. Lemma leq_app : forall B C (eB : relation B) (eC : relation C) (pB : Proper eB) (pC : Proper eC) g (b b' : B) n n', proper g -> proper b -> proper b' -> eB b b' -> BinNat.N.le n n' -> FixResult_leq eC (runGFix (g b) n) (runGFix (g b') n'). Proof. intros. destruct H. specialize (H4 _ _ H0 H1 H2 _ _ H3). auto. Qed. *) End Laws. *) coq-ext-lib-0.12.0/theories/Data/Monads/IdentityMonad.v000066400000000000000000000005431451523051500225740ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Set Implicit Arguments. Set Maximal Implicit Insertion. Section Ident. Inductive ident A := mkIdent { unIdent : A }. Global Instance Monad_ident : Monad ident := { ret := fun _ v => mkIdent v ; bind := fun _ _ c f => f (unIdent c) }. End Ident. Arguments mkIdent {A} (_). Arguments unIdent {A} (_). coq-ext-lib-0.12.0/theories/Data/Monads/IdentityMonadLaws.v000066400000000000000000000036061451523051500234260ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Require Import Setoid. Require Import ExtLib.Data.Fun. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.MonadLaws. Require Import ExtLib.Data.Monads.IdentityMonad. Set Implicit Arguments. Set Strict Implicit. (* Section with_T. Context {T : Type} (e : type T). Definition equal_ident (a b : ident T) : Prop := equal (unIdent a) (unIdent b). Global Instance type_ident : type (ident T) := { equal := equal_ident ; proper := fun x => proper (unIdent x) }. Global Instance typeOk_ident (tT : typeOk e) : typeOk type_ident. Proof. constructor. { unfold equal, proper, type_ident, equal_ident; simpl; intros. apply only_proper; auto. } { red. destruct x. intros. red; simpl. red; simpl. eapply preflexive with (wf := proper); eauto with typeclass_instances. } { red. simpl. unfold equal_ident. intros. symmetry. assumption. } { red; simpl. unfold equal_ident. intros. etransitivity; eassumption. } Qed. Global Instance proper_unIdent : proper unIdent. Proof. red; simpl; red; simpl. destruct x; compute; auto. Qed. Global Instance proper_mkIdent : proper mkIdent. Proof. do 7 red. compute; auto. Qed. End with_T. (* Global Instance FunctorOrder_fmleq : FunctorOrder _ (@Identity_leq) _. Proof. constructor; eauto with typeclass_instances. Qed. *) Require Import ExtLib.Tactics.TypeTac. Global Instance MonadLaws_GFix : MonadLaws Monad_ident (@type_ident). Proof. constructor; eauto with typeclass_instances; try solve [ compute; intuition ]. { unfold equal; simpl. intros. red in H2. red; simpl. eapply H2. eapply preflexive with (wf := proper); auto. eapply equiv_prefl; auto. } { unfold proper, equal; simpl. eauto with typeclass_instances. } { simpl; intros. red. solve_equal. } { unfold bind, Monad_ident. do 6 red; intros. solve_equal. } Qed. *) coq-ext-lib-0.12.0/theories/Data/Monads/OptionMonad.v000066400000000000000000000057521451523051500222620ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Set Implicit Arguments. Set Strict Implicit. Import MonadNotation. Local Open Scope monad_scope. Global Instance Monad_option : Monad option := { ret := @Some ; bind := fun _ _ c1 c2 => match c1 with | None => None | Some v => c2 v end }. Global Instance Zero_option : MonadZero option := { mzero := @None }. Global Instance Plus_option : MonadPlus option := { mplus _A _B aM bM := match aM with | None => liftM inr bM | Some a => Some (inl a) end }. Global Instance Exception_option : MonadExc unit option := { raise _ _ := None ; catch _ c h := match c with | None => h tt | Some x => Some x end }. Section Trans. Variable m : Type -> Type. Inductive optionT a := mkOptionT { unOptionT : m (option a) }. Context {M : Monad m}. Global Instance Monad_optionT : Monad optionT := { ret _A := fun x => mkOptionT (ret (Some x)) ; bind _A _B aMM f := mkOptionT (aM <- unOptionT aMM ;; match aM with | None => ret None | Some a => unOptionT (f a) end) }. Global Instance Zero_optionT : MonadZero optionT := { mzero _A := mkOptionT (ret None) }. Global Instance MonadT_optionT : MonadT optionT m := { lift _A aM := mkOptionT (liftM ret aM) }. Global Instance State_optionT {T} (SM : MonadState T m) : MonadState T optionT := { get := lift get ; put v := lift (put v) }. Instance Plus_optionT_right : MonadPlus optionT := { mplus _A _B a b := mkOptionT (bind (unOptionT b) (fun b => match b with | None => bind (unOptionT a) (fun a => match a with | None => ret None | Some a => ret (Some (inl a)) end) | Some b => ret (Some (inr b)) end)) }. Instance Plus_optionT_left : MonadPlus optionT := { mplus _A _B a b := mkOptionT (bind (unOptionT a) (fun a => match a with | None => bind (unOptionT b) (fun b => match b with | None => ret None | Some b => ret (Some (inr b)) end) | Some a => ret (Some (inl a)) end)) }. Global Instance Plus_optionT : MonadPlus optionT := Plus_optionT_left. Global Instance Reader_optionT {T} (SM : MonadReader T m) : MonadReader T optionT := { ask := lift ask ; local _T v cmd := mkOptionT (local v (unOptionT cmd)) }. Instance OptionTError : MonadExc unit optionT := { raise _u _A := mzero ; catch _A aMM f := mkOptionT (aM <- unOptionT aMM ;; match aM with | None => unOptionT (f tt) | Some x => ret (Some x) end) }. End Trans. Arguments mkOptionT {m} {a} (_). Arguments unOptionT {m} {a} (_). coq-ext-lib-0.12.0/theories/Data/Monads/OptionMonadLaws.v000066400000000000000000000273461451523051500231140ustar00rootroot00000000000000Require Import RelationClasses. Require Import Setoid. Require Import ExtLib.Data.Fun. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.MonadLaws. Require Import ExtLib.Data.Option. Require Import ExtLib.Data.Monads.OptionMonad. Set Implicit Arguments. Set Strict Implicit. (* Section Laws. Variable m : Type -> Type. Variable Monad_m : Monad m. Variable mtype : forall T, type T -> type (m T). Variable mtypeOk : forall T (tT : type T), typeOk tT -> typeOk (mtype tT). Variable ML_m : MonadLaws Monad_m mtype. Section parametric. Variable T : Type. Variable tT : type T. Definition optionT_eq (a b : optionT m T) : Prop := equal (unOptionT a) (unOptionT b). Global Instance type_optionT : type (optionT m T) := type_from_equal optionT_eq. Variable tokT : typeOk tT. Global Instance typeOk_readerT : typeOk type_optionT. Proof. eapply typeOk_from_equal. { simpl. unfold optionT_eq. intros. generalize (only_proper _ _ _ H); intros. split; solve_equal. } { red. unfold equal; simpl. unfold optionT_eq; simpl. unfold Morphisms.respectful; simpl. symmetry. auto. } { red. unfold equal; simpl. unfold optionT_eq; simpl. unfold Morphisms.respectful; simpl. intros. etransitivity; eauto. } Qed. Global Instance proper_unOptionT : proper (@unOptionT m T). Proof. do 3 red; eauto. Qed. Global Instance proper_mkOptionT : proper (@mkOptionT m T). Proof. do 5 red; eauto. Qed. End parametric. Theorem equal_match : forall (A B : Type) (eA : type A) (eB : type B), typeOk eA -> typeOk eB -> forall (x y : option A) (a b : B) (f g : A -> B), equal x y -> equal a b -> equal f g -> equal match x with | Some a => f a | None => a end match y with | Some a => g a | None => b end. Proof. destruct x; destruct y; intros; eauto with typeclass_instances; type_tac. { inversion H1. assumption. } { inversion H1. } { inversion H1. } Qed. Instance proper_match : forall (A B : Type) (eA : type A) (eB : type B), typeOk eA -> typeOk eB -> forall (x : option A), proper x -> forall f : A -> optionT m B, proper f -> proper match x with | Some a => unOptionT (f a) | None => ret None end. Proof. destruct x; intros; eauto with typeclass_instances; type_tac. Qed. Global Instance MonadLaws_optionT : MonadLaws (@Monad_optionT _ Monad_m) type_optionT. Proof. constructor. { (* bind_of_return *) intros. do 3 red. unfold bind, optionT_eq; simpl. rewrite bind_of_return; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. } { (* return_of_bind *) simpl; unfold optionT_eq; simpl; intros. rewrite return_of_bind; eauto with typeclass_instances; intros; type_tac. destruct x; type_tac. } { (* bind_associativity *) simpl; unfold optionT_eq; simpl; intros. rewrite bind_associativity; eauto with typeclass_instances; intros; type_tac. destruct x; destruct y; try solve [ inversion H5 ]; type_tac. inversion H5; assumption. eapply equal_match; eauto with typeclass_instances; type_tac. rewrite bind_of_return; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. } { simpl; unfold optionT_eq; simpl; intros. red; simpl; intros. type_tac. } { simpl; unfold optionT_eq; simpl; intros. red; simpl; intros. red; simpl; intros. type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. } Qed. (* Theorem equal_match_option : forall T U (tT : type T) (tU : type U), typeOk tT -> typeOk tU -> forall (a b : option T) (f g : T -> U) (x y : U), equal a b -> equal f g -> equal x y -> equal match a with | Some a => f a | None => x end match b with | Some b => g b | None => y end. Proof. clear. destruct a; destruct b; simpl; intros; try contradiction; auto. Qed. *) Global Instance MonadTLaws_optionT : MonadTLaws _ _ _ _ (@MonadT_optionT _ Monad_m). Proof. constructor. { simpl. unfold optionT_eq; simpl; intros. unfold liftM. rewrite bind_of_return; eauto with typeclass_instances; type_tac. } { simpl; unfold lift, optionT_eq; simpl; intros. unfold liftM. rewrite bind_associativity; eauto with typeclass_instances; type_tac. rewrite bind_associativity; eauto with typeclass_instances; type_tac. rewrite bind_of_return; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. } { unfold lift, liftM; simpl; intros. unfold liftM. red; simpl; intros. unfold optionT_eq; simpl. type_tac. } Qed. Global Instance MonadReaderLaws_optionT (s : Type) (t : type s) (tT : typeOk t) (Mr : MonadReader s m) (MLr : MonadReaderLaws Monad_m _ _ Mr) : MonadReaderLaws _ _ _ (@Reader_optionT _ _ _ Mr). Proof. constructor. { simpl. unfold optionT_eq; simpl; intros; unfold liftM. rewrite local_bind; eauto with typeclass_instances. (erewrite bind_proper; [ | | | | eapply ask_local | ]); eauto with typeclass_instances. rewrite bind_associativity; eauto with typeclass_instances. rewrite bind_associativity; eauto with typeclass_instances. type_tac. 6: eapply preflexive. repeat rewrite bind_of_return; eauto with typeclass_instances. rewrite local_ret; eauto with typeclass_instances. type_tac. type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. apply proper_fun; intros. repeat rewrite local_ret; eauto with typeclass_instances. type_tac; eauto with typeclass_instances. type_tac. type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. type_tac. apply proper_fun; intros. repeat rewrite local_ret; eauto with typeclass_instances. type_tac. eauto with typeclass_instances. type_tac. type_tac. } { simpl. unfold optionT_eq; simpl; intros; unfold liftM. rewrite local_bind; eauto with typeclass_instances. type_tac. destruct x; destruct y; try solve [ inversion H4 ]; type_tac. inversion H4; assumption. rewrite local_ret; eauto with typeclass_instances; type_tac. type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. } { simpl. unfold optionT_eq; simpl; intros; unfold liftM. rewrite local_ret; eauto with typeclass_instances; type_tac. } { simpl. unfold optionT_eq; simpl; intros; unfold liftM. rewrite local_local; eauto with typeclass_instances; type_tac. } { unfold local; simpl; intros. red. red. intros. red in H0. red; simpl. type_tac. } { Opaque lift. unfold ask; simpl; intros. red. type_tac. eapply lift_proper; eauto with typeclass_instances. Transparent lift. } Qed. (* Global Instance MonadStateLaws_optionT (s : Type) (t : type s) (tT : typeOk t) (Ms : MonadState s m) (MLs : MonadStateLaws Monad_m _ _ Ms) : MonadStateLaws _ _ _ (@State_optionT _ _ _ Ms). Proof. constructor. { simpl; unfold optionT_eq; simpl; intros; unfold liftM; simpl. rewrite bind_associativity; eauto with typeclass_instances; type_tac. erewrite bind_proper; eauto with typeclass_instances. 2: instantiate (1 := get); type_tac. instantiate (1 := fun a => bind (put a) (fun x : unit => ret (Some x))). { rewrite <- bind_associativity; eauto with typeclass_instances; type_tac. erewrite bind_proper; eauto with typeclass_instances. 2: eapply get_put; eauto with typeclass_instances. rewrite bind_of_return; eauto with typeclass_instances. instantiate (1 := fun x => ret (Some x)). simpl. type_tac. type_tac. type_tac. } { type_tac. rewrite bind_of_return; eauto with typeclass_instances. type_tac. type_tac. eapply equal_match_option; eauto with typeclass_instances; type_tac. } { eapply equal_match_option; eauto with typeclass_instances; type_tac. } } { simpl; unfold optionT_eq; simpl; intros; unfold liftM; simpl. repeat rewrite bind_associativity; eauto with typeclass_instances; try solve [ type_tac; eapply equal_match_option; eauto with typeclass_instances; type_tac ]. rewrite bind_proper; eauto with typeclass_instances. 2: eapply preflexive; eauto with typeclass_instances; type_tac. instantiate (1 := fun a : unit => bind get (fun x0 : s => ret (Some x0))). { rewrite <- bind_associativity; eauto with typeclass_instances. Require Import MonadTac. { Ltac cl := eauto with typeclass_instances. Ltac tcl := solve [ cl ]. Ltac monad_rewrite t := first [ t | rewrite bind_rw_0; [ | tcl | tcl | tcl | t | type_tac ] | rewrite bind_rw_1 ]. monad_rewrite ltac:(eapply put_get; eauto with typeclass_instances). rewrite bind_associativity; cl; try solve_proper. rewrite bind_rw_1; [ | tcl | tcl | tcl | intros | type_tac ]. Focus 2. etransitivity. eapply bind_of_return; cl; type_tac. instantiate (1 := fun _ => ret (Some x)). simpl. type_tac. Add Parametric Morphism (T : Type) (tT : type T) (tokT : typeOk tT) : (@equal _ tT) with signature (equal ==> equal ==> iff) as equal_mor. Proof. clear - tokT. intros. split; intros. { etransitivity. symmetry; eassumption. etransitivity; eassumption. } { etransitivity; eauto. etransitivity; eauto. symmetry; auto. } Qed. Add Parametric Morphism (T : Type) (tT : type T) (tokT : typeOk tT) : (@equal _ tT) with signature (equal ==> eq ==> iff) as equal_left_mor. Proof. clear - tokT. intros. split; intros. { etransitivity. symmetry; eassumption. eassumption. } { etransitivity; eauto. } Qed. Add Parametric Morphism (T : Type) (tT : type T) (tokT : typeOk tT) : (@equal _ tT) with signature (eq ==> equal ==> iff) as equal_right_mor. Proof. clear - tokT. intros. split; intros. { etransitivity. eassumption. eassumption. } { etransitivity; eauto. symmetry; auto. } Qed. assert (Morphisms.Proper (equal ==> Basics.flip Basics.impl) (equal (bind (put x) (fun _ : unit => ret (Some x))))) by cl. assert (Morphisms.Proper (Morphisms.pointwise_relation unit equal ==> equal) (bind (@put _ _ Ms x))). { red. red. intros. eapply bind_proper; cl. solve_proper. red; simpl. red in H1. red. assert bind_proper. debug eauto with typeclass_instances. setoid_rewrite bind_of_return. 2: rewrite bind_of_return; eauto with typeclass_instances; type_tac. rewrite bind_rw_0 3: instantiate (1 := (bind (put x) (fun _ : unit => get))). Theorem bind_rw_0 : forall A B (tA : type A) (tB : type B), typeOk tA -> typeOk tB -> forall (x z : m A) (y : A -> m B)z, equal x z -> proper y -> equal (bind x y) (bind z y). Proof. } { type_tac. rewrite bind_of_return; eauto with typeclass_instances; type_tac. eapply equal_match_option; eauto with typeclass_instances; type_tac. } } Print MonadStateLaws. *) Global Instance MonadZeroLaws_optionT : MonadZeroLaws (@Monad_optionT _ Monad_m) type_optionT _. Proof. constructor. { simpl; unfold optionT_eq; simpl; intros. rewrite bind_of_return; eauto with typeclass_instances; type_tac. eapply equal_match; eauto with typeclass_instances; type_tac. } { unfold mzero; simpl; intros. red; simpl. type_tac. } Qed. End Laws. *) coq-ext-lib-0.12.0/theories/Data/Monads/ReaderMonad.v000066400000000000000000000054021451523051500222040ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Monoid. Set Implicit Arguments. Set Maximal Implicit Insertion. Section ReaderType. Variable S : Type. Record reader (t : Type) : Type := mkReader { runReader : S -> t }. Global Instance Monad_reader : Monad reader := { ret := fun _ v => mkReader (fun _ => v) ; bind := fun _ _ c1 c2 => mkReader (fun s => let v := runReader c1 s in runReader (c2 v) s) }. Global Instance MonadReader_reader : MonadReader S reader := { ask := mkReader (fun x => x) ; local := fun _ f cmd => mkReader (fun x => runReader cmd (f x)) }. Variable m : Type -> Type. Record readerT (t : Type) : Type := mkReaderT { runReaderT : S -> m t }. Variable M : Monad m. Global Instance Monad_readerT : Monad readerT := { ret := fun _ x => mkReaderT (fun s => @ret _ M _ x) ; bind := fun _ _ c1 c2 => mkReaderT (fun s => @bind _ M _ _ (runReaderT c1 s) (fun v => runReaderT (c2 v) s)) }. Global Instance MonadReader_readerT : MonadReader S readerT := { ask := mkReaderT (fun x => ret x) ; local := fun _ f cmd => mkReaderT (fun x => runReaderT cmd (f x)) }. Global Instance MonadT_readerT : MonadT readerT m := { lift := fun _ c => mkReaderT (fun _ => c) }. Global Instance MonadZero_readerT (MZ : MonadZero m) : MonadZero readerT := { mzero := fun _ => lift mzero }. Global Instance MonadState_readerT T (MS : MonadState T m) : MonadState T readerT := { get := lift get ; put := fun x => lift (put x) }. Global Instance MonadWriter_readerT T (Mon : Monoid T) (MW : MonadWriter Mon m) : MonadWriter Mon readerT := { tell := fun v => lift (tell v) ; listen := fun _ c => mkReaderT (fun s => listen (runReaderT c s)) ; pass := fun _ c => mkReaderT (fun s => pass (runReaderT c s)) }. Global Instance MonadExc_readerT {E} (ME : MonadExc E m) : MonadExc E readerT := { raise := fun _ v => lift (raise v) ; catch := fun _ c h => mkReaderT (fun s => catch (runReaderT c s) (fun x => runReaderT (h x) s)) }. Global Instance MonadPlus_readerT {MP:MonadPlus m} : MonadPlus readerT := { mplus _A _B mA mB := mkReaderT (fun r => mplus (runReaderT mA r) (runReaderT mB r)) }. Global Instance MonadFix_readerT (MF : MonadFix m) : MonadFix readerT := { mfix := fun _ _ r x => mkReaderT (fun s => mfix2 _ (fun f x => runReaderT (r (fun x => mkReaderT (f x)) x)) x s) }. End ReaderType. Arguments mkReaderT {S} {m} {t} _. Arguments MonadWriter_readerT {S} {m} {T} {Mon} (_). Global Instance MonadReader_lift_readerT T S m (R : MonadReader T m) : MonadReader T (readerT S m) := { ask := mkReaderT (fun _ => ask) ; local := fun _ f c => mkReaderT (fun s => local f (runReaderT c s)) }. coq-ext-lib-0.12.0/theories/Data/Monads/ReaderMonadLaws.v000066400000000000000000000056551451523051500230450ustar00rootroot00000000000000Require Import RelationClasses. Require Import Setoid. Require Import ExtLib.Data.Fun. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.MonadLaws. Require Import ExtLib.Data.Monads.ReaderMonad. Set Implicit Arguments. Set Strict Implicit. (* Section Laws. Variable m : Type -> Type. Variable Monad_m : Monad m. Variable mtype : forall T, type T -> type (m T). Variable mtypeOk : forall T (tT : type T), typeOk tT -> typeOk (mtype tT). Variable ML_m : MonadLaws Monad_m mtype. Variable S : Type. Variable type_S : type S. Variable typeOk_S : typeOk type_S. Definition readerT_eq T (tT : type T) (a b : readerT S m T) : Prop := equal (runReaderT a) (runReaderT b). Global Instance type_readerT (T : Type) (tT : type T) : type (readerT S m T) := type_from_equal (readerT_eq tT). Global Instance typeOk_readerT (T : Type) (tT : type T) (tOkT : typeOk tT) : typeOk (type_readerT tT). Proof. eapply typeOk_from_equal. { simpl. unfold readerT_eq. intros. generalize (only_proper _ _ _ H); intros. split; do 4 red; intuition. } { red. unfold equal; simpl. unfold readerT_eq; simpl. unfold Morphisms.respectful; simpl. firstorder. } { red. unfold equal; simpl. unfold readerT_eq; simpl. unfold Morphisms.respectful; simpl. intros. etransitivity. eapply H; eauto. destruct (only_proper _ _ _ H1). eapply H0. eapply preflexive; eauto with typeclass_instances. } Qed. Theorem mproper_red : forall (C : Type) (tC : type C) (o : readerT S m C), proper o -> proper (runReaderT o). Proof. clear. intros. apply H. Qed. Global Instance proper_runReaderT T (tT : type T) : proper (@runReaderT S m T). Proof. repeat red; intros. apply H in H0. apply H0. Qed. Global Instance proper_mkReaderT T (tT : type T) : proper (@mkReaderT S m T). Proof. repeat red; intros. apply H in H0. apply H0. Qed. Ltac unfold_readerT := red; simpl; intros; do 2 (red; simpl); intros. Global Instance MonadLaws_readerT : MonadLaws (@Monad_readerT S _ Monad_m) _. Proof. constructor. { (* bind_of_return *) unfold_readerT. erewrite bind_of_return; eauto with typeclass_instances; type_tac. } { (* return_of_bind *) unfold_readerT. rewrite return_of_bind; intros; eauto with typeclass_instances. intros. eapply H0. eassumption. } { (* bind_associativity *) unfold_readerT. rewrite bind_associativity; eauto with typeclass_instances; type_tac. } { unfold_readerT. red; intros. type_tac. } { intros. unfold bind; simpl. red; intros. red; intros. red; simpl. red; simpl; intros. solve_equal. } Qed. (* Global Instance MonadTLaws_readerT : @MonadTLaws (readerT S m) (@Monad_readerT S m _) r_mleq m Monad_m (@MonadT_readerT _ m). Proof. constructor; intros; simpl; eapply lower_meq; unfold liftM; simpl; monad_norm; reflexivity. Qed. *) End Laws. *) coq-ext-lib-0.12.0/theories/Data/Monads/StateMonad.v000066400000000000000000000074551451523051500220740ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Monoid. Set Implicit Arguments. Set Strict Implicit. Section StateType. Variable S : Type. Record state (t : Type) : Type := mkState { runState : S -> t * S }. Definition evalState {t} (c : state t) (s : S) : t := fst (runState c s). Definition execState {t} (c : state t) (s : S) : S := snd (runState c s). Global Instance Monad_state : Monad state := { ret := fun _ v => mkState (fun s => (v, s)) ; bind := fun _ _ c1 c2 => mkState (fun s => let (v,s) := runState c1 s in runState (c2 v) s) }. Global Instance MonadState_state : MonadState S state := { get := mkState (fun x => (x,x)) ; put := fun v => mkState (fun _ => (tt, v)) }. Variable m : Type -> Type. Record stateT (t : Type) : Type := mkStateT { runStateT : S -> m (t * S)%type }. Variable M : Monad m. Definition evalStateT {t} (c : stateT t) (s : S) : m t := bind (runStateT c s) (fun x => ret (fst x)). Definition execStateT {t} (c : stateT t) (s : S) : m S := bind (runStateT c s) (fun x => ret (snd x)). (** [Monad_stateT] is not a Global Instance because it can cause an infinite loop in typeclass inference under certain circumstances. Use [Existing Instance Monad_stateT.] to bring the instance into context. *) Instance Monad_stateT : Monad stateT := { ret := fun _ x => mkStateT (fun s => @ret _ M _ (x,s)) ; bind := fun _ _ c1 c2 => mkStateT (fun s => @bind _ M _ _ (runStateT c1 s) (fun vs => let (v,s) := vs in runStateT (c2 v) s)) }. Global Instance MonadState_stateT : MonadState S stateT := { get := mkStateT (fun x => ret (x,x)) ; put := fun v => mkStateT (fun _ => ret (tt, v)) }. Global Instance MonadT_stateT : MonadT stateT m := { lift := fun _ c => mkStateT (fun s => bind c (fun t => ret (t, s))) }. Global Instance State_State_stateT T (MS : MonadState T m) : MonadState T stateT := { get := lift get ; put := fun x => lift (put x) }. Global Instance MonadReader_stateT T (MR : MonadReader T m) : MonadReader T stateT := { ask := mkStateT (fun s => bind ask (fun t => ret (t, s))) ; local := fun _ f c => mkStateT (fun s => local f (runStateT c s)) }. Global Instance MonadWriter_stateT T (Mon : Monoid T) (MR : MonadWriter Mon m) : MonadWriter Mon stateT := { tell := fun x => mkStateT (fun s => bind (tell x) (fun v => ret (v, s))) ; listen := fun _ c => mkStateT (fun s => bind (listen (runStateT c s)) (fun x => let '(a,s,t) := x in ret (a,t,s))) ; pass := fun _ c => mkStateT (fun s => bind (runStateT c s) (fun x => let '(a,t,s) := x in pass (ret ((a,s),t)))) }. Global Instance Exc_stateT T (MR : MonadExc T m) : MonadExc T stateT := { raise := fun _ e => lift (raise e) ; catch := fun _ body hnd => mkStateT (fun s => catch (runStateT body s) (fun e => runStateT (hnd e) s)) }. Global Instance MonadZero_stateT (MR : MonadZero m) : MonadZero stateT := { mzero _A := lift mzero }. Global Instance MonadFix_stateT (MF : MonadFix m) : MonadFix stateT := { mfix := fun _ _ r v => mkStateT (fun s => mfix2 _ (fun r v s => runStateT (mkStateT (r v)) s) v s) }. Global Instance MonadPlus_stateT (MP : MonadPlus m) : MonadPlus stateT := { mplus _A _B a b := mkStateT (fun s => bind (mplus (runStateT a s) (runStateT b s)) (fun res => match res with | inl (a,s) => ret (inl a, s) | inr (b,s) => ret (inr b, s) end)) }. End StateType. Arguments mkStateT {S} {m} {t} (_). Arguments evalState {S} {t} (c) (s). Arguments execState {S} {t} (c) (s). Arguments evalStateT {S} {m} {M} {t} (c) (s). Arguments execStateT {S} {m} {M} {t} (c) (s). Arguments MonadWriter_stateT {S} {m} {_} {T} {Mon} (_). coq-ext-lib-0.12.0/theories/Data/Monads/WriterMonad.v000066400000000000000000000135511451523051500222620ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.Monoid. Require Import ExtLib.Data.PPair. Require Import ExtLib.Data.Monads.IdentityMonad. Require Import Coq.Program.Basics. (* for (∘) *) Set Implicit Arguments. Set Maximal Implicit Insertion. Set Universe Polymorphism. Set Printing Universes. Section WriterType. Polymorphic Universe s d c. Variable S : Type@{s}. Record writerT (Monoid_S : Monoid@{s} S) (m : Type@{d} -> Type@{c}) (t : Type@{d}) : Type := mkWriterT { runWriterT : m (pprod t S)%type }. Variable Monoid_S : Monoid S. Variable m : Type@{d} -> Type@{c}. Context {M : Monad m}. Arguments mkWriterT _ [_ _] _. Definition execWriterT {T} (c : writerT Monoid_S m T) : m S := bind (runWriterT c) (fun (x : pprod T S) => ret (psnd x)). Definition evalWriterT {T} (c : writerT Monoid_S m T) : m T := bind (runWriterT c) (fun (x : pprod T S) => ret (pfst x)). Local Notation "( x , y )" := (ppair x y). Global Instance Monad_writerT : Monad (writerT Monoid_S m) := { ret := fun _ x => mkWriterT _ (@ret _ M _ (x, monoid_unit Monoid_S)) ; bind := fun _ _ c1 c2 => mkWriterT _ ( @bind _ M _ _ (runWriterT c1) (fun v => bind (runWriterT (c2 (pfst v))) (fun v' => ret (pfst v', monoid_plus Monoid_S (psnd v) (psnd v'))))) }. Global Instance Writer_writerT : MonadWriter Monoid_S (writerT Monoid_S m) := { tell := fun x => mkWriterT _ (ret (tt, x)) ; listen := fun _ c => mkWriterT _ (bind (runWriterT c) (fun x => ret (pair (pfst x) (psnd x), psnd x))) ; pass := fun _ c => mkWriterT _ (bind (runWriterT c) (fun x => ret (let '(ppair (pair x ss) s) := x in (x, ss s)))) }. Global Instance MonadT_writerT : MonadT (writerT Monoid_S m) m := { lift := fun _ c => mkWriterT _ (bind c (fun x => ret (x, monoid_unit Monoid_S))) }. Global Instance Reader_writerT {S'} (MR : MonadReader S' m) : MonadReader S' (writerT Monoid_S m) := { ask := mkWriterT _ (bind ask (fun v => @ret _ M _ (v, monoid_unit Monoid_S))) ; local := fun _ f c => mkWriterT _ (local f (runWriterT c)) }. Global Instance State_writerT {S'} (MR : MonadState S' m) : MonadState S' (writerT Monoid_S m) := { get := lift get ; put := fun v => lift (put v) }. Global Instance Zero_writerT (MZ : MonadZero m) : MonadZero (writerT Monoid_S m) := { mzero := fun _ => lift mzero }. Global Instance Exception_writerT {E} (ME : MonadExc E m) : MonadExc E (writerT Monoid_S m) := { raise := fun _ v => lift (raise v) ; catch := fun _ c h => mkWriterT _ (catch (runWriterT c) (fun x => runWriterT (h x))) }. Global Instance Writer_writerT_pass {T} {MonT : Monoid T} {M : Monad m} {MW : MonadWriter MonT m} : MonadWriter MonT (writerT Monoid_S m) := { tell := fun x => mkWriterT _ (bind (tell x) (fun x => ret (x, monoid_unit Monoid_S))) ; listen := fun _ c => mkWriterT _ (bind (m:=m) (@listen _ _ _ MW _ (runWriterT c)) (fun x => let '(pair (ppair a t) s) := x in ret (m:=m) (pair a s,t))) ; pass := fun _ c => mkWriterT _ (@pass _ _ _ MW _ (bind (m:=m) (runWriterT c) (fun x => let '(ppair (pair a t) s) := x in ret (m:=m) (pair (ppair a s) t)))) }. End WriterType. Arguments mkWriterT {_} _ {_ _} _. Arguments runWriterT {S} {Monoid_S} {m} {t} _. Arguments evalWriterT {S} {Monoid_S} {m} {M} {T} _. Arguments execWriterT {S} {Monoid_S} {m} {M} {T} _. Local Open Scope program_scope. Section MapWriterT. Variable W W': Type. Variable Monoid_W : Monoid W. Variable Monoid_W' : Monoid W'. Variable m n : Type -> Type. Variable A B: Type. (** Map both the return value and output of a computation using the given function. [[ 'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m) ]] *) Definition mapWriterT (f: m (pprod A W) -> n (pprod B W')) : writerT Monoid_W m A -> writerT Monoid_W' n B := mkWriterT Monoid_W' ∘ f ∘ runWriterT. End MapWriterT. Section CastWriterT. Variable W : Type. Variable Monoid_W Monoid_W': Monoid W. Variable m : Type -> Type. Variable A : Type. (* Special case of mapWriterT where mapping function is identity * Note: This function changes the `Monoid` instance. *) Definition castWriterT : writerT Monoid_W m A -> writerT Monoid_W' m A := mkWriterT Monoid_W' ∘ runWriterT. End CastWriterT. (** Simple wrapper around `writerT` specializing the underlying monad to `Identity` which yields the `writer` monad. **) Section WriterMonad. Variable W: Type. Variable Monoid_W : Monoid W. Variable A: Type. Definition writer : Type -> Type := writerT Monoid_W ident. Definition runWriter : writer A -> pprod A W := unIdent ∘ (@runWriterT W Monoid_W ident A). Definition execWriter : writer A -> W := psnd ∘ runWriter. Definition evalWriter : writer A -> A := pfst ∘ runWriter. End WriterMonad. Section MapWriter. Variable W W' : Type. Variable Monoid_W: Monoid W. Variable Monoid_W': Monoid W'. Variable A B: Type. (** Map both the return value and output of a computation using the given function. [[ 'runWriter' ('mapWriter' f m) = f ('runWriter' m) ]] *) Definition mapWriter (f: pprod A W -> pprod B W') : writer Monoid_W A -> writer Monoid_W' B := mapWriterT Monoid_W' ident B (mkIdent ∘ f ∘ unIdent). End MapWriter. Section CastWriter. Variable W : Type. Variable Monoid_W Monoid_W': Monoid W. Variable A : Type. (* Special case of mapWriter where mapping function is identity *) Definition castWriter : writer Monoid_W A -> writer Monoid_W' A := castWriterT Monoid_W' (m:=ident). End CastWriter. coq-ext-lib-0.12.0/theories/Data/N.v000066400000000000000000000000271451523051500167750ustar00rootroot00000000000000Require Import BinPos. coq-ext-lib-0.12.0/theories/Data/Nat.v000066400000000000000000000044641451523051500173330ustar00rootroot00000000000000Require Coq.Arith.Arith. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Structures.Monoid. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Tactics.Injection. Set Implicit Arguments. Set Strict Implicit. Global Instance RelDec_eq : RelDec (@eq nat) := { rel_dec := Nat.eqb }. Global Instance RelDec_lt : RelDec lt := { rel_dec := Nat.ltb }. Global Instance RelDec_le : RelDec le := { rel_dec := Nat.leb }. Global Instance RelDec_gt : RelDec gt := { rel_dec := fun x y => Nat.ltb y x }. Global Instance RelDec_ge : RelDec ge := { rel_dec := fun x y => Nat.leb y x }. Global Instance RelDecCorrect_eq : RelDec_Correct RelDec_eq. Proof. constructor; simpl. apply PeanoNat.Nat.eqb_eq. Qed. Global Instance RelDecCorrect_lt : RelDec_Correct RelDec_lt. Proof. constructor; simpl. eapply PeanoNat.Nat.ltb_lt. Qed. Global Instance RelDecCorrect_le : RelDec_Correct RelDec_le. Proof. constructor; simpl. eapply PeanoNat.Nat.leb_le. Qed. Global Instance RelDecCorrect_gt : RelDec_Correct RelDec_gt. Proof. constructor; simpl. unfold rel_dec; simpl. intros. eapply PeanoNat.Nat.ltb_lt. Qed. Global Instance RelDecCorrect_ge : RelDec_Correct RelDec_ge. Proof. constructor; simpl. unfold rel_dec; simpl. intros. eapply PeanoNat.Nat.leb_le. Qed. Inductive R_nat_S : nat -> nat -> Prop := | R_S : forall n, R_nat_S n (S n). Theorem wf_R_S : well_founded R_nat_S. Proof. red; induction a; constructor; intros. inversion H. inversion H; subst; auto. Defined. Inductive R_nat_lt : nat -> nat -> Prop := | R_lt : forall n m, n < m -> R_nat_lt n m. Theorem wf_R_lt : well_founded R_nat_lt. Proof. red; induction a; constructor; intros. { inversion H. exfalso. subst. inversion H0. } { inversion H; clear H; subst. inversion H0; clear H0; subst; auto. inversion IHa. eapply H. constructor. eapply H1. } Defined. Definition Monoid_nat_plus : Monoid nat := {| monoid_plus := plus ; monoid_unit := 0 |}. Definition Monoid_nat_mult : Monoid nat := {| monoid_plus := mult ; monoid_unit := 1 |}. Global Instance Injective_S (a b : nat) : Injective (S a = S b). refine {| result := a = b |}. abstract (inversion 1; auto). Defined. Definition nat_get_eq (n m : nat) (pf : unit -> n = m) : n = m := match PeanoNat.Nat.eq_dec n m with | left pf => pf | right bad => match bad (pf tt) with end end. coq-ext-lib-0.12.0/theories/Data/Option.v000066400000000000000000000123061451523051500200530ustar00rootroot00000000000000Require Import Coq.Relations.Relation_Definitions. Require Import Coq.Classes.RelationClasses. Require Import Coq.Classes.Morphisms. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Structures.Traversable. Require Import ExtLib.Structures.Applicative. Require Import ExtLib.Structures.Functor. Require Import ExtLib.Structures.FunctorLaws. Require Import ExtLib.Data.Fun. Require Import ExtLib.Tactics.Injection. Require Import ExtLib.Tactics.Consider. Set Implicit Arguments. Set Strict Implicit. (** For backwards compatibility with hint locality attributes. *) Set Warnings "-unsupported-attributes". Global Instance Foldable_option {T} : Foldable (option T) T := fun _ f d v => match v with | None => d | Some x => f x d end. Global Instance Traversable_option : Traversable option := {| mapT := fun F _ _ _ f o => match o with | None => pure None | Some o => ap (pure (@Some _)) (f o) end |}. Global Instance Applicative_option : Applicative option := {| pure := @Some ; ap := fun _ _ f x => match f , x with | Some f , Some x => Some (f x) | _ , _ => None end |}. Global Instance Functor_option : Functor option := {| fmap := fun _ _ f x => match x with | None => None | Some x => Some (f x) end |}. Section relation. Context {T : Type}. Variable (R : relation T). Inductive Roption : Relation_Definitions.relation (option T) := | Roption_None : Roption None None | Roption_Some : forall x y, R x y -> Roption (Some x) (Some y). Lemma Reflexive_Roption : Reflexive R -> Reflexive Roption. Proof. clear. compute. destruct x; try constructor; auto. Qed. Lemma Symmetric_Roption : Symmetric R -> Symmetric Roption. Proof. clear. compute. intros. destruct H0; constructor. auto. Qed. Lemma Transitive_Roption : Transitive R -> Transitive Roption. Proof. clear. compute. intros. destruct H0; auto. inversion H1. constructor; auto. subst. eapply H; eassumption. Qed. Global Instance Injective_Roption_None : Injective (Roption None None). refine {| result := True |}. auto. Defined. Global Instance Injective_Roption_None_Some a : Injective (Roption None (Some a)). refine {| result := False |}. inversion 1. Defined. Global Instance Injective_Roption_Some_None a : Injective (Roption (Some a) None). refine {| result := False |}. inversion 1. Defined. Global Instance Injective_Roption_Some_Some a b : Injective (Roption (Some a) (Some b)). refine {| result := R a b |}. inversion 1. auto. Defined. Global Instance Injective_Proper_Roption_Some x : Injective (Proper Roption (Some x)). refine {| result := R x x |}. abstract (inversion 1; assumption). Defined. End relation. (* Global Instance FunctorLaws_option : FunctorLaws Functor_option type_option. Proof. constructor. { simpl. red. destruct x; destruct y; simpl; auto. inversion 1; simpl. red in H0. unfold id. constructor. etransitivity. eapply H0. 2: eauto. eapply proper_left; eauto. inversion 1. } { intros. simpl in *. red. intros. destruct H4; simpl. - unfold compose. constructor. - unfold compose. constructor. eapply H3. eapply H2. assumption. } { intros; simpl in *. red. red. inversion 2. constructor. constructor. apply H1. assumption. } Qed. *) Global Instance Injective_Some (T : Type) (a b : T) : Injective (Some a = Some b) := { result := a = b ; injection := fun P : Some a = Some b => match P with | eq_refl => eq_refl end }. Require ExtLib.Core.EquivDec. Global Instance EqDec_option (T : Type) (EDT : EquivDec.EqDec T (@eq T)) : EquivDec.EqDec (option T) (@eq _). Proof. red. unfold Equivalence.equiv, RelationClasses.complement. intros. change (x = y -> False) with (x <> y). decide equality. apply EDT. Qed. Section OptionEq. Variable T : Type. Variable EDT : RelDec (@eq T). (** Specialization for equality **) Global Instance RelDec_eq_option : RelDec (@eq (option T)) := { rel_dec := fun x y => match x , y with | None , None => true | Some x , Some y => eq_dec x y | _ , _ => false end }. Variable EDCT : RelDec_Correct EDT. Global Instance RelDec_Correct_eq_option : RelDec_Correct RelDec_eq_option. Proof. constructor; destruct x; destruct y; split; simpl in *; intros; try congruence; f_equal; try match goal with | [ H : context [ eq_dec ?X ?Y ] |- _ ] => consider (eq_dec X Y) | [ |- context [ eq_dec ?X ?Y ] ] => consider (eq_dec X Y) end; auto; congruence. Qed. End OptionEq. Lemma eq_option_eq : forall T (a b : T) (pf : a = b) (F : _ -> Type) val, match pf in _ = x return option (F x) with | eq_refl => val end = match val with | None => None | Some val => Some match pf in _ = x return F x with | eq_refl => val end end. Proof. destruct pf. destruct val; reflexivity. Defined. #[global] Hint Rewrite eq_option_eq : eq_rw. coq-ext-lib-0.12.0/theories/Data/PList.v000066400000000000000000000165671451523051500176530ustar00rootroot00000000000000Require Import ExtLib.Structures.Functor. Require Import ExtLib.Structures.Applicative. Require Import ExtLib.Data.POption. Require Import ExtLib.Data.PPair. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Tactics.Injection. Require Import Coq.Bool.Bool. Set Universe Polymorphism. Set Primitive Projections. Section plist. Polymorphic Universe i. Variable T : Type@{i}. Polymorphic Inductive plist : Type@{i} := | pnil | pcons : T -> plist -> plist. Polymorphic Fixpoint length (ls : plist) : nat := match ls with | pnil => 0 | pcons _ ls' => S (length ls') end. Polymorphic Fixpoint app (ls ls' : plist) : plist := match ls with | pnil => ls' | pcons l ls => pcons l (app ls ls') end. Polymorphic Definition hd (ls : plist) : poption T := match ls with | pnil => pNone | pcons x _ => pSome x end. Polymorphic Definition tl (ls : plist) : plist := match ls with | pnil => ls | pcons _ ls => ls end. Polymorphic Fixpoint pIn (a : T) (l : plist) : Prop := match l with | pnil => False | pcons b m => b = a \/ pIn a m end. Polymorphic Inductive pNoDup : plist -> Prop := pNoDup_nil : pNoDup pnil | pNoDup_cons : forall (x : T) (l : plist), ~ pIn x l -> pNoDup l -> pNoDup (pcons x l). Polymorphic Fixpoint inb {RelDecA : RelDec (@eq T)} (x : T) (lst : plist) := match lst with | pnil => false | pcons l ls => if x ?[ eq ] l then true else inb x ls end. Polymorphic Fixpoint anyb (p : T -> bool) (ls : plist) : bool := match ls with | pnil => false | pcons l ls0 => if p l then true else anyb p ls0 end. Polymorphic Fixpoint allb (p : T -> bool) (lst : plist) : bool := match lst with | pnil => true | pcons l ls => if p l then allb p ls else false end. Polymorphic Fixpoint nodup {RelDecA : RelDec (@eq T)} (lst : plist) := match lst with | pnil => true | pcons l ls => andb (negb (inb l ls)) (nodup ls) end. Polymorphic Fixpoint nth_error (ls : plist) (n : nat) : poption T := match n , ls with | 0 , pcons l _ => pSome l | S n , pcons _ ls => nth_error ls n | _ , _ => pNone end. Section folds. Polymorphic Universe j. Context {U : Type@{j}}. Variable f : T -> U -> U. Polymorphic Fixpoint fold_left (acc : U) (ls : plist) : U := match ls with | pnil => acc | pcons l ls => fold_left (f l acc) ls end. Polymorphic Fixpoint fold_right (ls : plist) (rr : U) : U := match ls with | pnil => rr | pcons l ls => f l (fold_right ls rr) end. End folds. End plist. Arguments pnil {_}. Arguments pcons {_} _ _. Arguments app {_} _ _. Arguments pIn {_} _ _. Arguments pNoDup {_} _. Arguments anyb {_} _ _. Arguments allb {_} _ _. Arguments inb {_ _} _ _. Arguments nodup {_ _} _. Arguments fold_left {_ _} _ _ _. Arguments fold_right {_ _} _ _ _. Arguments nth_error {_} _ _. Section plistFun. Polymorphic Fixpoint split {A B : Type} (lst : plist (pprod A B)) := match lst with | pnil => (pnil, pnil) | pcons (ppair x y) tl => let (left, right) := split tl in (pcons x left, pcons y right) end. Lemma pIn_split_l {A B : Type} (lst : plist (pprod A B)) (p : pprod A B) (H : pIn p lst) : (pIn (pfst p) (fst (split lst))). Proof. destruct p; simpl. induction lst; simpl in *. + destruct H. + destruct t; simpl. destruct (split lst); simpl. destruct H as [H | H]. { inv_all. tauto. } { tauto. } Qed. Lemma pIn_split_r {A B : Type} (lst : plist (pprod A B)) (p : pprod A B) (H : pIn p lst) : (pIn (psnd p) (snd (split lst))). Proof. destruct p; simpl. induction lst; simpl in *. + destruct H. + destruct t; simpl. destruct (split lst); simpl. destruct H. { inv_all; tauto. } { tauto. } Qed. Lemma pIn_app_iff (A : Type) (l l' : plist A) (a : A) : pIn a (app l l') <-> pIn a l \/ pIn a l'. Proof. induction l; simpl; intuition congruence. Qed. End plistFun. Section plistOk. Context {A : Type}. Context {RelDecA : RelDec (@eq A)}. Context {RelDecA_Correct : RelDec_Correct RelDecA}. Lemma inb_sound (x : A) (lst : plist A) (H : inb x lst = true) : pIn x lst. Proof. induction lst; simpl in *; try congruence. consider (x ?[ eq ] t); intros; subst. + left; reflexivity. + right; apply IHlst; assumption. Qed. Lemma inb_complete (x : A) (lst : plist A) (H : pIn x lst) : inb x lst = true. Proof. induction lst; simpl in *; try intuition congruence. consider (x ?[ eq ] t); intros; destruct H as [H | H]; try congruence. apply IHlst; assumption. Qed. Lemma nodup_sound (lst : plist A) (H : nodup lst = true) : pNoDup lst. Proof. induction lst. + constructor. + simpl in *. rewrite andb_true_iff in H; destruct H as [H1 H2]. rewrite negb_true_iff in H1. constructor. * intro H. apply inb_complete in H. intuition congruence. * apply IHlst; assumption. Qed. Lemma nodup_complete (lst : plist A) (H : pNoDup lst) : nodup lst = true. Proof. induction lst. + constructor. + simpl in *. rewrite andb_true_iff. inversion H; subst; split; clear H. * apply eq_true_not_negb. intros H; apply H2. apply inb_sound; assumption. * apply IHlst; assumption. Qed. End plistOk. Section pmap. Polymorphic Universe i j. Context {T : Type@{i}}. Context {U : Type@{j}}. Variable f : T -> U. Polymorphic Fixpoint fmap_plist (ls : plist@{i} T) : plist@{j} U := match ls with | pnil => pnil | pcons l ls => pcons (f l) (fmap_plist ls) end. End pmap. Polymorphic Definition Functor_plist@{i} : Functor@{i i} plist@{i} := {| fmap := @fmap_plist@{i i} |}. #[global] Existing Instance Functor_plist. Section applicative. Polymorphic Universe i j. Context {T : Type@{i}} {U : Type@{j}}. Polymorphic Fixpoint ap_plist (fs : plist@{i} (T -> U)) (xs : plist@{i} T) : plist@{j} U := match fs with | pnil => pnil | pcons f fs => app@{j} (fmap_plist@{i j} f xs) (ap_plist fs xs) end. End applicative. Polymorphic Definition Applicative_plist@{i} : Applicative@{i i} plist@{i} := {| pure := fun _ val => pcons val pnil ; ap := @ap_plist |}. Section PListEq. Polymorphic Universe i. Variable T : Type@{i}. Variable EDT : RelDec (@eq T). Polymorphic Fixpoint plist_eqb (ls rs : plist T) : bool := match ls , rs with | pnil , pnil => true | pcons l ls , pcons r rs => if l ?[ eq ] r then plist_eqb ls rs else false | _ , _ => false end. (** Specialization for equality **) Global Polymorphic Instance RelDec_eq_plist : RelDec (@eq (plist T)) := { rel_dec := plist_eqb }. Variable EDCT : RelDec_Correct EDT. Global Polymorphic Instance RelDec_Correct_eq_plist : RelDec_Correct RelDec_eq_plist. Proof. constructor; induction x; destruct y; split; simpl in *; intros; repeat match goal with | [ H : context [ rel_dec ?X ?Y ] |- _ ] => consider (rel_dec X Y); intros; subst | [ |- context [ rel_dec ?X ?Y ] ] => consider (rel_dec X Y); intros; subst end; try solve [ auto | exfalso; clear - H; inversion H ]. - f_equal. eapply IHx. eapply H0. - inversion H. subst. eapply IHx. reflexivity. - inversion H. exfalso. eapply H0. assumption. Qed. End PListEq. coq-ext-lib-0.12.0/theories/Data/POption.v000066400000000000000000000046351451523051500202010ustar00rootroot00000000000000Require Import ExtLib.Structures.Functor. Require Import ExtLib.Structures.Applicative. Require Import ExtLib.Tactics.Injection. Set Universe Polymorphism. Set Printing Universes. Section poption. Universe i. Variable T : Type@{i}. Inductive poption : Type@{i} := | pSome : T -> poption | pNone. Global Instance Injective_pSome@{} a b : Injective (pSome a = pSome b) := { result := a = b ; injection := fun pf => match pf in _ = X return a = match X with | pSome y => y | _ => a end with | eq_refl => eq_refl end }. Global Instance Injective_pSome_pNone a : Injective (pSome a = pNone) := { result := False ; injection := fun pf => match pf in _ = X return match X return Prop with | pSome y => True | _ => False end with | eq_refl => I end }. Global Instance Injective_pNone_pSome@{} a : Injective (pNone = pSome a) := { result := False ; injection := fun pf => match pf in _ = X return match X return Prop with | pNone => True | _ => False end with | eq_refl => I end }. End poption. Arguments pSome {_} _. Arguments pNone {_}. Section poption_map. Universes i j. Context {T : Type@{i}} {U : Type@{j}}. Variable f : T -> U. Definition fmap_poption@{} (x : poption@{i} T) : poption@{j} U := match x with | pNone => pNone@{j} | pSome x => pSome@{j} (f x) end. Definition ap_poption@{} (f : poption@{i} (T -> U)) (x : poption@{i} T) : poption@{j} U := match f , x with | pSome f , pSome x => pSome (f x) | _ , _ => pNone end. End poption_map. Definition Functor_poption@{i} : Functor@{i i} poption@{i} := {| fmap := @fmap_poption@{i i} |}. #[global] Existing Instance Functor_poption. Definition Applicative_poption@{i} : Applicative@{i i} poption@{i} := {| pure := @pSome@{i} ; ap := @ap_poption |}. #[global] Existing Instance Applicative_poption. coq-ext-lib-0.12.0/theories/Data/PPair.v000066400000000000000000000051241451523051500176160ustar00rootroot00000000000000Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.Injection. Set Printing Universes. Set Primitive Projections. Set Universe Polymorphism. Section pair. Polymorphic Universes i j. Variable (T : Type@{i}) (U : Type@{j}). Polymorphic Record pprod : Type@{max (i, j)} := ppair { pfst : T ; psnd : U }. End pair. Arguments pprod _ _ : assert. Arguments ppair {_ _} _ _. Arguments pfst {_ _} _. Arguments psnd {_ _} _. Polymorphic Lemma eq_pair_rw : forall T U (a b : T) (c d : U) (pf : (ppair a c) = (ppair b d)), exists (pf' : a = b) (pf'' : c = d), pf = match pf' , pf'' with | eq_refl , eq_refl => eq_refl end. Proof. clear. intros. exists (f_equal pfst pf). exists (f_equal psnd pf). change (pf = match @f_equal (pprod T U) T (@pfst T U) (ppair a c) (ppair b d) pf in (_ = t) return ((ppair a c) = (ppair t d)) with | eq_refl => match @f_equal (pprod T U) U (@psnd T U) (ppair a c) (ppair b d) pf in (_ = u) return ((ppair a c) = (ppair (pfst (ppair a c)) u)) with | eq_refl => @eq_refl (pprod T U) (ppair a c) end end). generalize dependent (ppair a c). intros; subst. reflexivity. Defined. Section Injective. Polymorphic Universes i j. Context {T : Type@{i}} {U : Type@{j}}. Global Instance Injective_pprod (a : T) (b : U) c d : Injective (ppair a b = ppair c d). Proof. refine {| result := a = c /\ b = d |}. intros. change a with (pfst@{i j} {| pfst := a ; psnd := b |}). change b with (psnd@{i j} {| pfst := a ; psnd := b |}) at 2. rewrite H. split; reflexivity. Defined. End Injective. Section PProdEq. Polymorphic Universes i j. Context {T : Type@{i}} {U : Type@{j}}. Context {EDT : RelDec (@eq T)}. Context {EDU : RelDec (@eq U)}. Context {EDCT : RelDec_Correct EDT}. Context {EDCU : RelDec_Correct EDU}. Polymorphic Definition ppair_eqb (p1 p2 : pprod T U) : bool := pfst p1 ?[ eq ] pfst p2 && psnd p1 ?[ eq ] psnd p2. (** Specialization for equality **) Global Polymorphic Instance RelDec_eq_ppair : RelDec (@eq (@pprod T U)) := { rel_dec := ppair_eqb }. Global Polymorphic Instance RelDec_Correct_eq_ppair : RelDec_Correct RelDec_eq_ppair. Proof. constructor. intros p1 p2. destruct p1, p2. simpl. unfold ppair_eqb. simpl. rewrite Bool.andb_true_iff. repeat rewrite rel_dec_correct. split. { destruct 1. f_equal; assumption. } { intros. inv_all. tauto. } Qed. End PProdEq. coq-ext-lib-0.12.0/theories/Data/Pair.v000066400000000000000000000074661451523051500175110ustar00rootroot00000000000000Require Import Coq.Relations.Relation_Definitions. Require Import Coq.Classes.RelationClasses. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Tactics.Injection. Set Implicit Arguments. Set Strict Implicit. Section Eqpair. Context {T U} (rT : relation T) (rU : relation U). Inductive Eqpair : relation (T * U) := | Eqpair_both : forall a b c d, rT a b -> rU c d -> Eqpair (a,c) (b,d). Global Instance Reflexive_Eqpair {RrT : Reflexive rT} {RrU : Reflexive rU} : Reflexive Eqpair. Proof. red. destruct x. constructor; reflexivity. Qed. Global Instance Symmetric_Eqpair {RrT : Symmetric rT} {RrU : Symmetric rU} : Symmetric Eqpair. Proof. red. inversion 1; constructor; symmetry; assumption. Qed. Global Instance Transitive_Eqpair {RrT : Transitive rT} {RrU : Transitive rU} : Transitive Eqpair. Proof. red. inversion 1; inversion 1; constructor; etransitivity; eauto. Qed. Global Instance Injective_Eqpair a b c d : Injective (Eqpair (a,b) (c,d)). refine {| result := rT a c /\ rU b d |}. abstract (inversion 1; auto). Defined. End Eqpair. Section PairWF. Variables T U : Type. Variable RT : T -> T -> Prop. Variable RU : U -> U -> Prop. Inductive R_pair : T * U -> T * U -> Prop := | L : forall l l' r r', RT l l' -> R_pair (l,r) (l',r') | R : forall l r r', RU r r' -> R_pair (l,r) (l,r'). Hypothesis wf_RT : well_founded RT. Hypothesis wf_RU : well_founded RU. Theorem wf_R_pair : well_founded R_pair. Proof. red. intro x. destruct x. generalize dependent u. apply (well_founded_ind wf_RT (fun t => forall u : U, Acc R_pair (t, u))) . do 2 intro. apply (well_founded_ind wf_RU (fun u => Acc R_pair (x,u))). intros. constructor. destruct y. remember (t0,u). remember (x,x0). inversion 1; subst; inversion H4; inversion H3; clear H4 H3; subst; eauto. Defined. End PairWF. Section PairParam. Variable T : Type. Variable eqT : T -> T -> Prop. Variable U : Type. Variable eqU : U -> U -> Prop. Variable EDT : RelDec eqT. Variable EDU : RelDec eqU. Global Instance RelDec_equ_pair : RelDec (fun x y => eqT (fst x) (fst y) /\ eqU (snd x) (snd y)) := { rel_dec := fun x y => if rel_dec (fst x) (fst y) then rel_dec (snd x) (snd y) else false }. Variable EDCT : RelDec_Correct EDT. Variable EDCU : RelDec_Correct EDU. Global Instance RelDec_Correct_equ_pair : RelDec_Correct RelDec_equ_pair. Proof. constructor; destruct x; destruct y; split; simpl in *; intros; repeat match goal with | [ H : context [ rel_dec ?X ?Y ] |- _ ] => consider (rel_dec X Y); intros; subst | [ |- context [ rel_dec ?X ?Y ] ] => consider (rel_dec X Y); intros; subst end; intuition. Qed. End PairParam. Section PairEq. Variable T : Type. Variable U : Type. Variable EDT : RelDec (@eq T). Variable EDU : RelDec (@eq U). (** Specialization for equality **) Global Instance RelDec_eq_pair : RelDec (@eq (T * U)) := { rel_dec := fun x y => if rel_dec (fst x) (fst y) then rel_dec (snd x) (snd y) else false }. Variable EDCT : RelDec_Correct EDT. Variable EDCU : RelDec_Correct EDU. Global Instance RelDec_Correct_eq_pair : RelDec_Correct RelDec_eq_pair. Proof. constructor; destruct x; destruct y; split; simpl in *; intros; repeat match goal with | [ H : context [ rel_dec ?X ?Y ] |- _ ] => consider (rel_dec X Y); intros; subst | [ |- context [ rel_dec ?X ?Y ] ] => consider (rel_dec X Y); intros; subst end; congruence. Qed. End PairEq. Global Instance Injective_pair T U (a :T) (b:U) c d : Injective ((a,b) = (c,d)). refine {| result := a = c /\ b = d |}. Proof. abstract (inversion 1; intuition). Defined.coq-ext-lib-0.12.0/theories/Data/Positive.v000066400000000000000000000026441451523051500204110ustar00rootroot00000000000000Require Import Coq.PArith.BinPos. Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. (* Decidable Instances *) Global Instance RelDec_peq : RelDec (@eq positive) := { rel_dec := Pos.eqb }. Global Instance RelDec_plt : RelDec (Pos.lt) := { rel_dec := Pos.ltb }. Global Instance RelDec_ple : RelDec (Pos.le) := { rel_dec := Pos.leb }. Global Instance RelDec_pgt : RelDec (Pos.gt) := { rel_dec := fun x y => negb (Pos.leb x y) }. Global Instance RelDec_pge : RelDec (Pos.ge) := { rel_dec := fun x y => negb (Pos.ltb x y) }. Global Instance RelDec_Correct_peq : RelDec_Correct RelDec_peq. Proof. constructor; simpl. intros. apply Pos.eqb_eq. Qed. Global Instance RelDec_Correct_plt : RelDec_Correct RelDec_plt. Proof. constructor; simpl; intros. apply Pos.ltb_lt. Qed. Global Instance RelDec_Correct_ple : RelDec_Correct RelDec_ple. Proof. constructor; simpl; intros. apply Pos.leb_le. Qed. Global Instance RelDec_Correct_pgt : RelDec_Correct RelDec_pgt. Proof. constructor; simpl; intros. unfold rel_dec; simpl. rewrite <- Pos.ltb_antisym. rewrite Pos.ltb_lt. intuition; [ apply Pos.lt_gt | apply Pos.gt_lt ]; auto. Qed. Global Instance RelDec_Correct_pge : RelDec_Correct RelDec_pge. Proof. constructor; simpl. intros. unfold rel_dec; simpl. rewrite <- Pos.leb_antisym. rewrite Pos.leb_le. intuition; [ apply Pos.le_ge | apply Pos.ge_le ]; auto. Qed. Export Coq.PArith.BinPos. coq-ext-lib-0.12.0/theories/Data/PreFun.v000066400000000000000000000005371451523051500200050ustar00rootroot00000000000000Require Import Coq.Classes.Morphisms. Require Import Coq.Relations.Relations. Set Implicit Arguments. Set Strict Implicit. Set Universe Polymorphism. Definition Fun@{d c} (A : Type@{d}) (B : Type@{c}) := A -> B. Definition compose@{uA uB uC} {A:Type@{uA}} {B:Type@{uB}} {C : Type@{uC}} (g : B -> C) (f : A -> B) : A -> C := fun x => g (f x). coq-ext-lib-0.12.0/theories/Data/Prop.v000066400000000000000000000051101451523051500175160ustar00rootroot00000000000000From Coq Require Import Setoid. (** NOTE: These should fit into a larger picture, e.g. lattices or monoids **) (** And/Conjunction **) Lemma and_True_iff : forall P, (P /\ True) <-> P. Proof. intuition. Qed. Lemma and_and_iff : forall P, (P /\ P) <-> P. Proof. intuition. Qed. Lemma and_assoc : forall P Q R, (P /\ Q /\ R) <-> ((P /\ Q) /\ R). Proof. intuition. Qed. Lemma and_comm : forall P Q, (P /\ Q) <-> (Q /\ P). Proof. intuition. Qed. Lemma and_False_iff : forall P, (P /\ False) <-> False. Proof. intuition. Qed. Lemma and_cancel : forall P Q R : Prop, (P -> (Q <-> R)) -> ((P /\ Q) <-> (P /\ R)). Proof. intuition. Qed. Lemma and_iff : forall P Q R S : Prop, (P <-> R) -> (P -> (Q <-> S)) -> ((P /\ Q) <-> (R /\ S)). Proof. clear; intuition. Qed. (** Or/Disjunction **) Lemma or_False_iff : forall P, (P \/ False) <-> P. Proof. intuition. Qed. Lemma or_or_iff : forall P, (P \/ P) <-> P. Proof. intuition. Qed. Lemma or_assoc : forall P Q R, (P \/ Q \/ R) <-> ((P \/ Q) \/ R). Proof. intuition. Qed. Lemma or_comm : forall P Q, (P \/ Q) <-> (Q \/ P). Proof. intuition. Qed. Lemma or_True_iff : forall P, (P \/ True) <-> True. Proof. intuition. Qed. (** Implication **) Lemma impl_True_iff : forall (P : Prop), (True -> P) <-> P. Proof. clear; intros; tauto. Qed. Lemma impl_iff : forall P Q R S : Prop, (P <-> R) -> (P -> (Q <-> S)) -> ((P -> Q) <-> (R -> S)). Proof. clear. intuition. Qed. Lemma impl_eq : forall (P Q : Prop), P = Q -> (P -> Q). Proof. clear. intros; subst; auto. Qed. Lemma uncurry : forall (P Q R : Prop), (P /\ Q -> R) <-> (P -> Q -> R). Proof. clear. tauto. Qed. (** Forall **) Lemma forall_iff : forall T P Q, (forall x, P x <-> Q x) -> ((forall x : T, P x) <-> (forall x : T, Q x)). Proof. intros. setoid_rewrite H. reflexivity. Qed. Lemma forall_impl : forall {T} (P Q : T -> Prop), (forall x, P x -> Q x) -> (forall x, P x) -> (forall x, Q x). Proof. clear. intuition. Qed. (** Exists **) Lemma exists_iff : forall T P Q, (forall x, P x <-> Q x) -> ((exists x : T, P x) <-> (exists x : T, Q x)). Proof. intros. setoid_rewrite H. reflexivity. Qed. Lemma exists_impl : forall {T} (P Q : T -> Prop), (forall x, P x -> Q x) -> (exists x, P x) -> (exists x, Q x). Proof. clear. intuition. destruct H0; eauto. Qed. Lemma iff_eq : forall (P Q : Prop), P = Q -> (P <-> Q). Proof. clear. intros; subst; reflexivity. Qed. coq-ext-lib-0.12.0/theories/Data/Set/000077500000000000000000000000001451523051500171455ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Data/Set/ListSet.v000066400000000000000000000035711451523051500207310ustar00rootroot00000000000000Require Import List. Require Import ExtLib.Structures.Sets. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Data.List. Require Import ExtLib.Structures.Reducible. Set Implicit Arguments. Set Strict Implicit. Section ListSet. Definition lset (T : Type) : Type := list T. Variable T : Type. Variable R_dec : T -> T -> bool. Fixpoint lset_contains (v : T) (ls : lset T) : bool := match ls with | nil => false | l :: ls => if R_dec v l then true else lset_contains v ls end. Definition lset_empty : lset T := nil. Definition lset_add (v : T) (ls : lset T) : lset T := if lset_contains v ls then ls else v :: ls. Definition lset_remove (v : T) : lset T -> lset T := List.filter (fun x => negb (R_dec v x)). Definition lset_union (l r : lset T) : lset T := fold_left (fun x y => lset_add y x) l r. Definition lset_difference (l r : lset T) : lset T := List.filter (fun x => negb (lset_contains x r)) l. Definition lset_intersect (l r : lset T) : lset T := List.filter (fun x => lset_contains x r) l. Definition lset_subset (l r : lset T) : bool := allb (fun x => lset_contains x r) l. End ListSet. Global Instance DSet_weak_listset {T} (R : T -> T -> Prop) (R_dec : RelDec R) : DSet (@lset T) T := { contains := lset_contains rel_dec ; empty := lset_empty T ; add := lset_add rel_dec ; singleton := fun x => lset_add rel_dec x (lset_empty T) ; remove := lset_remove rel_dec ; union := lset_union rel_dec ; intersect := lset_intersect rel_dec ; difference := lset_difference rel_dec ; subset := lset_subset rel_dec ; filter := @List.filter _ }. Global Instance Foldable_listset {T} (R : T -> T -> Prop) : Foldable (lset T) T := fun _ f a t => List.fold_left (fun x y => f y x) t a. Require Import ExtLib.Structures.Functor. Global Instance Functor_listset : Functor lset := { fmap := map }. coq-ext-lib-0.12.0/theories/Data/Set/SetMap.v000066400000000000000000000013511451523051500205250ustar00rootroot00000000000000Require Import ExtLib.Structures.Maps. Require Import ExtLib.Structures.Sets. Set Implicit Arguments. Set Strict Implicit. (** Canonical instance, a set is the same as a map where the values are unit **) (* Section SetFromMap. Variable T : Type. Variable R : T -> T -> Prop. Variable m : Type -> Type. Variable Map_T : Map T m. Global Instance CSet_map : @DSet (m unit) T R := { empty := Maps.empty ; contains := fun k m => match lookup k m with | None => false | Some _ => true end ; add := fun k m => Maps.add k tt m ; remove := fun k m => Maps.remove k m ; singleton := fun v => Maps.add v tt Maps.empty }. End SetFromMap. *) coq-ext-lib-0.12.0/theories/Data/Set/TwoThreeTrees.v000066400000000000000000000460271451523051500221110ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Data.Monads.OptionMonad. Require Import ExtLib.Programming.Extras. Import FunNotation. Set Implicit Arguments. Set Maximal Implicit Insertion. Import MonadNotation. Import MonadPlusNotation. Open Scope monad_scope. Section tree. Variable E:Type. Variable comp : E -> E -> comparison. (* a two-three tree *) Inductive tree := (* Null_t = _ *) | Null_t : tree (* [a] * Two_t X a Y = / \ * X Y * Invariant: x in X => x < a; y in Y => y > a *) | Two_t : tree -> E -> tree -> tree (* [a][b] * Three_t X a Y b Z = / | \ * X Y Z * Invariant: x in X => x < a; y in Y => a < y < b; z in Z => z > b *) | Three_t : tree -> E -> tree -> E -> tree -> tree . Fixpoint height_t (t:tree) : nat := match t with | Null_t => O | Two_t tl _ tr => max (height_t tl) (height_t tr) | Three_t tl _ tm _ tr => max (max (height_t tl) (height_t tm)) (height_t tr) end. (* a context of a two-three tree. this is the type of taking a tree and * replacing a sub-tree with a hole. *) Inductive context := (* Top_c = _ *) | Top_c : context (* C * TwoLeftHole_c a Y C = | * [a] * / \ * ? Y *) | TwoLeftHole_c : E -> tree -> context -> context (* C * TwoRightHole_c X a C = | * [a] * / \ * X ? *) | TwoRightHole_c : tree -> E -> context -> context (* C * ThreeLeftHole a Y b Z C = | * [a][b] * / | \ * ? Y Z *) | ThreeLeftHole_c : E -> tree -> E -> tree -> context -> context (* C * ThreeMiddleHole X a b Z C = | * [a][b] * / | \ * X ? Z *) | ThreeMiddleHole_c : tree -> E -> E -> tree -> context -> context (* C * ThreeRightHole_c X a Y b C = | * [a][b] * / | \ * X Y ? *) | ThreeRightHole_c : tree -> E -> tree -> E -> context -> context . (* zip takes a context (which can be thought of as a tree with a hole), and a * subtree, and fills the hole with the subtree *) Fixpoint zip (t:tree) (c:context) : tree := match c with | Top_c => t | TwoLeftHole_c em tr c' => zip (Two_t t em tr) c' | TwoRightHole_c tl em c' => zip (Two_t tl em t) c' | ThreeLeftHole_c el em er tr c' => zip (Three_t t el em er tr) c' | ThreeMiddleHole_c tl el er tr c' => zip (Three_t tl el t er tr) c' | ThreeRightHole_c tl el em er c' => zip (Three_t tl el em er t) c' end. Fixpoint fuse (c1:context) (c2:context) : context := match c1 with | Top_c => c2 | TwoLeftHole_c em tr c1' => TwoLeftHole_c em tr (fuse c1' c2) | TwoRightHole_c tl em c1' => TwoRightHole_c tl em (fuse c1' c2) | ThreeLeftHole_c el em er tr c1' => ThreeLeftHole_c el em er tr (fuse c1' c2) | ThreeMiddleHole_c tl el er tr c1' => ThreeMiddleHole_c tl el er tr (fuse c1' c2) | ThreeRightHole_c tl el em er c1' => ThreeRightHole_c tl el em er (fuse c1' c2) end. Inductive location := (* C * TwoHole_l X Y C = | * [?] * / \ * X Y *) | TwoHole_l : tree -> tree -> context -> location (* C * TwoHole_l X Y b Z C = | * [?][b] * / | \ * X Y Z *) | ThreeLeftHole_l : tree -> tree -> E -> tree -> context -> location (* C * TwoHole_l X a Y Z C = | * [a][?] * / | \ * X Y Z *) | ThreeRightHole_l : tree -> E -> tree -> tree -> context -> location . Definition fillLocation (e:E) (l:location) : tree := match l with | TwoHole_l tl tr c => zip (Two_t tl e tr) c | ThreeLeftHole_l tl tm vr tr c => zip (Three_t tl e tm vr tr) c | ThreeRightHole_l tl el tm tr c => zip (Three_t tl el tm e tr) c end. Fixpoint locate (e:E) (t:tree) (c:context) : context + E * location := match t with | Null_t => inl c | Two_t tl em tr => match comp e em with | Lt => locate e tl $ TwoLeftHole_c em tr c | Eq => inr (em, TwoHole_l tl tr c) | Gt => locate e tr $ TwoRightHole_c tl em c end | Three_t tl el tm er tr => match comp e el, comp e er with | Lt, _ => locate e tl $ ThreeLeftHole_c el tm er tr c | Eq, _ => inr (el, ThreeLeftHole_l tl tm er tr c) | Gt, Lt => locate e tm $ ThreeMiddleHole_c tl el er tr c | _, Eq => inr (er, ThreeRightHole_l tl el tm tr c) | _, Gt => locate e tr $ ThreeRightHole_c tl el tm er c end end. Fixpoint locateGreatest (t:tree) (c:context) : option (E * (context + E * context)) := match t with | Null_t => None | Two_t tl em tr => liftM sum_tot $ locateGreatest tr (TwoRightHole_c tl em c) <+> ret (em, inl c) | Three_t tl el tm er tr => liftM sum_tot $ locateGreatest tr (ThreeRightHole_c tl el tm er c) <+> ret (er, inr (el, c)) end. Definition single e := Two_t Null_t e Null_t. (* if insertion results in a subtree which is too tall, propegate it up into * its context. *) Fixpoint insertUp (tet:tree * E * tree) (c:context) : tree := let '(tl,em,tr) := tet in match c with (* _ * | * [em] => [em] * // \\ / \ * tl tr tl tr *) | Top_c => Two_t tl em tr (* c' c' * | | * [em'] => [em][em'] * / \ / | \ * [em] tr' tl tr tr' * // \\ * tl tr *) | TwoLeftHole_c em' tr' c' => zip (Three_t tl em tr em' tr') c' (* c' c' * | | * [em'] => [em'][em] * / \ / | \ * tl' [em] tl' tl tr * // \\ * tl tr *) | TwoRightHole_c tl' em' c' => zip (Three_t tl' em' tl em tr ) c' (* c' c' * | | * [el][er] => [el] * / | \ // \\ * [em] tm tr' [em] [er] * // \\ / \ / \ * tl tr tl tr tm tr' *) | ThreeLeftHole_c el tm er tr' c' => insertUp (Two_t tl em tr, el, Two_t tm er tr') c' (* c' c' * | | * [el][er] => [em] * / | \ // \\ * tl' [em] tr' [el] [er] * // \\ / \ / \ * tl tr tl' tl tr tr' *) | ThreeMiddleHole_c tl' el er tr' c' => insertUp (Two_t tl' el tl, em, Two_t tr er tr') c' (* c' c' * | | * [el][er] => [er] * / | \ // \\ * tl' tm [em] [el] [em] * // \\ / \ / \ * tl tr tl' tm tl tr *) | ThreeRightHole_c tl' el tm er c' => insertUp (Two_t tl' el tm, er, Two_t tl em tr) c' end. (* insert an element into the two-three tree *) Definition insert (e:E) (t:tree) : tree := match locate e t Top_c with | inl c => insertUp (Null_t, e, Null_t) c | inr (_, l) => fillLocation e l end. (* if remove results in a tree which is too short, propegate the gap into the * context *) Fixpoint removeUp (t:tree) (c:context) : tree := match c with (* _ * || * e => e *) | Top_c => t (* c' c' * | | * [em] => [el'] * // \ / \ * t [el'][er'] [em] [er'] * / | \ / \ / \ * tl' tm' tr' t tl' tm' tr' *) | TwoLeftHole_c em (Three_t tl' el' tm' er' tr') c' => zip (Two_t (Two_t t em tl') el' (Two_t tm' er' tr')) c' (* c' c' * | || * [em] => [em][em'] * // \ / | \ * t [em'] t tl' tr' * / \ * tl' tr' *) | TwoLeftHole_c em (Two_t tl' em' tr') c' => removeUp (Three_t t em tl' em' tr') c' (* c' c' * | | * [em] => [er'] * / \\ / \ * [el'][er'] t [el'] [em] * / | \ / \ / \ * tl' tm' tr' tl' tm' tr' t *) | TwoRightHole_c (Three_t tl' el' tm' er' tr') em c' => zip (Two_t (Two_t tl' el' tm') er' (Two_t tr' em t)) c' (* c' c' * | || * [em] => [em'][em] * / \\ / | \ * [em'] t tl' tr' t * / \ * tl' tr' *) | TwoRightHole_c (Two_t tl' em' tr') em c' => removeUp (Three_t tl' em' tr' em t) c' (* c' c' * | | * [el][er] => [el][er] * // | \ / | \ * t [el'][er'] tr [el'] [er'] tr * / | \ / \ / \ * tl' tm' tr' t tl' tm' tr' *) | ThreeLeftHole_c el (Three_t tl' el' tm' er' tr') er tr c' => zip (Three_t (Two_t t el' tl') el (Two_t tm' er' tr') er tr) c' (* c' c' * | | * [el][er] => [er] * // | \ / \ * t [em'] tr [el][em'] tr * / \ / | \ * tl' tr' t tl' tr' *) | ThreeLeftHole_c el (Two_t tl' em' tr') er tr c' => zip (Two_t (Three_t t el tl' em' tr') er tr) c' (* c' c' * | | * [el][er] => [er'][er] * / || \ / | \ * [el'][er'] t tr [el'] [el] tr * / | \ / \ / \ * tl' tm' tr' tl' tm' tr' t *) | ThreeMiddleHole_c (Three_t tl' el' tm' er' tr') el er tr c' => zip (Three_t (Two_t tl' el' tm') er' (Two_t tr' el t) er tr) c' (* c' c' * | | * [el][er] => [el][el'] * / || \ / | \ * tl t [el'][er'] tl [er] [er'] * / | \ / \ / \ * tl' tm' tr' t tl' tm' tr' *) | ThreeMiddleHole_c tl el er (Three_t tl' el' tm' er' tr') c' => zip (Three_t tl el (Two_t t er tl') el' (Two_t tm' er' tr')) c' (* c' c' * | | * [el][er] => [er] * / || \ / \ * [em'] t tr [em'][el] tr * / \ / | \ * tl' tr' tl' tr' t *) | ThreeMiddleHole_c (Two_t tl' em' tr') el er tr c' => zip (Two_t (Three_t tl' em' tr' el t) er tr) c' (* c' c' * | | * [el][er] => [el] * / || \ / \ * tl t [em'] tl [er][em'] * / \ / | \ * tl' tr' t tl' tr' *) | ThreeMiddleHole_c tl el er (Two_t tl' em' tr') c' => zip (Two_t tl el (Three_t t er tl' em' tr')) c' (* c' c' * | | * [el][er] => [el][er'] * / | \\ / | \ * tl [el'][er'] t tl [el'] [er] * / | \ / \ / \ * tl' tm' tr' tl' tm' tr' t *) | ThreeRightHole_c tl el (Three_t tl' el' tm' er' tr') er c' => zip (Three_t tl el (Two_t tl' el' tm') er' (Two_t tr' er t)) c' (* c' c' * | | * [el][er] => [el] * / | \\ / \ * tl [em'] t tl [em'][er] * / \ / | \ * tl' tr' tl' tr t *) | ThreeRightHole_c tl el (Two_t tl' em' tr') er c' => zip (Two_t tl el (Three_t tl' em' tr' er t)) c' | TwoLeftHole_c _ Null_t _ => Null_t (* not wf *) | TwoRightHole_c Null_t _ _ => Null_t (* not wf *) | ThreeLeftHole_c _ Null_t _ _ _ => Null_t (* not wf *) | ThreeMiddleHole_c Null_t _ _ _ _ => Null_t (* not wf *) | ThreeRightHole_c _ _ Null_t _ _ => Null_t (* not wf *) end. Definition remove (e:E) (t:tree) : tree := match locate e t Top_c with (* element doesn't exist *) | inl _ => t (* element found at location [loc] *) | inr (_, loc) => match loc with (* element found at a two-node *) | TwoHole_l tl tr c => let mkContext g c' := TwoLeftHole_c g tr c' in match locateGreatest tl Top_c with (* no children: turn into a hole and propagate *) | None => removeUp Null_t c (* greatest leaf is a two-node: replace it with a hole and propagate *) | Some (g, inl c') => removeUp Null_t $ fuse (mkContext g c') c (* greatest leaf is a three-node: turn it into a two-node *) | Some (g, inr (el, c')) => zip (single el) $ fuse (mkContext g c') c end (* element found on left side of three-node *) | ThreeLeftHole_l tl tm er tr c => let mkContext g c' := ThreeLeftHole_c g tm er tr c' in match locateGreatest tl Top_c with (* no children: turn into a two-node *) | None => zip (single er) c (* greatest leaf is a two-node: replace it with a hole and propagate *) | Some (g, inl c') => removeUp Null_t $ fuse (mkContext g c') c (* greatest leaf is a three-node: turn it into a two-node *) | Some (g, inr (el, c')) => zip (single el) $ fuse (mkContext g c') c end (* element found on right side of three-node *) | ThreeRightHole_l tl el tm tr c => let mkContext g c' := ThreeMiddleHole_c tl el g tr c' in match locateGreatest tm Top_c with (* no children: turn into a two-node *) | None => zip (single el) c (* greatest leaf is a two-node: replace it with a hole and propagate *) | Some (g, inl c') => removeUp Null_t $ fuse (mkContext g c') c (* greatest leaf is a three-node: turn it into a two-node *) | Some (g, inr (el, c')) => zip (single el) $ fuse (mkContext g c') c end end end. End tree. Arguments Null_t {E}. (* Section treeWfP. Context {E:Type} {TO:TotalOrder E} {TOP:TotalOrderP E}. Context {EP:EquivP E} {POEP:PreOrderEquivP _ EP}. Inductive tree_wf : tree E -> nat -> EtndTopBot E -> EtndTopBot E -> Prop := | NullTreeWf : forall eLL eRR, tree_wf Null_t O eLL eRR | TwoTreeWf : forall tl em tr h eLL eRR, eLL << IncEtndTopBot em -> IncEtndTopBot em << eRR -> tree_wf tl h eLL (IncEtndTopBot em) -> tree_wf tr h (IncEtndTopBot em) eRR -> tree_wf (Two_t tl em tr) (S h) eLL eRR | ThreeTreWf : forall tl el tm er tr eLL eRR h, eLL << IncEtndTopBot el -> el << er -> IncEtndTopBot er << eRR -> tree_wf tl h eLL (IncEtndTopBot el) -> tree_wf tm h (IncEtndTopBot el) (IncEtndTopBot er) -> tree_wf tr h (IncEtndTopBot er) eRR -> tree_wf (Three_t tl el tm er tr) (S h) eLL eRR . Inductive tree_in : E -> tree E -> Prop := | TwoTreeIn : forall e tl em tr, e ~= em \/ tree_in e tl \/ tree_in e tr -> tree_in e (Two_t tl em tr) | ThreeTreeIn : forall e tl el tm er tr, e ~= el \/ e ~= er \/ tree_in e tl \/ tree_in e tm \/ tree_in e tr -> tree_in e (Three_t tl el tm er tr) . (* Lemma swapTwoWf : forall tl em tr h eLL eRR em', tree_wf (Two_t tl em tr) h eLL eRR -> em ~= em' -> tree_wf (Two_t tl em' tr) h eLL eRR. Proof. intros ; induction h. inversion H. inversion H ; subst ; clear H. constructor. repeat (ohsnap ; girlforeal). unfold ltP in H5. destruct eLL ; repeat (ohsnap ; girlforeal). ... *) End treeWfP. (* Definition context_wf (c:context) (sth:nat) (sel:E+bool) (ser:E+bool) (th:nat) (eLL:E+bool) (eRR:E+bool) : Prop := forall t:tree, tree_wf t sth sel ser -> tree_wf (zip t c) th eLL eRR. Lemma twoLeftHoleZipWf : forall tl em tr c h eLL eRR, tree_wf (zip (Two_t tl em tr) c) h eLL eRR -> tree_wf (zip tl (TwoLeftHole_c em tr c)) h eLL eRR. Proof. intros. induction tl ; intros ; simpl ; auto. Qed. Hint Immediate twoLeftHoleZipWf : twoThreeDb. Lemma twoRightHoleZipWf : forall tl em tr c h eLL eRR, tree_wf (zip (Two_t tl em tr) c) h eLL eRR -> tree_wf (zip tr (TwoRightHole_c tl em c)) h eLL eRR. Proof. intros. induction tl ; intros ; simpl ; auto. Qed. Hint Immediate twoRightHoleZipWf : twoThreeDb. Lemma threeLeftHoleZipWf : forall tl el tm er tr c h eLL eRR, tree_wf (zip (Three_t tl el tm er tr) c) h eLL eRR-> tree_wf (zip tl (ThreeLeftHole_c el tm er tr c)) h eLL eRR. Proof. intros. induction tl ; intros ; simpl ; auto. Qed. Hint Immediate threeLeftHoleZipWf : twoThreeDb. Lemma threeMiddleHoleZipWf : forall tl el tm er tr c h eLL eRR, tree_wf (zip (Three_t tl el tm er tr) c) h eLL eRR -> tree_wf (zip tm (ThreeMiddleHole_c tl el er tr c)) h eLL eRR. Proof. intros. induction tl ; intros ; simpl ; auto. Qed. Hint Immediate threeMiddleHoleZipWf : twoThreeDb. Lemma threeRightHoleZipWf : forall tl el tm er tr c h eLL eRR, tree_wf (zip (Three_t tl el tm er tr) c) h eLL eRR -> tree_wf (zip tr (ThreeRightHole_c tl el tm er c)) h eLL eRR. Proof. intros. induction tl ; intros ; simpl ; auto. Qed. Hint Immediate threeRightHoleZipWf : twoThreeDb. Definition location_wf (l:location) h eLL eRR : Prop := forall e:E, tree_wf (fillLocation e l) h eLL eRR. Lemma zipLocationWf : forall tl em tr c, tree_wf (zip (Two_t tl em tr) c) -> location_wf (TwoHole_l tl tr c). Proof. intros. unfold location_wf. intros. simpl. exists em. auto. Qed. Hint Immediate zipLocationWf : twoThreeDb. Lemma locate_wf : forall e t c, tree_wf (zip t c) -> match locate e t c with inl c => tree_wf (zip Null_t c) | inr (_,l) => location_wf l end. Proof. intros. gd c. gd e. induction t ; intros ; simpl ; auto. destruct (compareo e0 e). pose (twoLeftHoleZipWf _ _ _ _ H). specialize (IHt1 e0 _ t). apply IHt1. eauto with twoThreeDb. pose (twoRightHoleZipWf _ _ _ _ H). specialize (IHt2 e0 _ t). apply IHt2. Lemma single_wf : forall e, tree_wf (single e). Proof. intros. simpl. auto. Qed. Definition insert_wf : forall e t, tree_wf t -> tree_wf (insert e t). Proof. intros. destruct t. simpl. auto. unfold insert. simpl. destruct (compareo e e0). unfold insert. destruct (locate e t Top_c). simpl. *) *) coq-ext-lib-0.12.0/theories/Data/SigT.v000066400000000000000000000024271451523051500174540ustar00rootroot00000000000000Require Coq.Classes.EquivDec. Require Import ExtLib.Structures.EqDep. Require Import ExtLib.Tactics.Injection. Require Import ExtLib.Tactics.EqDep. Set Implicit Arguments. Set Strict Implicit. Set Printing Universes. (** For backwards compatibility with hint locality attributes. *) Set Warnings "-unsupported-attributes". Section injective. Variable T : Type. Variable F : T -> Type. Variable ED : EquivDec.EqDec _ (@eq T). Global Instance Injective_existT a b d : Injective (existT F a b = existT F a d) | 1. refine {| result := b = d |}. abstract (eauto using inj_pair2). Defined. Global Instance Injective_existT_dif a b c d : Injective (existT F a b = existT F c d) | 2. refine {| result := exists pf : c = a, b = match pf in _ = t return F t with | eq_refl => d end |}. abstract (inversion 1; subst; exists eq_refl; auto). Defined. End injective. Lemma eq_sigT_rw : forall T U F (a b : T) (pf : a = b) s, match pf in _ = x return @sigT U (F x) with | eq_refl => s end = @existT U (F b) (projT1 s) match pf in _ = x return F x (projT1 s) with | eq_refl => (projT2 s) end. Proof. destruct pf. destruct s; reflexivity. Qed. #[global] Hint Rewrite eq_sigT_rw : eq_rw. coq-ext-lib-0.12.0/theories/Data/Stream.v000066400000000000000000000003441451523051500200350ustar00rootroot00000000000000 Set Implicit Arguments. Set Strict Implicit. Section stream. Variable T : Type. CoInductive stream : Type := | snil : stream | scons : T -> stream -> stream. End stream. Arguments snil {T}. Arguments scons {T} _ _. coq-ext-lib-0.12.0/theories/Data/String.v000066400000000000000000000126431451523051500200550ustar00rootroot00000000000000Require Import Coq.Strings.String. Require Import Coq.Program.Program. Require Import Coq.Arith.PeanoNat. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Structures.Monoid. Require Import ExtLib.Data.Char. Require Import ExtLib.Data.Nat. Set Implicit Arguments. Set Strict Implicit. Local Notation "x >> y" := (match x with | Eq => y | z => z end) (only parsing, at level 30). Definition deprecated_bool_cmp (l r : bool) : comparison := match l , r with | true , false => Gt | false , true => Lt | true , true | false , false => Eq end. #[deprecated(since="8.12",note="Use Bool.compare instead.")] Notation bool_cmp := deprecated_bool_cmp. Definition deprecated_ascii_cmp (l r : Ascii.ascii) : comparison := match l , r with | Ascii.Ascii l1 l2 l3 l4 l5 l6 l7 l8 , Ascii.Ascii r1 r2 r3 r4 r5 r6 r7 r8 => bool_cmp l8 r8 >> bool_cmp l7 r7 >> bool_cmp l6 r6 >> bool_cmp l5 r5 >> bool_cmp l4 r4 >> bool_cmp l3 r3 >> bool_cmp l2 r2 >> bool_cmp l1 r1 end. #[deprecated(since="8.15",note="Use Ascii.compare instead.")] Notation ascii_cmp := deprecated_ascii_cmp. Fixpoint deprecated_string_dec (l r : string) : bool := match l , r with | EmptyString , EmptyString => true | String l ls , String r rs => if Ascii.eqb l r then deprecated_string_dec ls rs else false | _ , _ => false end. #[deprecated(since="8.9",note="Use String.eqb instead.")] Notation string_dec := deprecated_string_dec. Theorem deprecated_string_dec_sound : forall l r, string_dec l r = true <-> l = r. Proof. induction l; destruct r; try (constructor; easy); simpl. case (Ascii.eqb_spec a a0); simpl; [intros -> | constructor; now intros [= ]]. case (IHl r); intros; constructor; intros; f_equal; auto. inversion H1; subst; auto. Qed. #[deprecated(since="8.9",note="Use String.eqb_eq instead.")] Notation string_dec_sound := deprecated_string_dec_sound. Global Instance RelDec_string : RelDec (@eq string) := {| rel_dec := String.eqb |}. Global Instance RelDec_Correct_string : RelDec_Correct RelDec_string. Proof. constructor; auto using String.eqb_eq. Qed. Global Instance Reflect_string_dec a b : Reflect (String.eqb a b) (a = b) (a <> b). Proof. apply iff_to_reflect; auto using String.eqb_eq. Qed. Fixpoint deprecated_string_cmp (l r : string) : comparison := match l , r with | EmptyString , EmptyString => Eq | EmptyString , _ => Lt | _ , EmptyString => Gt | String l ls , String r rs => ascii_cmp l r >> deprecated_string_cmp ls rs end. #[deprecated(since="8.15",note="Use String.compare instead.")] Notation string_cmp := deprecated_string_cmp. Section Program_Scope. Variable modulus : nat. Hypothesis one_lt_mod : 1 < modulus. Lemma _xxx : forall m n, 1 < m -> ~ n < m -> 0 < n. Proof. destruct n; destruct m; intros. inversion H. exfalso. apply H0. etransitivity. 2: eassumption. repeat constructor. inversion H. now apply Nat.lt_0_succ. Qed. Program Fixpoint nat2string (n:nat) {measure n}: string := match Nat.ltb n modulus as x return Nat.ltb n modulus = x -> string with | true => fun _ => String (digit2ascii n) EmptyString | false => fun pf => let m := Nat.div n modulus in append (nat2string m) (String (digit2ascii (n - modulus * m)) EmptyString) end (@Logic.eq_refl _ (Nat.ltb n modulus)). Next Obligation. eapply Nat.div_lt; auto. consider (Nat.ltb n modulus); try congruence. intros. eapply _xxx; eassumption. Defined. End Program_Scope. Definition nat2string10 : nat -> string. refine (@nat2string 10 _). repeat constructor. Defined. Definition nat2string2 : nat -> string. refine (@nat2string 2 _). repeat constructor. Defined. Definition nat2string8 : nat -> string. refine (@nat2string 8 _). repeat constructor. Defined. Definition nat2string16 : nat -> string. refine (@nat2string 16 _). repeat constructor. Defined. Global Instance Foldable_string : Foldable string ascii := fun _ f base => fix go ls := match ls with | EmptyString => base | String l ls => f l (go ls) end. Section string. Inductive R_string_len : string -> string -> Prop := | R_s_len : forall n m, length n < length m -> R_string_len n m. Theorem wf_R_string_len : well_founded R_string_len. Proof. constructor. intros. refine (@Fix _ _ wf_R_lt (fun n : nat => forall ls : string, n = length ls -> Acc R_string_len ls) (fun x rec ls pfls => Acc_intro _ _) _ _ refl_equal). refine ( match ls as ls return x = length ls -> forall z : string, R_string_len z ls -> Acc R_string_len z with | EmptyString => fun (pfls : x = 0) z pf => _ | String l ls => fun pfls z pf => rec _ (match pf in R_string_len xs ys return x = length ys -> R_nat_lt (length xs) x with | R_s_len n m pf' => fun pf_eq => match eq_sym pf_eq in _ = x return R_nat_lt (length n) x with | refl_equal => R_lt pf' end end pfls) _ eq_refl end pfls). clear - pf; abstract (inversion pf; subst; simpl in *; inversion H). Defined. End string. Definition Monoid_string_append : Monoid string := {| monoid_plus := append ; monoid_unit := EmptyString |}. coq-ext-lib-0.12.0/theories/Data/Sum.v000066400000000000000000000061431451523051500173510ustar00rootroot00000000000000Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.Consider. Require Import ExtLib.Tactics.Injection. Set Implicit Arguments. Set Strict Implicit. Section PairParam. Variable T : Type. Variable eqT : T -> T -> Prop. Variable U : Type. Variable eqU : U -> U -> Prop. Inductive sum_eq : T + U -> T + U -> Prop := | Inl_eq : forall a b, eqT a b -> sum_eq (inl a) (inl b) | Inr_eq : forall a b, eqU a b -> sum_eq (inr a) (inr b). Variable EDT : RelDec eqT. Variable EDU : RelDec eqU. Global Instance RelDec_equ_sum : RelDec (sum_eq) := { rel_dec := fun x y => match x , y with | inl x , inl y => rel_dec x y | inr x , inr y => rel_dec x y | inl _ , inr _ => false | inr _ , inl _ => false end }. Variable EDCT : RelDec_Correct EDT. Variable EDCU : RelDec_Correct EDU. Global Instance RelDec_Correct_equ_sum : RelDec_Correct RelDec_equ_sum. Proof. constructor; destruct x; destruct y; split; simpl in *; intros; repeat match goal with | [ H : context [ rel_dec ?X ?Y ] |- _ ] => consider (rel_dec X Y); intros; subst | [ |- context [ rel_dec ?X ?Y ] ] => consider (rel_dec X Y); intros; subst end; intuition; try solve [ constructor; auto | congruence ]. + inversion H. intuition. + inversion H. + inversion H. + inversion H; intuition. Qed. End PairParam. Section SumEq. Variable T : Type. Variable U : Type. Variable EDT : RelDec (@eq T). Variable EDU : RelDec (@eq U). (** Specialization for equality **) Global Instance RelDec_eq_pair : RelDec (@eq (T + U)) := { rel_dec := fun x y => match x , y with | inl x , inl y => rel_dec x y | inr x , inr y => rel_dec x y | inl _ , inr _ => false | inr _ , inl _ => false end }. Variable EDCT : RelDec_Correct EDT. Variable EDCU : RelDec_Correct EDU. Global Instance RelDec_Correct_eq_pair : RelDec_Correct RelDec_eq_pair. Proof. constructor; destruct x; destruct y; split; simpl in *; intros; repeat match goal with | [ H : context [ rel_dec ?X ?Y ] |- _ ] => consider (rel_dec X Y); intros; subst | [ |- context [ rel_dec ?X ?Y ] ] => consider (rel_dec X Y); intros; subst end; congruence. Qed. End SumEq. Global Instance Injective_inl T U a c : Injective (@inl T U a = inl c). refine {| result := a = c |}. Proof. abstract (inversion 1; intuition). Defined. Global Instance Injective_inr T U a c : Injective (@inr T U a = inr c). refine {| result := a = c |}. Proof. abstract (inversion 1; intuition). Defined. Global Instance Injective_inl_False T U a c : Injective (@inl T U a = inr c). refine {| result := False |}. Proof. abstract (inversion 1; intuition). Defined. Global Instance Injective_inr_False T U a c : Injective (@inr T U a = inl c). refine {| result := False |}. Proof. abstract (inversion 1; intuition). Defined.coq-ext-lib-0.12.0/theories/Data/SumN.v000066400000000000000000000114451451523051500174700ustar00rootroot00000000000000From Coq Require Import PArith. Require Import ExtLib.Data.Map.FMapPositive. Require Import ExtLib.Data.Eq. Require Import ExtLib.Tactics.Injection. From Coq Require Import PArith. Fixpoint pmap_lookup' (ts : pmap Type) (p : positive) : option Type := match p with | xH => pmap_here ts | xI p => pmap_lookup' (pmap_right ts) p | xO p => pmap_lookup' (pmap_left ts) p end. Record OneOf (ts : pmap Type) : Type := mkOneOf { index : positive ; value : match pmap_lookup' ts index with | None => Empty_set | Some T => T end }. Definition Into {ts} {T : Type} (n : positive) (pf : pmap_lookup' ts n = Some T) : T -> OneOf ts := match pf in _ = X return match X with | Some T => T | None => Empty_set end -> OneOf ts with | eq_refl => @mkOneOf ts n end. Fixpoint asNth' {ts : pmap Type} (p p' : positive) : match pmap_lookup' ts p' with | None => Empty_set | Some T => T end -> option (match pmap_lookup' ts p with | None => Empty_set | Some T => T end) := match p as p , p' as p' return match pmap_lookup' ts p' with | None => Empty_set | Some T => T end -> option (match pmap_lookup' ts p with | None => Empty_set | Some T => T end) with | xH , xH => Some | xI p , xI p' => asNth' p p' | xO p , xO p' => asNth' p p' | _ , _ => fun _ => None end. Definition asNth {ts : pmap Type} (p : positive) (oe : OneOf ts) : option (match pmap_lookup' ts p with | None => Empty_set | Some T => T end) := @asNth' ts p oe.(index ts) oe.(value ts). Definition OutOf {ts} {T : Type} (n : positive) (pf : pmap_lookup' ts n = Some T) : OneOf ts -> option T := match pf in _ = X return OneOf ts -> option match X with | None => Empty_set:Type | Some T => T end with | eq_refl => @asNth ts n end. Lemma asNth'_get_lookup : forall p ts v, asNth' (ts:=ts) p p v = Some v. Proof. induction p; simpl; intros; auto. Qed. Theorem Outof_Into : forall ts T p pf v, @OutOf ts T p pf (@Into ts T p pf v) = Some v. Proof using. unfold OutOf, Into. intros. repeat rewrite (eq_Arr_eq pf). repeat rewrite (eq_Const_eq pf). repeat rewrite (eq_Const_eq (eq_sym pf)). unfold asNth. simpl. rewrite asNth'_get_lookup. { generalize dependent (pmap_lookup' ts p). intros. subst. reflexivity. } Qed. Theorem asNth_eq : forall ts p oe v, @asNth ts p oe = Some v -> oe = {| index := p ; value := v |}. Proof. unfold asNth. destruct oe; simpl. revert value0. revert index0. revert ts. induction p; destruct index0; simpl; intros; solve [ congruence | eapply IHp in H; inversion H; clear H IHp; subst; auto ]. Qed. Section elim. Context {T : Type}. Variable F : T -> Type. Fixpoint pmap_elim (R : Type) (ts : pmap T) : Type := match ts with | Empty => R | Branch None l r => pmap_elim (pmap_elim R r) l | Branch (Some x) l r => F x -> pmap_elim (pmap_elim R r) l end. End elim. Fixpoint pmap_lookup'_Empty (p : positive) : pmap_lookup' Empty p = None := match p with | xH => eq_refl | xO p => pmap_lookup'_Empty p | xI p => pmap_lookup'_Empty p end. Definition OneOf_Empty (f : OneOf Empty) : False. Proof. destruct f. rewrite pmap_lookup'_Empty in *. intuition congruence. Defined. Lemma pmap_lookup'_eq p m : pmap_lookup p m = pmap_lookup' m p. Proof. generalize dependent m. induction p; intuition. simpl. destruct m. simpl. rewrite pmap_lookup'_Empty. reflexivity. simpl in *. apply IHp. simpl in *. destruct m. simpl. rewrite pmap_lookup'_Empty. reflexivity. simpl. apply IHp. Defined. Global Instance Injective_OneOf m i1 i2 v1 v2 : Injective (@eq (OneOf m) {| index := i1 ; value := v1 |} {| index := i2 ; value := v2 |}) := { result := exists pf : i2 = i1, v1 = match pf in _ = T return match pmap_lookup' m T with | None => Empty_set | Some T => T end with | eq_refl => v2 end ; injection := fun H => match H in _ = h return exists pf : index _ h = i1 , v1 = match pf in (_ = T) return match pmap_lookup' m T with | Some T0 => T0 | None => Empty_set end with | eq_refl => value _ h end with | eq_refl => @ex_intro _ _ eq_refl eq_refl end }. coq-ext-lib-0.12.0/theories/Data/Tuple.v000066400000000000000000000030751451523051500176770ustar00rootroot00000000000000Require Import ExtLib.Data.Fin. Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. Fixpoint vector (T : Type) (n : nat) : Type := match n with | 0 => unit | S n => prod T (vector T n) end. Fixpoint get {T} {n : nat} (f : fin n) : vector T n -> T := match f in fin n return vector T n -> T with | F0 n => fun v : T * vector T n => fst v | FS n f => fun v : T * vector T n => get f (snd v) end. Fixpoint put {T} {n : nat} (f : fin n) (t : T) : vector T n -> vector T n := match f in fin n return vector T n -> vector T n with | F0 _ => fun v => (t, snd v) | FS _ f => fun v => (fst v, put f t (snd v)) end. Theorem get_put_eq : forall {T n} (v : vector T n) (f : fin n) val, get f (put f val v) = val. Proof. induction n. { inversion f. } { remember (S n). destruct f. inversion Heqn0; subst; intros; reflexivity. inversion Heqn0; subst; simpl; auto. } Qed. Theorem get_put_neq : forall {T n} (v : vector T n) (f f' : fin n) val, f <> f' -> get f (put f' val v) = get f v. Proof. induction n. { inversion f. } { remember (S n); destruct f. { inversion Heqn0; clear Heqn0; subst; intros. destruct (fin_case f'); try congruence. destruct H0; subst. auto. } { inversion Heqn0; clear Heqn0; subst; intros. destruct (fin_case f'). subst; auto. destruct H0; subst. simpl. eapply IHn. congruence. } } Qed. Definition vector_tl {T : Type} {n : nat} (v : vector T (S n)) : vector T n := snd v. Definition vector_hd {T : Type} {n : nat} (v : vector T (S n)) : T := fst v. coq-ext-lib-0.12.0/theories/Data/Unit.v000066400000000000000000000004641451523051500175240ustar00rootroot00000000000000Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. Global Instance RelDec_eq_unit : RelDec (@eq unit) := { rel_dec := fun _ _ => true }. Global Instance RelDec_Correct_eq_unit : RelDec_Correct RelDec_eq_unit. constructor. destruct x; destruct y; auto; simpl. intuition. Qed. coq-ext-lib-0.12.0/theories/Data/Vector.v000066400000000000000000000143761451523051500200560ustar00rootroot00000000000000Require Import ExtLib.Data.Fin. Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. Inductive vector T : nat -> Type := | Vnil : vector T 0 | Vcons : forall {n}, T -> vector T n -> vector T (S n). Section parametric. Variable T : Type. Definition vector_hd n (v : vector T (S n)) : T := match v in vector _ n' return match n' with | 0 => unit | S _ => T end with | Vnil => tt | Vcons _ x _ => x end. Definition vector_tl n (v : vector T (S n)) : vector T n := match v in vector _ n' return match n' with | 0 => unit | S n => vector T n end with | Vnil => tt | Vcons _ _ x => x end. Theorem vector_eta : forall n (v : vector T n), v = match n as n return vector T n -> vector T n with | 0 => fun _ => Vnil _ | S n => fun v => Vcons (vector_hd v) (vector_tl v) end v. Proof. destruct v; auto. Qed. Fixpoint get {n : nat} (f : fin n) : vector T n -> T := match f in fin n return vector T n -> T with | F0 n => @vector_hd _ | FS n f => fun v => get f (vector_tl v) end. Fixpoint put {n : nat} (f : fin n) (t : T) : vector T n -> vector T n := match f in fin n return vector T n -> vector T n with | F0 _ => fun v => Vcons t (vector_tl v) | FS _ f => fun v => Vcons (vector_hd v) (put f t (vector_tl v)) end. Theorem get_put_eq : forall {n} (v : vector T n) (f : fin n) val, get f (put f val v) = val. Proof. induction n. { inversion f. } { remember (S n). destruct f. inversion Heqn0; subst; intros; reflexivity. inversion Heqn0; subst; simpl; auto. } Qed. Theorem get_put_neq : forall {n} (v : vector T n) (f f' : fin n) val, f <> f' -> get f (put f' val v) = get f v. Proof. induction n. { inversion f. } { remember (S n); destruct f. { inversion Heqn0; clear Heqn0; subst; intros. destruct (fin_case f'); try congruence. destruct H0; subst. auto. } { inversion Heqn0; clear Heqn0; subst; intros. destruct (fin_case f'). subst; auto. destruct H0; subst. simpl. eapply IHn. congruence. } } Qed. Section ForallV. Variable P : T -> Prop. Inductive ForallV : forall n, vector T n -> Prop := | ForallV_nil : ForallV (Vnil _) | ForallV_cons : forall n e es, P e -> @ForallV n es -> ForallV (Vcons e es). Definition ForallV_vector_hd n (v : vector T (S n)) (f : ForallV v) : P (vector_hd v) := match f in @ForallV n v return match n as n return vector T n -> Prop with | 0 => fun _ => True | S _ => fun v => P (vector_hd v) end v with | ForallV_nil => I | ForallV_cons _ _ _ pf _ => pf end. Definition ForallV_vector_tl n (v : vector T (S n)) (f : ForallV v) : ForallV (vector_tl v) := match f in @ForallV n v return match n as n return vector T n -> Prop with | 0 => fun _ => True | S _ => fun v => ForallV (vector_tl v) end v with | ForallV_nil => I | ForallV_cons _ _ _ _ pf => pf end. End ForallV. Section vector_dec. Variable Tdec : forall a b : T, {a = b} + {a <> b}. Fixpoint vector_dec {n} (a : vector T n) : forall b : vector T n, {a = b} + {a <> b} := match a in vector _ n return forall b : vector T n, {a = b} + {a <> b} with | Vnil => fun b => left match b in vector _ 0 with | Vnil => eq_refl end | Vcons _ a a' => fun b => match b as b in vector _ (S n) return forall a', (forall a : vector T n, {a' = a} + {a' <> a}) -> {Vcons a a' = b} + {Vcons a a' <> b} with | Vcons _ b b' => fun a' rec => match Tdec a b , rec b' with | left pf , left pf' => left match pf , pf' with | eq_refl , eq_refl => eq_refl end | right pf , _ => right (fun x : Vcons a a' = Vcons b b' => pf match x in _ = z return a = vector_hd z with | eq_refl => eq_refl end) | left _ , right pf => right (fun x : Vcons a a' = Vcons b b' => pf match x in _ = z return a' = vector_tl z with | eq_refl => eq_refl end) end end a' (@vector_dec _ a') end. End vector_dec. Section vector_in. Variable a : T. Inductive vector_In : forall {n}, vector T n -> Prop := | vHere : forall n rst, @vector_In (S n) (Vcons a rst) | vNext : forall n rst b, @vector_In n rst -> @vector_In (S n) (Vcons b rst). End vector_in. Lemma ForallV_vector_In : forall {n} t (vs : vector T n) P, ForallV P vs -> vector_In t vs -> P t. Proof. induction 2. - eapply (ForallV_vector_hd H). - eapply IHvector_In. eapply (ForallV_vector_tl H). Qed. End parametric. Section vector_map. Context {T U : Type}. Variable f : T -> U. Fixpoint vector_map {n} (v : vector T n) : vector U n := match v with | Vnil => Vnil _ | Vcons _ v vs => Vcons (f v) (vector_map vs) end. End vector_map. Arguments vector T n. Arguments vector_hd {T n} _. Arguments vector_tl {T n} _. coq-ext-lib-0.12.0/theories/Data/Z.v000066400000000000000000000026551451523051500170220ustar00rootroot00000000000000Require Import ZArith. Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. Global Instance RelDec_zeq : RelDec (@eq Z) := { rel_dec := Z.eqb }. Global Instance RelDec_zlt : RelDec (Z.lt) := { rel_dec := Z.ltb }. Global Instance RelDec_zle : RelDec (Z.le) := { rel_dec := Z.leb }. Global Instance RelDec_zgt : RelDec (Z.gt) := { rel_dec := Z.gtb }. Global Instance RelDec_zge : RelDec (Z.ge) := { rel_dec := Z.geb }. Global Instance RelDec_Correct_zeq : RelDec_Correct RelDec_zeq. Proof. constructor; simpl. intros. apply Z.eqb_eq. Qed. Global Instance RelDec_Correct_zlt : RelDec_Correct RelDec_zlt. Proof. constructor; simpl. intros. generalize (Zlt_cases x y). unfold rel_dec. simpl. destruct ((x ? y)%Z); intros; intuition; congruence. Qed. Global Instance RelDec_Correct_zge : RelDec_Correct RelDec_zge. Proof. constructor; simpl. intros. generalize (Zge_cases x y). unfold rel_dec; simpl. destruct ((x >=? y)%Z); intros; intuition; congruence. Qed. coq-ext-lib-0.12.0/theories/ExtLib.v000066400000000000000000000000431451523051500171140ustar00rootroot00000000000000Require Export ExtLib.Core.RelDec. coq-ext-lib-0.12.0/theories/Generic/000077500000000000000000000000001451523051500171155ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Generic/Data.v000066400000000000000000000141771451523051500201670ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import ExtLib.Data.Member. Require Import ExtLib.Data.HList. Require Import ExtLib.Generic.Func. (** This module gives a representation of inductive types **) Set Implicit Arguments. Set Strict Implicit. Fixpoint hlist_to_tuple ps (h : hlist (fun x : Type => x) ps) : asTuple ps := match h in hlist _ ps return asTuple ps with | Hnil => tt | Hcons x h => (x,hlist_to_tuple h) end. Inductive itype (ps : list Type) : Type := | Inj : Type -> itype ps | Rec : hlist (fun x => x) ps -> itype ps | Sum : itype ps -> itype ps -> itype ps | Prod : itype ps -> itype ps -> itype ps | Sig : forall T : Type, (T -> itype ps) -> itype ps | Pi : forall T : Type, (T -> itype ps) -> itype ps | Get : forall T : Type, member T ps -> (T -> itype ps) -> itype ps | Unf : forall T : Type, member T ps -> T -> itype ps -> itype ps. Definition Unit {ps} := @Inj ps unit. Section denote. Variable (ps : list Type). Fixpoint itypeD (i : itype ps) {struct i} : asFunc ps Type -> asFunc ps Type := match i return asFunc ps Type -> asFunc ps Type with | Get pf f => fun F => @get ps _ _ pf (fun x => itypeD (f x) F) | Inj _ T => fun _ => const T | Rec h => fun F => const (applyF F (hlist_to_tuple h)) | @Sig _ t f => fun F => @under _ _ (fun App => @sigT t (fun x' => App _ (itypeD (f x') F))) | @Pi _ t f => fun F => @under _ _ (fun App => forall x' : t, App _ (itypeD (f x') F)) | Sum a b => fun F => combine sum ps (itypeD a F) (itypeD b F) | Prod a b => fun F => combine prod ps (itypeD a F) (itypeD b F) | @Unf _ T pf v i => fun F => @get ps _ _ pf (fun x => combine prod _ (const (x = v : Type)) (replace pf v (itypeD i F))) end%type. End denote. Section _match. Variable ps : list Type. Variable RecT : asFunc ps Type. (** NOTE: Non-dependent **) Fixpoint cases (i : itype ps) (k : asFunc ps Type -> asFunc ps Type) {struct i} : asFunc ps Type := match i with | Inj _ T => k (const T) | Sum a b => combine prod ps (cases a k) (cases b k) | Prod a b => cases a (fun A => cases b (fun B => under _ _ (fun App => App _ A -> App _ (k B)))) | Rec ps => k (const (applyF RecT (hlist_to_tuple ps))) | @Get _ T m f => @get _ _ _ m (fun x => cases (f x) k) | @Sig _ t f => @under _ _ (fun App => forall x' : t, (App _ (cases (f x') k))) | @Pi _ t f => @under _ _ (fun App => @sigT t (fun x' => App _ (cases (f x') k))) | @Unf _ T pf v i => replace pf v (cases i k) end. End _match. Fixpoint asPiE ps {struct ps} : forall (F : _) (G : forall x : (forall U, asFunc ps U -> U), F x), asPi ps F := match ps as ps return forall F : (forall U : Type, asFunc ps U -> U) -> Type, (forall x : forall U : Type, asFunc ps U -> U, F x) -> asPi ps F with | nil => fun _ G => G _ | p :: ps => fun _ G => fun x => asPiE _ _ (fun x' => G _) end. Fixpoint asPi_combine ps {struct ps} : forall (F G : _), asPi ps (fun App => F App -> G App) -> asPi ps F -> asPi ps G := match ps as ps return forall F G : (forall U : Type, asFunc ps U -> U) -> Type, asPi ps (fun App : forall U : Type, asFunc ps U -> U => F App -> G App) -> asPi ps F -> asPi ps G with | nil => fun _ _ a b => a b | p :: ps => fun _ _ a b x => asPi_combine _ _ _ (a x) (b x) end. (* Section _mmatch. Variable ps : list Type. Variable RecT : asFunc ps Type. Fixpoint Fmatch (i : itype ps) (Ret : asFunc ps Type) (brs : asPi ps (fun App => App _ (cases RecT i (fun x => combine (fun x y => x -> y) _ x Ret)))) {struct i} : asPi ps (fun App => App _ (itypeD i RecT) -> App _ Ret). destruct i. { simpl in *. revert brs. unfold combine. apply asPi_combine. apply asPiE. intro. intro. destruct i. { simpl in *. Abort. *) (** Some Examples **) (** Vectors **) (* Definition rfvec T : itype ((nat : Type) :: nil) := @Get ((nat : Type) :: @nil Type) nat (MZ _ _) (fun x => match x with | 0 => Inj _ unit | S n => Prod (Inj _ T) (Rec (Hcons n Hnil)) end). Definition rfvec' T : itype ((nat : Type) :: nil) := Sum (@Get ((nat : Type) :: @nil Type) nat (MZ _ _) (fun x => Inj _ (x = 0))) (@Get ((nat : Type) :: @nil Type) nat (MZ _ _) (fun x => Sig (fun n : nat => Prod (Inj _ T) (Prod (Rec (Hcons n Hnil)) (Inj _ (x = S n)))))). Definition rfvec'' T : itype ((nat : Type) :: nil) := Sum (Unf (MZ _ _) 0 Unit) (Sig (fun n : nat => (Unf (MZ _ _) (S n) (Prod (Inj _ T) (Rec (Hcons n Hnil)))))). Eval simpl in fun T => itypeD (rfvec T). Eval simpl in fun T => itypeD (rfvec' T). Eval simpl in fun T => itypeD (rfvec'' T). Eval simpl in fun T Result Rec => @cases _ Rec (rfvec T) (fun x => combine (fun x y => x -> y) _ x Result). Eval simpl in fun T Result Rec => @cases _ Rec (rfvec' T) (fun x => combine (fun x y => x -> y) _ x Result). Eval simpl in fun T Result Rec => @cases _ Rec (rfvec'' T) (fun x => combine (fun x y => x -> y) _ x Result). (** Nats **) Definition rfnat := Sum (Inj nil unit) (Rec Hnil). Eval simpl in fun Result Rec => @Tmatch _ Rec rfnat (fun x => combine (fun x y => x -> y) _ x Result). Definition inat := Eval simpl in itypeD rfnat. Definition i0 : inat := @existT bool (fun x' => itypeD nil (if x' then Inj nil unit else Rec nil Hnil) nat) true tt. Definition iS : nat -> inat := @existT bool (fun x' => itypeD nil (if x' then Inj nil unit else Rec nil Hnil) nat) false. Definition fold (i : nat) : inat := match i with | 0 => i0 | S n => iS n end. Definition unfold (i : inat) : nat := match i with | existT true _ => 0 | existT false x => S x end. Theorem fold_unfold : forall x, fold (unfold x) = x. Proof. destruct x; simpl. destruct x; simpl. { simpl in *. destruct i. reflexivity. } { simpl in *. reflexivity. } Qed. Theorem unfold_fold : forall x, unfold (fold x) = x. Proof. destruct x; simpl; reflexivity. Qed. *)coq-ext-lib-0.12.0/theories/Generic/DerivingData.v000066400000000000000000000046751451523051500216610ustar00rootroot00000000000000Require Import String List. Require Import ExtLib.Data.HList. Set Implicit Arguments. Set Strict Implicit. Inductive data T : (T -> Type) -> Type := | Inj : forall X, Type -> data X | Get : forall X, T -> data X | Prod : forall X, data X -> data X -> data X | Sigma : forall X (S : Type), (S -> data X) -> data X | Pi : forall X (S : Type), (S -> data X) -> data X. Fixpoint dataD (T : Type) (X : T -> Type) (d : data X) : Type := match d with | Inj _X x => x | Get X i => X i | Prod l r => prod (dataD l) (dataD r) | @Sigma _ _ i s => @sigT i (fun v => dataD (s v)) | @Pi _ _ i s => forall v : i, dataD (s v) end. (** Example of lists as data **) Definition dataList (a : Type) : @data unit (fun _ => list a) := @Sigma _ _ bool (fun x => match x with | true => @Inj _ _ unit | false => @Prod _ _ (Inj _ a) (Get _ tt) end). Theorem dataList_to_list : forall T (x : dataD (dataList T)), list T. simpl. intros. destruct x. destruct x. apply nil. simpl in *. apply (fst d :: snd d). Defined. Theorem list_to_dataList : forall T (ls : list T), dataD (dataList T). simpl. destruct 1. exists true. apply tt. exists false. apply (t, ls). Defined. Fixpoint dataP (T : Type) (X : T -> Type) (d : data X) (R : Type) : Type := match d with | Inj _X x => x -> R | Get X x => X x -> R | @Prod _ _ l r => dataP l (dataP r R) | @Sigma _ _ i s => forall i, dataP (s i) R | @Pi _ _ i s => (forall i, dataD (s i)) -> R end. Fixpoint dataMatch (T : Type) (X : T -> Type) (d : data X) {struct d} : forall (R : Type), dataP d R -> dataD d -> R := match d as d return forall (R : Type), dataP d R -> dataD d -> R with | Inj _ _ => fun _ p => p | Get X x => fun _ p => p | @Prod _ _ l r => fun _ p v => dataMatch r _ (dataMatch l _ p (fst v)) (snd v) | @Sigma _ _ i d => fun _ p v => match v with | existT _ x y => dataMatch (d x) _ (p _) y end | @Pi _ _ i d => fun _ p v => p v end. (* This used to work (** You really need a fold! **) Fixpoint dataLength {x} (l : list x) Z {struct l} : nat := dataMatch (dataList x) _ (fun tag => match tag with | true => fun _ => 0 | false => fun h t => S (Z t) (* (dataLength t) *) end) (list_to_dataList l). *)coq-ext-lib-0.12.0/theories/Generic/Func.v000066400000000000000000000053441451523051500202050ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import ExtLib.Data.Member. Fixpoint asFunc (domain : list Type) (range : Type) : Type := match domain with | nil => range | d :: ds => d -> asFunc ds range end. Fixpoint asPi (ps : list Type) {struct ps} : ((forall U, asFunc ps U -> U) -> Type) -> Type := match ps as ps return ((forall U, asFunc ps U -> U) -> Type) -> Type with | nil => fun f => f (fun _ x => x) | p :: ps => fun f => forall x : p, asPi ps (fun App => f (fun _ f' => App _ (f' x))) end. Fixpoint asTuple (domain : list Type) : Type := match domain with | nil => unit | d :: ds => prod d (asTuple ds) end. Fixpoint applyF {domain : list Type} {range : Type} : asFunc domain range -> asTuple domain -> range := match domain as domain return asFunc domain range -> asTuple domain -> range with | nil => fun x _ => x | d :: ds => fun f x_xs => applyF (f (fst x_xs)) (snd x_xs) end. Fixpoint const {D R} (r : R) : asFunc D R := match D with | nil => r | _ :: D => fun _ => const r end. Fixpoint uncurry {D R} {struct D} : (asTuple D -> R) -> asFunc D R := match D as D return (asTuple D -> R) -> asFunc D R with | nil => fun x => x tt | d :: D => fun f d => uncurry (fun x => f (d, x)) end. Fixpoint curry {D R} {struct D} : asFunc D R -> (asTuple D -> R) := match D as D return asFunc D R -> (asTuple D -> R) with | nil => fun x _ => x | d :: D => fun f x => curry (f (fst x)) (snd x) end. Fixpoint get (domain : list Type) (range : Type) T (m : member T domain) : (T -> asFunc domain range) -> asFunc domain range := match m in member _ domain return (T -> asFunc domain range) -> asFunc domain range with | MZ _ _ => fun F x => F x x | MN _ m => fun F x => @get _ _ _ m (fun y => F y x) end. Fixpoint under (domain : list Type) (range : Type) {struct domain} : ((forall U, asFunc domain U -> U) -> range) -> asFunc domain range := match domain as domain return ((forall U, asFunc domain U -> U) -> range) -> asFunc domain range with | nil => fun F => F (fun _ x => x) | d :: ds => fun F x => under ds range (fun App => F (fun U f => App U (f x))) end%type. Fixpoint replace {ps} {T U : Type} (m : member T ps) (v : T) {struct m} : asFunc ps U -> asFunc ps U := match m in member _ ps return asFunc ps U -> asFunc ps U with | MZ _ _ => fun f _ => f v | MN _ m => fun f x => replace m v (f x) end. Section combine. Context {T U V : Type}. Variable (join : T -> U -> V). Definition combine (domain : list Type) (a : asFunc domain T) (b : asFunc domain U) : asFunc domain V := under domain _ (fun App => join (App _ a) (App _ b)). End combine. coq-ext-lib-0.12.0/theories/Generic/Ind.v000066400000000000000000000121571451523051500200240ustar00rootroot00000000000000Require Import List String. Require Import ExtLib.Structures.CoMonad. Set Implicit Arguments. Set Strict Implicit. Inductive type : Type := | Self : type | Inj : Type -> type. Definition product := list type. Definition variant := list product. Section denote. Variable M : Type. Definition typeD (t : type) : Type := match t with | Self => M | Inj t => t end. Definition func (T : Type) (v : product) : Type := fold_right (fun x acc => typeD x -> acc) T v. Definition data (v : product) : Type := fold_right (fun x acc => typeD x * acc)%type unit v. Definition matchD (T : Type) (v : variant) : Type := fold_right (fun x acc => func T x -> acc)%type T v. Definition dataD (v : variant) : Type := fold_right (fun x acc => data x + acc)%type Empty_set v. Definition recD (T : Type) (c : Type -> Type) (v : variant) : Type := fold_right (fun x acc => fold_right (fun x acc => match x with | Inj t => t | Self => c T end -> acc) (c T) x -> acc) (M -> T) v. End denote. Class Data (T : Type) : Type := { repr : variant ; into : dataD T repr -> T ; outof : T -> forall A, matchD T A repr ; rec : forall c {_ : CoMonad c}, forall A, recD T A c repr }. Local Open Scope string_scope. Global Instance Data_nat : Data nat := { repr := nil :: (Self :: nil) :: nil ; outof := fun x _ z s => match x with | 0 => z | S n => s n end ; into := fun d => match d with | inl tt => 0 | inr (inl (n, tt)) => n | inr (inr x) => match x with end end ; rec := fun c _ A z s d => extract ((fix recur (d : nat) {struct d} : c A := match d with | 0 => z | S n => s (recur n) end) d) }. Global Instance Data_list {A} : Data (list A) := { repr := (nil) :: (Inj A :: Self :: nil) :: nil ; outof := fun x _ n c => match x with | nil => n | x :: xs => c x xs end ; into := fun d => match d with | inl tt => nil | inr (inl (x, (xs, tt))) => x :: xs | inr (inr x) => match x with end end ; rec := fun c _ T n co d => extract ((fix recur (ds : list A) {struct ds} : c T := match ds with | nil => n | d :: ds => co d (recur ds) end) d) }. (** Example of deriving Show from Data **) Require Import ExtLib.Programming.Show. Require Import ExtLib.Data.Monads.IdentityMonad. Require Import ExtLib.Structures.Monads. Global Instance Comoand_Id : CoMonad id := { extract := fun _ x => x ; extend := fun _ _ x f => x f }. (* Inductive AllResolve (C : Type -> Type) : list type -> Type := | AllResolve_nil : AllResolve C nil | AllResolve_Self : forall ls, AllResolve C ls -> AllResolve C (Self :: ls) | AllResolve_Inj : forall t ls, C t -> AllResolve C ls -> AllResolve C (Inj t :: ls). Existing Class AllResolve. *) Definition ProductResolve (C : Type -> Type) (r : product) : Type := fold_right (fun t acc => match t with | Inj t => C t * acc | Self => acc end)%type unit r. Definition VariantResolve (C : Type -> Type) (r : variant) : Type := fold_right (fun p acc => ProductResolve C p * acc)%type unit r. Existing Class VariantResolve. Ltac all_resolve := simpl VariantResolve; simpl ProductResolve; repeat match goal with | |- unit => apply tt | |- (unit * _)%type => constructor; [ apply tt | ] | |- (_ * _)%type => constructor | |- _ => solve [ eauto with typeclass_instances ] end. #[global] Hint Extern 0 (ProductResolve _ _) => all_resolve : typeclass_instances. #[global] Hint Extern 0 (VariantResolve _ _) => all_resolve : typeclass_instances. Definition comma_before (b : bool) (s : showM) : showM := if b then cat (show_exact ",") s else s. Fixpoint show_product (first : bool) (r : list type) {struct r} : ProductResolve Show r -> (showM -> showM) -> (fold_right (fun (x : type) (acc : Type) => match x with | Self => showM | Inj t => t end -> acc) (showM) r). refine ( match r as r return ProductResolve Show r -> (showM -> showM) -> (fold_right (fun (x : type) (acc : Type) => match x with | Self => showM | Inj t => t end -> acc) (showM) r) with | nil => fun _ f => f empty | Self :: rs => fun a f s => @show_product false rs a (fun s' => f (cat s (comma_before first s'))) | Inj t :: rs => fun a f x => @show_product false rs (snd a) (fun s' => f (cat ((fst a) x) (comma_before first s'))) end); simpl in *. Defined. Global Instance Show_data (T : Type) (d : Data T) (AS : VariantResolve Show repr) : Show T := { show := (fix recur (repr : variant) : VariantResolve Show repr -> recD T showM id repr -> T -> showM := match repr as repr return VariantResolve Show repr -> recD T showM id repr -> T -> showM with | nil => fun _ x => x | r :: rs => fun a k' => recur rs (snd a) (k' (show_product true _ (fst a) (fun s' => cat (show_exact "-") (cat (show_exact "(") (cat s' (show_exact ")")))))) end) repr AS (rec (c := id) showM) }. Eval compute in to_string (M := Show_data _ _) (5 :: 6 :: 7 :: nil). coq-ext-lib-0.12.0/theories/Programming/000077500000000000000000000000001451523051500200235ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Programming/Eqv.v000066400000000000000000000033731451523051500207530ustar00rootroot00000000000000Require Import Equivalence. Require Import ExtLib.Core.RelDec. Class Eqv T := eqv : T -> T -> Prop. Definition neg_eqv {T} {E:Eqv T} (x:T) (y:T) : Prop := not (eqv x y). Class EqvWF T := { eqvWFEqv :> Eqv T ; eqvWFEquivalence :> Equivalence eqv }. #[global] Instance EqvWF_Build {T} {E:Eqv T} {EV:Equivalence eqv} : EqvWF T := { eqvWFEqv := E ; eqvWFEquivalence := EV }. Definition eqv_dec {T} {E:Eqv T} {R:RelDec eqv} := rel_dec. Definition neg_eqv_dec {T} {E:Eqv T} {R:RelDec eqv} x y := negb (rel_dec x y). Section eqv_decP. Context {T} {E:Eqv T}. Context {RD:RelDec eqv} {RDC:RelDec_Correct RD}. Definition eqv_dec_p (x:T) (y:T) : {eqv x y} + {~eqv x y} := rel_dec_p x y. Definition neg_eqv_dec_p (x:T) (y:T) : {~eqv x y} + {eqv x y} := neg_rel_dec_p x y. End eqv_decP. Module EqvNotation. Infix "~=!" := eqv_dec (at level 35, no associativity). Infix "/~=!" := neg_eqv_dec (at level 35, no associativity). Infix "~=?" := eqv_dec_p (at level 35, no associativity). Infix "/~=?" := neg_eqv_dec_p (at level 35, no associativity). Infix "~=" := eqv (at level 70, no associativity). Infix "/~=" := neg_eqv (at level 70, no associativity). End EqvNotation. Import EqvNotation. Section injection_eqv_equivalence. Context {T U:Type}. Context {TE:EqvWF T}. Context {UE:Eqv U}. Variable (inj:U -> T). Variable injResp : forall u1 u2, u1 ~= u2 <-> inj u1 ~= inj u2. Definition injection_eqv_equivalence : Equivalence (eqv (T:=U)). Proof. repeat constructor ; unfold Reflexive ; unfold Symmetric ; unfold Transitive ; intros. apply injResp. reflexivity. apply injResp. apply injResp in H. symmetry. auto. apply injResp. apply injResp in H. apply injResp in H0. transitivity (inj y) ; auto. Qed. End injection_eqv_equivalence. coq-ext-lib-0.12.0/theories/Programming/Extras.v000066400000000000000000000052031451523051500214600ustar00rootroot00000000000000Require Import List. Require Import String. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Core.RelDec. (*Require Import Injection. *) Open Scope string_scope. Import MonadNotation ListNotations. Open Scope monad_scope. Set Implicit Arguments. Set Maximal Implicit Insertion. Module FunNotation. Notation "f $ x" := (f x) (at level 99, x at level 99, right associativity, only parsing). Notation "'begin' e1 'end'" := ((e1)) (at level 0, only parsing). End FunNotation. Import FunNotation. Definition deprecated_uncurry A B C (f:A -> B -> C) (x:A * B) : C := let (a,b) := x in f a b. #[deprecated(since = "8.13", note = "Use standard library.")] Notation uncurry := deprecated_uncurry. Definition deprecated_curry {A B C} (f : A * B -> C) (a : A) (b : B) : C := f (a, b). #[deprecated(since = "8.13", note = "Use standard library.")] Notation curry := deprecated_curry. Lemma deprecated_uncurry_curry : forall A B C (f : A -> B -> C) a b, curry (uncurry f) a b = f a b. Proof. unfold curry, uncurry. reflexivity. Qed. #[deprecated(since = "8.13", note = "Use standard library.")] Notation uncurry_curry := deprecated_uncurry_curry. Lemma deprecated_curry_uncurry : forall A B C (f : A * B -> C) ab, uncurry (curry f) ab = f ab. Proof. unfold uncurry, curry. destruct ab. reflexivity. Qed. #[deprecated(since = "8.13", note = "Use standard library.")] Notation curry_uncurry := deprecated_curry_uncurry. Fixpoint deprecated_zip A B (xs:list A) (ys:list B) : list (A * B) := match xs, ys with | [], _ => [] | _, [] => [] | x::xs, y::ys => (x,y)::deprecated_zip xs ys end . #[deprecated(note = "Use List.combine instead.")] Notation zip := deprecated_zip. Fixpoint deprecated_unzip A B (xys:list (A * B)) : list A * list B := match xys with | [] => ([], []) | (x,y)::xys => let (xs,ys) := deprecated_unzip xys in (x::xs,y::ys) end. #[deprecated(note = "Use List.split instead.")] Notation unzip := deprecated_unzip. Definition sum_tot {A} (x:A + A) : A := match x with inl a => a | inr a => a end. Definition forEach A B (xs:list A) (f:A -> B) : list B := map f xs. Definition lsingleton {A} (x:A) : list A := [x]. Definition firstf {A B C} (f:A->C) (xy:A*B) : C*B := let (x,y) := xy in (f x, y). Definition secondf {A B C} (f:B->C) (xy:A*B) : A*C := let (x,y) := xy in (x, f y). Fixpoint update {K V} {kRealDec:RelDec (@eq K)} x v l : list (K * V) := match l with | [] => [(x,v)] | (y,w)::l' => if eq_dec x y then (x,v)::l' else (y,w)::update x v l' end. Definition updateMany {K V} {kRealDec:RelDec (@eq K)} (ups:list (K * V)) (init:list (K * V)) : list (K * V) := fold_right (uncurry update) init ups. coq-ext-lib-0.12.0/theories/Programming/Injection.v000066400000000000000000000011321451523051500221310ustar00rootroot00000000000000Require Import Coq.Strings.Ascii. Require Import Coq.Strings.String. Set Implicit Arguments. Set Maximal Implicit Insertion. Polymorphic Class Injection (x : Type) (t : Type) := inject : x -> t. (* Class Projection x t := { project : t -> x ; pmodify : (x -> x) -> (t -> t) }. *) #[global] Polymorphic Instance Injection_refl {T : Type} : Injection T T := { inject := @id T }. #[global] Instance Injection_ascii_string : Injection ascii string := { inject a := String a EmptyString }. #[global] Instance Injection_ascii_string_cons : Injection ascii (string -> string) := { inject := String }. coq-ext-lib-0.12.0/theories/Programming/Le.v000066400000000000000000000104101451523051500205460ustar00rootroot00000000000000Require Import Coq.Bool.Bool. Require Import Equivalence. Require Import ExtLib.Core.RelDec. Class Lte T := { lte : T -> T -> Prop }. Definition neg_lte {T} {L:Lte T} (x:T) (y:T) : Prop := not (lte x y). Definition lt {T} {L:Lte T} x y := lte x y /\ ~lte y x. Definition neg_lt {T} {L:Lte T} x y := not (lt x y). #[global] Instance lt_RelDec {T} {L:Lte T} {RD:RelDec lte} : RelDec lt := { rel_dec x y := (rel_dec x y && negb (rel_dec y x))%bool }. #[global] Instance lt_RelDecCorrect {T} {L:Lte T} {RD:RelDec lte} {RDC:RelDec_Correct RD} : RelDec_Correct lt_RelDec. Proof. constructor. intros ; constructor ; intros. unfold rel_dec in H. simpl in H. apply andb_true_iff in H. destruct H. unfold lt. constructor. apply rel_dec_correct. auto. apply neg_rel_dec_correct. simpl in H0. apply negb_true_iff in H0. auto. unfold lt in H. destruct H. unfold rel_dec. simpl. apply andb_true_iff. constructor. apply rel_dec_correct. auto. apply negb_true_iff. apply neg_rel_dec_correct. auto. Qed. Class LteWF T := { lteWFLte :> Lte T ; lteWFPreOrder :> PreOrder lte }. #[global] Instance LteWF_Build {T} {L:Lte T} {PO:PreOrder lte} : LteWF T := { lteWFLte := L ; lteWFPreOrder := PO }. Definition lte_dec {T} {L:Lte T} {R:RelDec lte} := rel_dec. Definition neg_lte_dec {T} {L:Lte T} {R:RelDec lte} x y := negb (lte_dec x y). Definition lt_dec {T} {L:Lte T} {R:RelDec lte} := rel_dec. Definition neg_lt_dec {T} {L:Lte T} {R:RelDec lte} x y := negb (lt_dec x y). Section dec_p. Context {T} {L:Lte T} {RD:RelDec lte} {DC:RelDec_Correct RD}. Definition lte_dec_p (x:T) (y:T) : {lte x y} + {~lte x y} := rel_dec_p x y. Definition neg_lte_dec_p (x:T) (y:T) : {~lte x y} + {lte x y} := neg_rel_dec_p x y. Definition lt_dec_p (x:T) (y:T) : {lt x y} + {~lt x y} := rel_dec_p x y. Definition neg_lt_dec_p (x:T) (y:T) : {~lt x y} + {lt x y} := neg_rel_dec_p x y. End dec_p. Module LteNotation. Notation "x <=! y" := (lte_dec x y) (at level 35, no associativity). Notation "x <=! y <=! z" := (lte_dec x y /\ lte_dec y z) (at level 35, y at next level, no associativity). Notation "x >=! y" := (lte_dec y x) (at level 35, no associativity, only parsing). Notation "x >=! y >=! z" := (lte_dec z y /\ lte_dec y x) (at level 35, y at next level, no associativity). Notation "x ! y" := (lt_dec y x) (at level 35, no associativity, only parsing). Notation "x >! y >! z" := (lt_dec z y /\ lt_dec y x) (at level 35, y at next level, no associativity). Notation "x <=? y" := (lte_dec_p y x) (at level 35, no associativity). Notation "x <=? y <=? z" := (lte_dec_p x y /\ lte_dec_p y z) (at level 35, y at next level, no associativity). Notation "x >=? y" := (lte_dec_p y x) (at level 35, no associativity, only parsing). Notation "x >=? y >=? z" := (lte_dec_p z y /\ lte_dec_p y x) (at level 35, y at next level, no associativity, only parsing). Notation "x ? y" := (lt_dec_p y x) (at level 35, no associativity, only parsing). Notation "x >? y >? z" := (lt_dec_p z y /\ lt_dec_p y x) (at level 35, y at next level, no associativity, only parsing). Notation "x <=. y" := (lte x y) (at level 70, no associativity). Notation "x <=. y <=. z" := (lte x y /\ lte y z) (at level 70, y at next level, no associativity). Notation "x >=. y" := (lte y x) (at level 70, no associativity, only parsing). Notation "x >=. y >=. z" := (lte z y /\ lte y x) (at level 70, y at next level, no associativity, only parsing). Notation "x <. y" := (lt x y) (at level 70, no associativity). Notation "x <. y <. z" := (lt x y /\ lt y z) (at level 70, y at next level, no associativity). Notation "x >. y" := (lt y x) (at level 70, no associativity, only parsing). Notation "x >. y >. z" := (lt z y /\ lt y x) (at level 70, y at next level, no associativity, only parsing). End LteNotation. coq-ext-lib-0.12.0/theories/Programming/Show.v000066400000000000000000000131141451523051500211320ustar00rootroot00000000000000Require Coq.Strings.Ascii. Require Coq.Strings.String. Require Import Coq.Strings.String. Require Import Coq.Program.Wf. Require Import Coq.PArith.BinPos. Require Import Coq.ZArith.ZArith. Require Import ExtLib.Structures.Monoid. Require Import ExtLib.Structures.Reducible. Require Import ExtLib.Programming.Injection. Require Import ExtLib.Data.Char. Require Import ExtLib.Data.String. Require Import ExtLib.Data.Fun. Require Import ExtLib.Core.RelDec. Set Implicit Arguments. Set Strict Implicit. Set Universe Polymorphism. Set Printing Universes. Monomorphic Universe Ushow. Definition showM@{T} : Type@{Ushow} := forall m : Type@{T}, Injection ascii m -> Monoid m -> m. Class ShowScheme@{t} (T : Type@{t}) : Type := { show_mon : Monoid@{t} T ; show_inj : Injection ascii T }. Global Instance ShowScheme_string : ShowScheme string := { show_mon := Monoid_string_append ; show_inj := fun x => String x EmptyString }. Global Instance ShowScheme_string_compose : ShowScheme (string -> string) := { show_mon := Monoid_compose string ; show_inj := String }. Definition runShow {T} {M : ShowScheme T} (m : showM) : T := m _ show_inj show_mon. Class Show@{t m} (T : Type@{t}) : Type := show : T -> showM@{m}. Definition to_string {T} {M : Show T} (v : T) : string := runShow (show v) ""%string. Definition empty : showM := fun _ _ m => monoid_unit m. Definition cat (a b : showM) : showM := fun _ i m => monoid_plus m (a _ i m) (b _ i m). Global Instance Injection_ascii_showM : Injection ascii showM := fun v => fun _ i _ => i v. Fixpoint show_exact (s : string) : showM := match s with | EmptyString => empty | String a s' => cat (inject a) (show_exact s') end. Module ShowNotation. Delimit Scope show_scope with show. Notation "x << y" := (cat x%show y%show) (at level 100) : show_scope. Coercion show_exact : string >-> showM. Definition _inject_char : ascii -> showM := inject. Coercion _inject_char : ascii >-> showM. End ShowNotation. Definition indent (indent : showM) (v : showM) : showM := let nl := Ascii.ascii_of_nat 10 in fun _ inj mon => v _ (fun a => if eq_dec a nl then monoid_plus mon (inj a) (indent _ inj mon) else inj a) mon. Section sepBy. Import ShowNotation. Local Open Scope show_scope. Definition sepBy {T : Type} {F : Foldable T showM} (sep : showM) (ls : T) : showM := match fold (fun s acc => match acc with | None => Some s | Some x => Some (x << sep << s) end) None ls with | None => empty | Some s => s end. End sepBy. Section sepBy_f. Import ShowNotation. Local Open Scope show_scope. Variables (T : Type) (E : Type). Context {F : Foldable T E}. Variable (f : E -> showM). Definition sepBy_f (sep : showM) (ls : T) : showM := match fold (fun s acc => match acc with | None => Some (f s) | Some x => Some (x << sep << f s) end) None ls with | None => empty | Some s => s end. End sepBy_f. Definition wrap (before after : showM) (x : showM) : showM := cat before (cat x after). Section sum_Show. Import ShowNotation. Local Open Scope show_scope. Definition sum_Show@{a m} {A : Type@{a}} {B : Type@{a}} {AS:Show@{a m} A} {BS:Show@{a m} B} : Show@{a m} (A+B) := fun s => let (tag, payload) := match s with | inl a => (show_exact "inl"%string, show a) | inr b => (show_exact "inr"%string, show b) end in "("%char << tag << " "%char << payload << ")"%char. End sum_Show. Section foldable_Show. Context {A:Type} {B:Type} {F : Foldable B A} {BS : Show A}. Global Instance foldable_Show : Show B := { show s := sepBy_f show (show_exact ", "%string) s }. End foldable_Show. Fixpoint iter_show (ss : list showM) : showM := match ss with | nil => empty | cons s ss => cat s (iter_show ss) end. Section hiding_notation. Import ShowNotation. Local Open Scope show_scope. Import Ascii. Import String. Global Instance unit_Show : Show unit := { show u := "tt"%string }. Global Instance bool_Show : Show bool := { show b := if b then "true"%string else "false"%string }. Global Instance ascii_Show : Show ascii := fun a => "'"%char << a << "'"%char. Global Instance string_Show : Show string := { show s := """"%char << s << """"%char }. Program Fixpoint nat_show (n:nat) {measure n} : showM := if Compare_dec.le_gt_dec n 9 then inject (Char.digit2ascii n) else let n' := Nat.div n 10 in (@nat_show n' _) << (inject (Char.digit2ascii (n - 10 * n'))). Next Obligation. assert (Nat.div n 10 < n) ; eauto. eapply Nat.div_lt. match goal with [ H : n > _ |- _ ] => inversion H end; apply Nat.lt_0_succ. repeat constructor. Defined. Global Instance nat_Show : Show nat := { show := nat_show }. Global Instance Show_positive : Show positive := fun x => nat_show (Pos.to_nat x). Global Instance Show_Z : Show Z := fun x => match x with | Z0 => "0"%char | Zpos p => show p | Zneg p => "-"%char << show p end. End hiding_notation. Section pair_Show. Import ShowNotation. Local Open Scope show_scope. Definition pair_Show@{a m t} {A : Type@{a}} {B : Type@{a}} {AS:Show A} {BS:Show B} : Show@{_ t} (A*B) := fun p => let (a,b) := p in "("%char << show a << ","%char << show b << ")"%char. End pair_Show. (* Examples: Eval compute in (runShow (show (42,"foo"%string)) : string). Eval compute in (runShow (show (inl true : bool+string))). *) coq-ext-lib-0.12.0/theories/Programming/With.v000066400000000000000000000032351451523051500211300ustar00rootroot00000000000000Require Import Coq.Lists.List. Set Asymmetric Patterns. Fixpoint Ctor {T : Type} (ls : list {x : Type & T -> x}) : Type := match ls with | nil => T | a :: b => (projT1 a) -> Ctor b end. Class Struct (T : Type) : Type := { fields : list {x : Type & T -> x} ; ctor : Ctor fields }. Section With. Variable T : Type. Variable strt : Struct T. Variable rec : T. Section Member. Variable U : Type. Inductive Mem : list {x : Type & T -> x} -> Type := | Here : forall a b, Mem ((@existT _ _ U a) :: b) | Next : forall a b, Mem b -> Mem (a :: b). End Member. Fixpoint applyRest (f : list {x : Type & T -> x}) : Ctor f -> T := match f as f return Ctor f -> T with | nil => fun x => x | a :: b => fun acc => applyRest b (acc ((projT2 a) rec)) end. Section Until. Context {U : Type}. Variable (v : U). Fixpoint applyUntil (f : list {x : Type & T -> x}) (n : Mem U f) : Ctor f -> T := match n in Mem _ f return Ctor f -> T with | Here a b => fun ctor => applyRest b (ctor v) | Next a b i => fun ctor => applyUntil b i (ctor ((projT2 a) rec)) end. End Until. Definition structWith {U : Type} (v : U) (n : Mem U fields) : T := applyUntil v fields n ctor. End With. Class Accessor {T U : Type} {strt : Struct T} (f : T -> U) : Type := { acc : Mem T U fields }. Definition wrapWith {T U : Type} (t : T) (f : T -> U) (v : U) (_strt : Struct T) (_acc : Accessor f) := @structWith _ _ t _ v acc. Delimit Scope struct_scope with record. Notation "{$ x 'with' y ':=' v $}" := (@wrapWith _ _ x y v _ _) : struct_scope. Arguments Next { T U a b }. Arguments Here { T U a b }. coq-ext-lib-0.12.0/theories/Recur/000077500000000000000000000000001451523051500166215ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Recur/Facts.v000066400000000000000000000006671451523051500200610ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Lemma wf_anti_sym T (R : T -> T -> Prop) (wf : well_founded R) : Irreflexive R. Proof. refine (fun a => (@Fix _ _ wf (fun x => x = a -> R x a ->False) (fun x rec pf pfr => rec _ match eq_sym pf in _ = t return R x t with | eq_refl => pfr end pf pfr)) a eq_refl). Qed.coq-ext-lib-0.12.0/theories/Recur/GenRec.v000066400000000000000000000023211451523051500201510ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Set Implicit Arguments. Set Strict Implicit. Fixpoint guard A (R : A -> A -> Prop) (n : nat) (wfR : well_founded R) {struct n}: well_founded R := match n with | 0 => wfR | S n => fun x => Acc_intro x (fun y _ => guard n (guard n wfR) y) end. Section setoid_fix. Variables (A : Type) (R : A -> A -> Prop) (Rwf : well_founded R). Variables (P : A -> Type) (F : forall x : A, (forall y : A, R y x -> P y) -> P x). Variable r : forall x : A, P x -> P x -> Prop. Hypothesis Hstep : forall (x : A) (f g : forall y : A, R y x -> P y), (forall (y : A) (p : R y x), r (f y p) (g y p)) -> r (@F x f) (@F x g). Lemma Fix_F_equiv_inv : forall (x : A) (r' s' : Acc R x), r (Fix_F _ F r') (Fix_F _ F s'). Proof. intro x; induction (Rwf x); intros. rewrite <- (Fix_F_eq _ F r'); rewrite <- (Fix_F_eq _ F s'); intros. eapply Hstep. eauto. Qed. Theorem Fix_equiv : forall x : A, r (Fix Rwf P F x) (@F x (fun (y : A) (_ : R y x) => Fix Rwf P F y)). Proof. intro x; unfold Fix. rewrite <- Fix_F_eq. apply Hstep; intros. apply Fix_F_equiv_inv. Qed. End setoid_fix.coq-ext-lib-0.12.0/theories/Recur/Measure.v000066400000000000000000000022011451523051500204040ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Require Coq.Arith.Wf_nat. Set Implicit Arguments. Set Strict Implicit. Section parametric. Context {T U : Type}. Variable f : T -> U. Variable R : U -> U -> Prop. Hypothesis well_founded_R : well_founded R. Definition compose (a b : T) : Prop := R (f a) (f b). Definition well_founded_compose : well_founded compose := (fun t => (@Fix _ R well_founded_R (fun x => forall y, f y = x -> Acc compose y) (fun x recur y pf => @Acc_intro _ compose y (fun y' (pf' : R (f y') (f y)) => recur _ match pf in _ = t return R (f y') t with | eq_refl => pf' end _ eq_refl)) (f t) t eq_refl)). End parametric. (** A well-founded relation induced by a measure to nat **) Section measure. Context {T : Type}. Variable m : T -> nat. Definition mlt : T -> T -> Prop := compose m lt. Definition well_founded_mlt : well_founded mlt := @well_founded_compose T nat m lt Wf_nat.lt_wf. End measure.coq-ext-lib-0.12.0/theories/Recur/Relation.v000066400000000000000000000016111451523051500205640ustar00rootroot00000000000000Require Import ExtLib.Relations.TransitiveClosure. Set Implicit Arguments. Set Strict Implicit. Section rightTrans. Variables (A : Type) (R : A -> A -> Prop). Variable wf_R : well_founded R. Theorem wf_rightTrans : well_founded (rightTrans R). Proof. red. eapply Fix. eapply wf_R. clear. intros. constructor. intros. revert H. induction H0. { intros. eauto. } { intros. eapply IHrightTrans; clear IHrightTrans. specialize (H1 _ H). inversion H1. intros. eapply H2. eapply RTFin. eassumption. } Defined. Theorem wf_leftTrans : well_founded (leftTrans R). Proof. red. eapply Fix. eapply wf_R. clear. intros. constructor. intros. revert H. induction H0. { intros. eauto. } { intros. eapply IHleftTrans; clear IHleftTrans. intros. eapply H1. auto. eapply LTFin. auto. } Defined. End rightTrans. coq-ext-lib-0.12.0/theories/Relations/000077500000000000000000000000001451523051500175015ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Relations/Compose.v000066400000000000000000000002401451523051500212710ustar00rootroot00000000000000Section compose. Variable T : Type. Variable R1 R2 : T -> T -> Prop. Definition compose (x z : T) : Prop := exists y, R1 x y /\ R2 y z. End compose. coq-ext-lib-0.12.0/theories/Relations/TransitiveClosure.v000066400000000000000000000106071451523051500233610ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Require Import Coq.Setoids.Setoid. Set Implicit Arguments. Set Strict Implicit. Set Asymmetric Patterns. Section parametric. Variable T : Type. Variable R : T -> T -> Prop. (** Reflexivity **) Inductive makeRefl (x : T) : T -> Prop := | RRefl : makeRefl x x | RStep : forall y, R x y -> makeRefl x y. Global Instance Refl_makeRefl : Reflexive makeRefl. Proof. constructor. Qed. Global Instance Refl_makeTrans : Transitive R -> Transitive makeRefl. Proof. intro. intro. intros. inversion H0; clear H0; subst; auto. inversion H1; clear H1; subst; auto using RStep. apply RStep. etransitivity; eauto. Qed. (** Transitivity **) Inductive makeTrans (x y : T) : Prop := | TStep : R x y -> makeTrans x y | TTrans : forall z, makeTrans x z -> makeTrans z y -> makeTrans x y. Global Instance Trans_makeTrans : Transitive makeTrans. Proof. intro. intros; eapply TTrans; eassumption. Qed. Global Instance Trans_makeRefl : Reflexive R -> Reflexive makeTrans. Proof. intro. intro. apply TStep. reflexivity. Qed. Inductive leftTrans (x y : T) : Prop := | LTFin : R x y -> leftTrans x y | LTStep : forall z, R x z -> leftTrans z y -> leftTrans x y. Inductive rightTrans (x y : T) : Prop := | RTFin : R x y -> rightTrans x y | RTStep : forall z, rightTrans x z -> R z y -> rightTrans x y. (** Equivalence of definitions of transitivity **) Fixpoint leftTrans_rightTrans_acc x y (l : leftTrans y x) : forall z, rightTrans z y -> rightTrans z x := match l with | LTFin pf => fun z pfR => RTStep pfR pf | LTStep _ pf pfL => fun z pfR => leftTrans_rightTrans_acc pfL (RTStep pfR pf) end. Fixpoint rightTrans_leftTrans_acc x y (l : rightTrans x y) : forall z, leftTrans y z -> leftTrans x z := match l with | RTFin pf => fun z pfR => LTStep pf pfR | RTStep _ pf pfL => fun z pfR => rightTrans_leftTrans_acc pf (LTStep pfL pfR) end. Theorem leftTrans_rightTrans : forall x y, leftTrans x y <-> rightTrans x y. Proof. split. { destruct 1. apply RTFin; assumption. eapply leftTrans_rightTrans_acc. eassumption. eapply RTFin. eassumption. } { destruct 1. apply LTFin. assumption. eapply rightTrans_leftTrans_acc. eassumption. eapply LTFin. eassumption. } Qed. Fixpoint leftTrans_makeTrans_acc x y (l : leftTrans x y) : makeTrans x y := match l with | LTFin pf => TStep pf | LTStep _ pf pfL => TTrans (TStep pf) (leftTrans_makeTrans_acc pfL) end. Fixpoint leftTrans_trans x y (l : leftTrans x y) : forall z (r : leftTrans y z), leftTrans x z := match l with | LTFin pf => fun _ pfL => LTStep pf pfL | LTStep _ pf pfL => fun _ pfR => LTStep pf (leftTrans_trans pfL pfR) end. Theorem makeTrans_leftTrans : forall s s', makeTrans s s' <-> leftTrans s s'. Proof. split; intros. { induction H. eapply LTFin. eassumption. eapply leftTrans_trans; eassumption. } { apply leftTrans_makeTrans_acc. assumption. } Qed. Theorem makeTrans_rightTrans : forall s s', makeTrans s s' <-> rightTrans s s'. Proof. intros. etransitivity. apply makeTrans_leftTrans. apply leftTrans_rightTrans. Qed. Definition RTStep_left : forall x y z : T, R x y -> rightTrans y z -> rightTrans x z. intros. revert H. revert x. induction H0. { intros. eapply RTStep. eapply RTFin. eassumption. eassumption. } { intros. eapply RTStep. eapply IHrightTrans. eassumption. eassumption. } Defined. End parametric. Section param. Variable T : Type. Variable R : T -> T -> Prop. Theorem makeTrans_idem : forall s s', makeTrans (makeTrans R) s s' <-> makeTrans R s s'. Proof. split. { induction 1; eauto using TTrans. } { eapply TStep. } Qed. Theorem makeTrans_makeRefl_comm : forall s s', makeTrans (makeRefl R) s s' <-> makeRefl (makeTrans R) s s'. Proof. split. { induction 1; repeat match goal with | [ H : makeRefl _ _ _ |- _ ] => inversion H; clear H; subst end; eauto using RRefl, RStep, TStep, TTrans. } { intros. inversion H; clear H; subst; auto. apply TStep. apply RRefl. induction H0; eauto using RStep, TStep, TTrans. } Qed. Theorem makeRefl_idem : forall s s', makeRefl (makeRefl R) s s' <-> makeRefl R s s'. Proof. split; inversion 1; subst; eauto using RStep, RRefl. Qed. End param. coq-ext-lib-0.12.0/theories/Structures/000077500000000000000000000000001451523051500177245ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Structures/Applicative.v000066400000000000000000000016721451523051500223620ustar00rootroot00000000000000From ExtLib Require Import Functor. Set Implicit Arguments. Set Maximal Implicit Insertion. Set Universe Polymorphism. Class Applicative@{d c} (T : Type@{d} -> Type@{c}) := { pure : forall {A : Type@{d}}, A -> T A ; ap : forall {A B : Type@{d}}, T (A -> B) -> T A -> T B }. Module ApplicativeNotation. Notation "f <*> x" := (ap f x) (at level 52, left associativity). End ApplicativeNotation. Import ApplicativeNotation. Section applicative. Definition liftA@{d c} {T : Type@{d} -> Type@{c}} {AT:Applicative@{d c} T} {A B : Type@{d}} (f:A -> B) (aT:T A) : T B := pure f <*> aT. Definition liftA2@{d c} {T : Type@{d} -> Type@{c}} {AT:Applicative@{d c} T} {A B C : Type@{d}} (f:A -> B -> C) (aT:T A) (bT:T B) : T C := liftA f aT <*> bT. End applicative. Section Instances. Universe d c. Context (T : Type@{d} -> Type@{c}) {AT : Applicative T}. Global Instance Functor_Applicative@{} : Functor T := { fmap := @liftA _ _ }. End Instances. coq-ext-lib-0.12.0/theories/Structures/BinOps.v000066400000000000000000000012531451523051500213060ustar00rootroot00000000000000Section unit_op. Context {T : Type}. Variable op : T -> T -> T. Variable u : T. Variable equ : T -> T -> Prop. Class LeftUnit : Type := lunit : forall a, equ (op u a) a. Class RightUnit : Type := runit : forall a, equ (op a u) a. End unit_op. Section comm_op. Context {T U : Type}. Variable op : T -> T -> U. Variable equ : U -> U -> Prop. Class Commutative : Type := commut : forall a b, equ (op a b) (op b a). End comm_op. Section assoc_op. Context {T : Type}. Variable op : T -> T -> T. Variable equ : T -> T -> Prop. Class Associative : Type := assoc : forall a b c, equ (op (op a b) c) (op a (op b c)). End assoc_op. coq-ext-lib-0.12.0/theories/Structures/CoFunctor.v000066400000000000000000000013641451523051500220210ustar00rootroot00000000000000Require Import ExtLib.Core.Any. Set Implicit Arguments. Set Strict Implicit. Set Universe Polymorphism. Section functor. Class CoFunctor@{d c} (F : Type@{d} -> Type@{c}) : Type := { cofmap : forall {A B : Type@{d}}, (B -> A) -> F A -> F B }. Class CoPFunctor@{d c p} (F : Type@{d} -> Type@{c}) : Type := { CoFunP : Type@{d} -> Type@{p} ; copfmap : forall {A B : Type@{d}} {P : CoFunP B}, (B -> A) -> F A -> F B }. Existing Class CoFunP. Hint Extern 0 (@CoFunP _ _ _) => progress (simpl CoFunP) : typeclass_instances. Global Instance CoPFunctor_From_CoFunctor@{d c p} (F : Type@{d} -> Type@{c}) (F_ : CoFunctor@{d c} F) : CoPFunctor@{d c p} F := {| CoFunP := Any@{p} ; copfmap := fun _ _ _ f x => cofmap f x |}. End functor. coq-ext-lib-0.12.0/theories/Structures/CoMonad.v000066400000000000000000000007241451523051500214360ustar00rootroot00000000000000Set Implicit Arguments. Set Strict Implicit. Class CoMonad (m : Type -> Type) : Type := { extract : forall {A}, m A -> A ; extend : forall {A B}, (m A -> B) -> m A -> m B }. (* Aliases for [extract] and [extend] for backward compatiblity *) Section BackwardCompatibility. Context {m: Type->Type}. Context {CoMonad: CoMonad m}. Definition coret {A: Type} := extract (A:=A). Definition cobind {A B: Type} := extend (A:=A) (B:=B). End BackwardCompatibility. coq-ext-lib-0.12.0/theories/Structures/CoMonadLaws.v000066400000000000000000000011221451523051500222560ustar00rootroot00000000000000Require Import Coq.Program.Basics. Require Import ExtLib.Structures.CoMonad. Set Implicit Arguments. Set Strict Implicit. Local Open Scope program_scope. Section CoMonadLaws. Variable m : Type -> Type. Variable C : CoMonad m. Class CoMonadLaws : Type := { extend_extract: forall (A B:Type), extend (B:=A) extract = id ; extract_extend: forall (A B:Type) {f}, extract ∘ extend (A:=A) (B:=B) f = f; extend_extend:forall (A B:Type) {f g}, extend (A:=B) (B:=A) f ∘ extend (A:=A) g = extend (f ∘ extend g) }. End CoMonadLaws. coq-ext-lib-0.12.0/theories/Structures/EqDep.v000066400000000000000000000023331451523051500211120ustar00rootroot00000000000000Require Coq.Logic.Eqdep_dec. Require EquivDec. Require Import ExtLib.Core.RelDec. Require Import ExtLib.Tactics.Consider. Set Implicit Arguments. Set Strict Implicit. Section Classes. Context {A : Type}. Context {dec : EquivDec.EqDec A (@eq A)}. Theorem UIP_refl : forall {x : A} (p1 : x = x), p1 = refl_equal _. intros. eapply Coq.Logic.Eqdep_dec.UIP_dec. apply EquivDec.equiv_dec. Qed. Theorem UIP_equal : forall {x y : A} (p1 p2 : x = y), p1 = p2. eapply Coq.Logic.Eqdep_dec.UIP_dec. apply EquivDec.equiv_dec. Qed. Lemma inj_pair2 : forall (P:A -> Type) (p:A) (x y:P p), existT P p x = existT P p y -> x = y. Proof. intros. eapply Coq.Logic.Eqdep_dec.inj_pair2_eq_dec; auto. Qed. Theorem equiv_dec_refl_left : forall a, @EquivDec.equiv_dec _ _ _ dec a a = left eq_refl. Proof. intros. destruct (EquivDec.equiv_dec a a); try congruence. f_equal. apply UIP_equal. Qed. End Classes. Section from_rel_dec. Variable T : Type. Variable RD : RelDec (@eq T). Variable RDC : RelDec_Correct RD. Global Instance EqDec_RelDec : EquivDec.EqDec T (@eq T). Proof. red; intros. consider (x ?[ eq ] y); intros; subst; auto. left. reflexivity. Qed. End from_rel_dec. coq-ext-lib-0.12.0/theories/Structures/Foldable.v000066400000000000000000000021471451523051500216270ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import ExtLib.Structures.Monoid. Set Implicit Arguments. Set Strict Implicit. Section foldable. Variable T A : Type. Class Foldable : Type := { fold_mon : forall m {M : Monoid m}, (A -> m) -> T -> m }. Variable Foldable_T : Foldable. Definition fold (R : Type) (f : A -> R -> R) (init : R) (s : T) : R := @fold_mon Foldable_T (R -> R) {| monoid_plus := fun f g x => f (g x) ; monoid_unit := fun x => x |} f s init. Definition toList : T -> list A := fold_mon (M := {| monoid_plus := @List.app A ; monoid_unit := nil |}) (fun x => x :: nil). Variable Add : A -> T -> T -> Prop. Class FoldableOk : Type := { fold_ind : forall m (M : Monoid m) (ML : MonoidLaws M) (P : m -> Prop) f u, P (monoid_unit M) -> (forall x y z, Add x y z -> P (@fold_mon Foldable_T m M f y) -> P (monoid_plus M (f x) (@fold_mon Foldable_T m M f z))) -> P (@fold_mon Foldable_T m M f u) }. End foldable. coq-ext-lib-0.12.0/theories/Structures/Functor.v000066400000000000000000000006531451523051500215370ustar00rootroot00000000000000Require Import ExtLib.Core.Any. Set Implicit Arguments. Set Strict Implicit. Polymorphic Class Functor@{d c} (F : Type@{d} -> Type@{c}) : Type := { fmap : forall {A B : Type@{d}}, (A -> B) -> F A -> F B }. Polymorphic Definition ID@{d} {T : Type@{d}} (f : T -> T) : Prop := forall x : T, f x = x. Module FunctorNotation. Notation "f <$> x" := (@fmap _ _ _ _ f x) (at level 52, left associativity). End FunctorNotation. coq-ext-lib-0.12.0/theories/Structures/FunctorLaws.v000066400000000000000000000006671451523051500223730ustar00rootroot00000000000000Require Import Coq.Relations.Relations. Require Import ExtLib.Data.Fun. Require Import ExtLib.Structures.Functor. Set Implicit Arguments. Set Strict Implicit. Set Universe Polymorphism. Section laws. Class FunctorLaws {F} (Functor_F : Functor F) := { fmap_id : forall {T} (x : F T), fmap id x = x ; fmap_compose : forall {T U V} (f : T -> U) (g : U -> V) (x : F T), fmap (compose g f) x = fmap g (fmap f x) }. End laws. coq-ext-lib-0.12.0/theories/Structures/Maps.v000066400000000000000000000051121451523051500210120ustar00rootroot00000000000000Require Import RelationClasses. Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.Reducible. Set Implicit Arguments. Set Strict Implicit. (** First-class maps **) Section Maps. Variables K V : Type. Variable map : Type. (** General Maps **) Class Map : Type := { empty : map ; add : K -> V -> map -> map ; remove : K -> map -> map ; lookup : K -> map -> option V ; union : map -> map -> map }. Variable R : K -> K -> Prop. Class MapOk (M : Map) : Type := { mapsto : K -> V -> map -> Prop ; mapsto_empty : forall k v, ~mapsto k v empty ; mapsto_lookup : forall k v m, lookup k m = Some v <-> mapsto k v m ; mapsto_add_eq : forall m k v, mapsto k v (add k v m) ; mapsto_add_neq : forall m k v k', ~R k k' -> forall v', (mapsto k' v' m <-> mapsto k' v' (add k v m)) ; mapsto_remove_eq: forall m k v, ~ mapsto k v (remove k m) ; mapsto_remove_neq : forall m k k', ~ R k k' -> forall v', (mapsto k' v' m <-> mapsto k' v' (remove k m)) }. Variable M : Map. Definition contains (k : K) (m : map) : bool := match lookup k m with | None => false | Some _ => true end. Definition singleton (k : K) (v : V) : map := add k v empty. (* Finite Maps *) Context {F : Foldable map (K * V)}. Definition combine (f : K -> V -> V -> V) (m1 m2 : map) : map := fold (fun k_v acc => let '(k,v) := k_v in match lookup k acc with | None => add k v acc | Some v' => add k (f k v v') acc end) m2 m1. Definition filter (f : K -> V -> bool) (m : map) : map := fold (fun k_v acc => let '(k,v) := k_v in if f k v then add k v acc else acc) empty m. Definition submap_with (le : V -> V -> bool) (m1 m2 : map) : bool := fold (fun k_v (acc : bool) => if acc then let '(k,v) := k_v in match lookup k m2 with | None => false | Some v' => le v v' end else false) true m1. (* Definition keys (s : Type) (_ : DMonad s K) : map T -> s := fold (fun k_v (acc : s) => djoin (dreturn (fst k_v)) acc) dzero. Definition values (s : Type) (_ : DMonad s T) : map T -> s := fold (fun k_v (acc : s) => djoin (dreturn (snd k_v)) acc) dzero. *) End Maps. Arguments empty {_} {_} {_} {_} . Arguments add {K V} {map} {Map} _ _ _. Arguments remove {K V} {map} {Map} _ _. Arguments lookup {K V} {map} {Map} _ _. Arguments contains {K V} {map} {M} _ _. Arguments singleton {K V} {map} {M} _ _. Arguments combine {K V} {map} {M} _ _ _ _. coq-ext-lib-0.12.0/theories/Structures/Monad.v000066400000000000000000000060121451523051500211500ustar00rootroot00000000000000Require Import ExtLib.Structures.Functor. Require Import ExtLib.Structures.Applicative. Set Implicit Arguments. Set Strict Implicit. Set Universe Polymorphism. Class Monad@{d c} (m : Type@{d} -> Type@{c}) : Type := { ret : forall {t : Type@{d}}, t -> m t ; bind : forall {t u : Type@{d}}, m t -> (t -> m u) -> m u }. Section monadic. Definition liftM@{d c} {m : Type@{d} -> Type@{c}} {M : Monad m} {T U : Type@{d}} (f : T -> U) : m T -> m U := fun x => bind x (fun x => ret (f x)). Definition liftM2@{d c} {m : Type@{d} -> Type@{c}} {M : Monad m} {T U V : Type@{d}} (f : T -> U -> V) : m T -> m U -> m V := Eval cbv beta iota zeta delta [ liftM ] in fun x y => bind x (fun x => liftM (f x) y). Definition liftM3@{d c} {m : Type@{d} -> Type@{c}} {M : Monad m} {T U V W : Type@{d}} (f : T -> U -> V -> W) : m T -> m U -> m V -> m W := Eval cbv beta iota zeta delta [ liftM2 ] in fun x y z => bind x (fun x => liftM2 (f x) y z). Definition apM@{d c} {m : Type@{d} -> Type@{c}} {M : Monad m} {A B : Type@{d}} (fM:m (A -> B)) (aM:m A) : m B := bind fM (fun f => liftM f aM). (* Left-to-right composition of Kleisli arrows. *) Definition mcompose@{c d} {m:Type@{d}->Type@{c}} {M: Monad m} {T U V:Type@{d}} (f: T -> m U) (g: U -> m V): (T -> m V) := fun x => bind (f x) g. Definition join@{d c} {m : Type@{d} -> Type@{c}} {a} `{Monad m} : m (m a) -> m a := fun x => bind x (fun y => y). End monadic. Module MonadBaseNotation. Delimit Scope monad_scope with monad. Notation "c >>= f" := (@bind _ _ _ _ c f) (at level 58, left associativity) : monad_scope. Notation "f =<< c" := (@bind _ _ _ _ c f) (at level 61, right associativity) : monad_scope. Notation "f >=> g" := (@mcompose _ _ _ _ _ f g) (at level 61, right associativity) : monad_scope. Notation "e1 ;; e2" := (@bind _ _ _ _ e1%monad (fun _ => e2%monad))%monad (at level 61, right associativity) : monad_scope. End MonadBaseNotation. Module MonadNotation. Export MonadBaseNotation. Notation "x <- c1 ;; c2" := (@bind _ _ _ _ c1 (fun x => c2)) (at level 61, c1 at next level, right associativity) : monad_scope. Notation "' pat <- c1 ;; c2" := (@bind _ _ _ _ c1 (fun x => match x with pat => c2 end)) (at level 61, pat pattern, c1 at next level, right associativity) : monad_scope. End MonadNotation. Module MonadLetNotation. Export MonadBaseNotation. Notation "'let*' p ':=' c1 'in' c2" := (@bind _ _ _ _ c1 (fun p => c2)) (at level 61, p as pattern, c1 at next level, right associativity) : monad_scope. End MonadLetNotation. Section Instances. Universe d c. Context (m : Type@{d} -> Type@{c}) {M : Monad m}. Global Instance Functor_Monad@{} : Functor m := { fmap := @liftM _ _ }. Global Instance Applicative_Monad@{} : Applicative m := { pure := @ret _ _ ; ap := @apM _ _ }. End Instances. coq-ext-lib-0.12.0/theories/Structures/MonadCont.v000066400000000000000000000003161451523051500217750ustar00rootroot00000000000000(** The Cont Monad Class **) Require Import ExtLib.Structures.Monad. Class Cont (m : Type -> Type) : Type := { callCC : forall a b, ((a -> m b) -> m a) -> m a }. Arguments callCC {m Cm} {_ _} _ : rename.coq-ext-lib-0.12.0/theories/Structures/MonadExc.v000066400000000000000000000004051451523051500216100ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Class MonadExc (E : Type) (m : Type -> Type) : Type := { raise : forall {T}, E -> m T ; catch : forall {T}, m T -> (E -> m T) -> m T }. Arguments raise {E m mE} {_} _ : rename. Arguments catch {E m mE} {_} _ _ : rename.coq-ext-lib-0.12.0/theories/Structures/MonadFix.v000066400000000000000000000034361451523051500216260ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Set Implicit Arguments. Class MonadFix (m : Type -> Type) : Type := { mfix : forall {T U}, ((T -> m U) -> T -> m U) -> T -> m U }. Section MonadFix. Fixpoint ftype (ls : list Type) (r : Type) : Type := match ls with | nil => r | cons l ls => l -> ftype ls r end. Fixpoint tuple (ls : list Type) : Type := match ls with | nil => unit | cons l ls => l * tuple ls end%type. Fixpoint wrap (ls : list Type) R {struct ls} : (tuple ls -> R) -> ftype ls R := match ls as ls return (tuple ls -> R) -> ftype ls R with | nil => fun f => f tt | cons l ls => fun f => fun x => wrap ls (fun g => f (x,g)) end. Fixpoint apply (ls : list Type) R {struct ls} : ftype ls R -> tuple ls -> R := match ls as ls return ftype ls R -> tuple ls -> R with | nil => fun f _ => f | cons l ls => fun f t => @apply ls R (f (fst t)) (snd t) end. Context {m : Type -> Type} {MF : MonadFix m}. Definition mfix_multi (ls : list Type) (R : Type) (f : ftype ls (m R) -> ftype ls (m R)) : ftype ls (m R) := @wrap ls (m R) (@mfix _ MF (tuple ls) R (fun packed => apply ls (m R) (f (wrap ls packed)))). Context {mMonad:Monad m}. Definition mfix2 A B C (ff:(A -> B -> m C) -> (A -> B -> m C)) (a:A) (b:B) : m C := let ff' fabp (abp:A*B) := let (a,b) := abp in let fab a b := fabp (a,b) in ff fab a b in mfix ff' (a,b). Definition mfix3 A B C D (ff:(A -> B -> C -> m D) -> (A -> B -> C -> m D)) (a:A) (b:B) (c:C) : m D := let ff' fabcp (abcp:A*B*C) := let (abp,c) := abcp in let (a,b) := abp in let fabc a b c := fabcp (a,b,c) in ff fabc a b c in mfix ff' (a,b,c). End MonadFix. Arguments mfix {m MonadFix T U} _ _.coq-ext-lib-0.12.0/theories/Structures/MonadLaws.v000066400000000000000000000051001451523051500217740ustar00rootroot00000000000000Require Import Setoid. Require Import Coq.Classes.Morphisms. Require Import ExtLib.Structures.Monads. Require Import ExtLib.Data.Fun. Require Import ExtLib.Data.Unit. Set Implicit Arguments. Set Strict Implicit. Section MonadLaws. Variable m : Type -> Type. Variable M : Monad m. (** This <= relation is a computational <= relation based on the ideas of domain theory. It generalizes the usual equivalence relation by, enabling the relation to talk about computations that are "more defined" than others. This generalization is done to support the fixpoint law. **) Class MonadLaws := { bind_of_return : forall {A B} (a : A) (f : A -> m B), bind (ret a) f = f a ; return_of_bind : forall {A} (aM: m A), bind aM ret = aM ; bind_associativity : forall {A B C} (aM:m A) (f:A -> m B) (g:B -> m C), bind (bind aM f) g = bind aM (fun a => bind (f a) g) }. Class MonadTLaws {n} (nM : Monad n) (MT : MonadT m n) := { lift_ret : forall {T} (x : T), lift (ret x) = ret x ; lift_bind : forall {T U} (c : n T) (f : T -> n U), lift (bind c f) = bind (lift c) (fun x => lift (f x)) }. Section with_state. Context {S : Type}. Class MonadStateLaws (MS : MonadState S m) : Type := { get_put : bind get put = ret tt ; put_get : forall x : S, bind (put x) (fun _ => get) = bind (put x) (fun _ => ret x) ; put_put : forall {A} (x y : S) (f : unit -> m A), bind (put x) (fun _ => bind (put y) f) = bind (put y) f ; get_get : forall {A} (f : S -> S -> m A), bind get (fun s => bind get (f s)) = bind get (fun s => f s s) ; get_ignore : forall {A} (aM : m A), bind get (fun _ => aM) = aM }. Class MonadReaderLaws (MR : MonadReader S m) : Type := { ask_local : forall f : S -> S, local f ask = bind ask (fun x => ret (f x)) ; local_bind : forall {A B} (aM : m A) (f : S -> S) (g : A -> m B), local f (bind aM g) = bind (local f aM) (fun x => local f (g x)) ; local_ret : forall {A} (x : A) (f : S -> S), local f (ret x) = ret x ; local_local : forall {T} (s s' : S -> S) (c : m T), local s (local s' c) = local (fun x => s' (s x)) c }. End with_state. Class MonadZeroLaws (MZ : MonadZero m) : Type := { bind_zero : forall {A B} (f : A -> m B), bind mzero f = mzero }. Class MonadFixLaws (MF : MonadFix m) : Type := { mleq : forall {T}, relation T -> relation (m T) ; mfix_monotonic : forall {T U} (F : (T -> m U) -> T -> m U), respectful eq (mleq eq) (mfix F) (F (mfix F)) }. End MonadLaws. coq-ext-lib-0.12.0/theories/Structures/MonadPlus.v000066400000000000000000000007621451523051500220220ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Set Implicit Arguments. Class MonadPlus (m : Type -> Type) : Type := { mplus : forall {A B:Type}, m A -> m B -> m (A + B)%type }. Definition mjoin {m : Type -> Type} {M : Monad m} {MP : MonadPlus m} {T} (a b : m T) : m T := bind (mplus a b) (fun x => match x with | inl x | inr x => ret x end). Module MonadPlusNotation. Notation "x <+> y" := (@mplus _ _ _ _ x y) (at level 54, left associativity) : monad_scope. End MonadPlusNotation. coq-ext-lib-0.12.0/theories/Structures/MonadReader.v000066400000000000000000000016671451523051500223060ustar00rootroot00000000000000(** The Reader Monad Class **) Require Import ExtLib.Structures.Monad. Set Universe Polymorphism. Set Printing Universes. Class MonadReader@{d c} (T : Type@{d}) (m : Type@{d} -> Type@{c}) : Type := { local : forall {t : Type@{d}}, (T -> T) -> m t -> m t ; ask : m T }. Arguments local {T} {m} {_} {t} _ _ : rename. Arguments ask {T} {m} {_} : rename. Definition asks@{d c} {m : Type@{d} -> Type@{c}} {M : Monad m} {T : Type@{d}} {MR : MonadReader@{d c} T m} {U : Type@{d}} (f : T -> U) : m U := bind ask (fun x => ret (f x)). Definition ReaderProd@{d c} {m : Type@{d} -> Type@{c}} {M : Monad m} {T S : Type@{d}} {MR : MonadReader T m} (f : T -> S) (g : S -> T -> T) : MonadReader@{d c} S m := {| ask := @asks m M T MR S f ; local := fun _T up (c : m _T) => @local T m MR _ (fun s => g (up (f s)) s) c |}. coq-ext-lib-0.12.0/theories/Structures/MonadState.v000066400000000000000000000020031451523051500221450ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Set Universe Polymorphism. Set Printing Universes. Class MonadState@{s d c} (T : Type@{s}) (m : Type@{d} -> Type@{c}) : Type := { get : m T ; put : T -> m unit }. Arguments get {_ m MS} : rename. Arguments put {_ m MS} _ : rename. Section monadic. Polymorphic Universes s d c. Context {m : Type@{d} -> Type@{c}}. Context {M : Monad@{d c} m}. Context {T : Type@{s}}. Context {MS : MonadState@{s d c} T m}. Definition modify (f : T -> T) : m T := bind get (fun x => bind (put (f x)) (fun _ => ret x)). Definition gets {U} (f : T -> U) : m U := bind get (fun x => ret (f x)). End monadic. Section SubState. Polymorphic Universes s d c. Context {m : Type@{d} -> Type@{c}}. Context {M : Monad@{d c} m}. Context {T S : Type@{s}}. Context {MS : MonadState@{s d c} T m}. Definition StateProd (f : T -> S) (g : S -> T -> T) : MonadState S m := {| get := @gets m M T MS S f ; put := fun x => bind get (fun s => put (g x s)) |}. End SubState. coq-ext-lib-0.12.0/theories/Structures/MonadTrans.v000066400000000000000000000002441451523051500221610ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Set Implicit Arguments. Class MonadT (m : Type -> Type) (mt : Type -> Type) : Type := { lift : forall {t}, mt t -> m t }. coq-ext-lib-0.12.0/theories/Structures/MonadWriter.v000066400000000000000000000022151451523051500223460ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Require Import ExtLib.Structures.Monoid. Set Universe Polymorphism. Set Printing Universes. Class MonadWriter@{d c s} (T : Type@{s}) (M : Monoid T) (m : Type@{d} -> Type@{c}) : Type := { tell : T -> m unit ; listen : forall {A : Type@{d}}, m A -> m (A * T)%type ; pass : forall {A : Type@{d}}, m (A * (T -> T))%type -> m A }. Arguments tell {T MT m _} _ : rename. Arguments listen {T MT m _ _} _ : rename. Arguments pass {T MT m _} {_} _ : rename. Arguments MonadWriter {T} MT _ : rename. Definition listens@{d c s} {m : Type@{d} -> Type@{c}} {S : Type@{s}} {Monad_m : Monad m} {Monoid_S : Monoid S} {Writer_m : MonadWriter Monoid_S m} {A B : Type@{d}} (f : S -> B) (c : m A) : m (A * B)%type := liftM (fun x => (fst x, f (snd x))) (listen c). Definition censor@{d c s} {m : Type@{d} -> Type@{c}} {S : Type@{s}} {Monad_m : Monad m} {Monoid_S : Monoid S} {Writer_m : MonadWriter Monoid_S m} {A : Type@{d}} (f : S -> S) (c : m A) : m A := pass (liftM (fun x => (x, f)) c). coq-ext-lib-0.12.0/theories/Structures/MonadZero.v000066400000000000000000000005331451523051500220120ustar00rootroot00000000000000Require Import ExtLib.Structures.Monad. Set Implicit Arguments. Class MonadZero (m : Type -> Type) : Type := { mzero : forall {T}, m T }. Section ZeroFuncs. Context {m : Type -> Type}. Context {Monad_m : Monad m}. Context {Zero_m : MonadZero m}. Definition assert (b : bool) : m unit := if b then ret tt else mzero. End ZeroFuncs.coq-ext-lib-0.12.0/theories/Structures/Monads.v000066400000000000000000000006671451523051500213450ustar00rootroot00000000000000Require Export ExtLib.Structures.Monad. Require Export ExtLib.Structures.MonadZero. Require Export ExtLib.Structures.MonadPlus. Require Export ExtLib.Structures.MonadReader. Require Export ExtLib.Structures.MonadWriter. Require Export ExtLib.Structures.MonadState. Require Export ExtLib.Structures.MonadTrans. Require Export ExtLib.Structures.MonadFix. Require Export ExtLib.Structures.MonadExc. Require Export ExtLib.Structures.MonadCont.coq-ext-lib-0.12.0/theories/Structures/Monoid.v000066400000000000000000000007761451523051500213520ustar00rootroot00000000000000Require Import ExtLib.Structures.BinOps. Set Implicit Arguments. Set Maximal Implicit Insertion. Set Universe Polymorphism. Section Monoid. Universe u. Variable S : Type@{u}. Record Monoid@{} : Type := { monoid_plus : S -> S -> S ; monoid_unit : S }. Class MonoidLaws@{} (M : Monoid) : Type := { monoid_assoc :> Associative M.(monoid_plus) eq ; monoid_lunit :> LeftUnit M.(monoid_plus) M.(monoid_unit) eq ; monoid_runit :> RightUnit M.(monoid_plus) M.(monoid_unit) eq }. End Monoid. coq-ext-lib-0.12.0/theories/Structures/Ops.v000066400000000000000000000004061451523051500206540ustar00rootroot00000000000000Section unit_op. Context {T : Type}. Variable op : T -> T -> T. Variable u : T. Variable equ : T -> T -> Prop. Class Ident : Type := lunit : forall a, equ (op u a) a. Class RightUnit : Type := runit : forall a, equ (op a u) a. End unit_op.coq-ext-lib-0.12.0/theories/Structures/Reducible.v000066400000000000000000000037331451523051500220170ustar00rootroot00000000000000Require Import Coq.Classes.RelationClasses. Require Import ExtLib.Structures.BinOps. Require Import ExtLib.Structures.Monad. Set Implicit Arguments. Set Strict Implicit. Class Reducible (T E : Type) : Type := reduce : forall {A} (base : A) (single : E -> A) (join : A -> A -> A), T -> A. Class Foldable (T E : Type) : Type := fold : forall {A} (add : E -> A -> A) (base : A), T -> A. Section RedFold. Variables T E : Type. Global Instance Reducible_from_Foldable (R : Foldable T E) : Reducible T E | 100 := fun A base single join => @fold _ _ R A (fun x => join (single x)) base. End RedFold. Section foldM. Context {T E : Type}. Context {Foldable_te : Foldable T E}. Context {m : Type -> Type}. Context {Monad_m : Monad m}. Definition foldM {A} (add : E -> A -> m A) (base : m A) (t : T) : m A := fold (fun x acc => bind acc (add x)) base t. End foldM. Section reduceM. Context {T E : Type}. Context {Reducible_te : Reducible T E}. Context {m : Type -> Type}. Context {Monad_m : Monad m}. Definition reduceM {A} (base : m A) (single : E -> m A) (join : A -> A -> m A) (t : T) : m A := reduce base single (fun x y => bind x (fun x => bind y (fun y => join x y))) t. End reduceM. Section iterM. Context {T E : Type}. Context {U V : Type}. Context {m : Type -> Type}. Context {Monad_m : Monad m}. Context {Red_te : Reducible T E}. Variable f : E -> m unit. Definition iterM : T -> m unit := reduce (ret tt) f (fun x y => bind x (fun _ => y)). End iterM. (* Section Laws. Context (T E : Type). Context (R : Reducible T E). Class ReducibleLaw : Prop := reduce_spec : forall A (unit : A) (single : E -> A) (join : A -> A -> A) (eqA : A -> A -> Prop), LeftUnit join unit eqA -> RightUnit join unit eqA -> Commutative join eqA -> Associative join eqA -> forall t, eqA (reduce unit single join t) (fold_right (fun acc x => join acc (single x)) ?? unit) *)coq-ext-lib-0.12.0/theories/Structures/Sets.v000066400000000000000000000053661451523051500210430ustar00rootroot00000000000000Require Import ExtLib.Structures.Monoid. Set Implicit Arguments. Set Strict Implicit. Section Sets. Variable S : Type. Variable T : Type. Class DSet : Type := { contains : T -> S -> bool ; empty : S ; singleton : T -> S ; union : S -> S -> S ; filter : (T -> bool) -> S -> S ; intersect : S -> S -> S ; difference : S -> S -> S ; subset : S -> S -> bool (** point-wise **) ; add : T -> S -> S ; remove : T -> S -> S }. Variable DS : DSet. Variable eqT : T -> T -> Prop. Class DSet_Laws : Type := { DSet_WF : S -> Prop ; empty_WF : DSet_WF empty ; singleton_WF : forall x, DSet_WF (singleton x) ; union_WF : forall s s', DSet_WF s -> DSet_WF s' -> DSet_WF (union s s') ; filter_WF : forall s f, DSet_WF s -> DSet_WF (filter f s) ; intersect_WF : forall s s', DSet_WF s -> DSet_WF s' -> DSet_WF (intersect s s') ; difference_WF : forall s s', DSet_WF s -> DSet_WF s' -> DSet_WF (difference s s') ; add_WF : forall s x, DSet_WF s -> DSet_WF (add x s) ; remove_WF : forall s x, DSet_WF s -> DSet_WF (remove x s) ; empty_not_contains : forall t, contains t empty = false ; singleton_contains : forall t u, contains t (singleton u) = true <-> eqT t u ; union_contains : forall s s', DSet_WF s -> DSet_WF s' -> forall x, orb (contains x s) (contains x s') = contains x (union s s') ; intersect_contains : forall s s', DSet_WF s -> DSet_WF s' -> forall x, andb (contains x s) (contains x s') = contains x (intersect s s') ; difference_contains : forall s s', DSet_WF s -> DSet_WF s' -> forall x, andb (contains x s) (negb (contains x s')) = contains x (difference s s') ; subset_contains : forall s s', DSet_WF s -> DSet_WF s' -> subset s s' = true <-> (forall x, contains x s = true -> contains x s' = true) ; add_contains : forall s x, DSet_WF s -> contains x (add x s) = true ; add_contains_not : forall s x y, DSet_WF s -> ~eqT x y -> contains x (add y s) = contains x s ; remove_contains : forall s x, DSet_WF s -> contains x (remove x s) = false ; remove_contains_not : forall s x y, DSet_WF s -> ~eqT x y -> contains x (remove y s) = contains x s }. End Sets. Arguments contains {S} {T} {_} _ _. Arguments empty {S} {T} {_}. Arguments singleton {S} {T} {_} _. Arguments union {S} {T} {_} _ _. Arguments intersect {S} {T} {_} _ _. Arguments difference {S} {T} {_} _ _. Arguments subset {S} {T} {_} _ _. Arguments add {S} {T} {_} _ _. Arguments remove {S} {T} {_} _ _. Arguments filter {S} {T} {_} _ _. Section monoid. Variable S : Type. Context {T : Type}. Context {set : DSet S T}. Definition Monoid_set_union : Monoid S := {| monoid_plus := union ; monoid_unit := empty |}. End monoid. coq-ext-lib-0.12.0/theories/Structures/Traversable.v000066400000000000000000000013741451523051500223720ustar00rootroot00000000000000Require Import ExtLib.Structures.Applicative. Set Implicit Arguments. Set Maximal Implicit Insertion. Polymorphic Class Traversable@{d r} (T : Type@{d} -> Type@{r}) : Type := { mapT : forall {F : Type@{d} -> Type@{r} } {Ap:Applicative@{d r} F} {A B : Type@{d}}, (A -> F B) -> T A -> F (T B) }. Polymorphic Definition sequence@{d r} {T : Type@{d} -> Type@{d}} {Tr:Traversable T} {F : Type@{d} -> Type@{d}} {Ap:Applicative F} {A : Type@{d}} : T (F A) -> F (T A) := mapT (@id _). Polymorphic Definition forT@{d r} {T : Type@{d} -> Type@{d}} {Tr:Traversable T} {F : Type@{d} -> Type@{d}} {Ap:Applicative F} {A B : Type@{d}} (aT:T A) (f:A -> F B) : F (T B) := mapT f aT. coq-ext-lib-0.12.0/theories/Tactics.v000066400000000000000000000003021451523051500173150ustar00rootroot00000000000000Require Export ExtLib.Tactics.Consider. Require Export ExtLib.Tactics.Cases. Require Export ExtLib.Tactics.Injection. Require Export ExtLib.Tactics.Forward. Require Export ExtLib.Tactics.EqDep. coq-ext-lib-0.12.0/theories/Tactics/000077500000000000000000000000001451523051500171335ustar00rootroot00000000000000coq-ext-lib-0.12.0/theories/Tactics/BoolTac.v000066400000000000000000000036431451523051500206530ustar00rootroot00000000000000Require Import Coq.Bool.Bool. Set Implicit Arguments. Set Strict Implicit. (** For backwards compatibility with hint locality attributes. *) Set Warnings "-unsupported-attributes". #[global] Hint Rewrite negb_orb negb_andb negb_involutive if_negb : bool_rw. Lemma negb_true : forall a, negb a = true -> a = false. Proof. destruct a; auto. Qed. Lemma negb_false : forall a, negb a = false -> a = true. Proof. destruct a; auto. Qed. Ltac do_bool' runner := ( autorewrite with bool_rw in * ); repeat match goal with | [ H : negb _ = true |- _ ] => apply negb_true in H | [ H : negb _ = false |- _ ] => apply negb_false in H | [ H : andb _ _ = true |- _ ] => apply andb_true_iff in H; destruct H | [ H : orb _ _ = false |- _ ] => apply orb_false_iff in H; destruct H | [ H : true = andb _ _ |- _ ] => symmetry in H; apply andb_true_iff in H; destruct H | [ H : false = orb _ _ |- _ ] => symmetry in H; apply orb_false_iff in H; destruct H | [ H : andb _ _ = false |- _ ] => apply andb_false_iff in H; runner H | [ H : orb _ _ = true |- _ ] => apply orb_true_iff in H; runner H | [ H : false = andb _ _ |- _ ] => symmetry in H; apply andb_false_iff in H; runner H | [ H : true = orb _ _ |- _ ] => symmetry in H; apply orb_true_iff in H; runner H end. Ltac do_bool_case := let t H := (destruct H) in do_bool' t. Ltac do_bool := let t _ := idtac in do_bool' t. (** Test **) (* Goal forall a b c d e f : bool, negb (a || b) = true -> negb (a && b) = false -> a && b && c = true -> b && c && d = false -> d || e || f = true -> b || c || d = false -> true = a && b && c -> false = b && c && d -> true = d || e || f -> false = b || c || d -> if a && b then True else False. Proof. intros. do_bool. Abort. *) coq-ext-lib-0.12.0/theories/Tactics/Cases.v000066400000000000000000000053171451523051500203660ustar00rootroot00000000000000Require Import ExtLib.Tactics.Consider. Set Implicit Arguments. Set Strict Implicit. (** This tactic will perform case splits on terms that are matched on. It only does this on terms where only one of the cases is non-trivial (i.e. by [intuition congruence]). ** **) Ltac forward' dst sol := let check X := match X with | match _ with _ => _ end => fail 1 | if _ then _ else _ => fail 1 | _ => idtac end in let go X := first [ (dst X; try solve [ sol ]); [ intros ] | dst X; solve [ sol ] ] in repeat match goal with | [ H : context [ match ?X with _ => _ end ] |- _ ] => go X | [ H : context [ if ?X then _ else _ ] |- _ ] => go X | [ |- context [ match ?X with _ => _ end ] ] => go X | [ |- context [ if ?X then _ else _ ] ] => go X end. Ltac forward := forward' ltac:(fun x => consider x; intros) ltac:(intuition congruence). Ltac forward_unsafe' dst sol := let check X := match X with | match _ with _ => _ end => fail 1 | if _ then _ else _ => fail 1 | _ => idtac end in let go X := dst X; try solve [ sol ] in repeat match goal with | [ H : context [ match ?X with _ => _ end ] |- _ ] => go X | [ H : context [ if ?X then _ else _ ] |- _ ] => go X | [ |- context [ match ?X with _ => _ end ] ] => go X | [ |- context [ if ?X then _ else _ ] ] => go X end. Ltac forward_unsafe := forward_unsafe' ltac:(fun x => consider x; intros) ltac:(intuition congruence). Ltac change_rewrite H := match type of H with | ?X = _ => match goal with | |- context [ ?Y ] => change Y with X ; rewrite H end end. Ltac change_rewrite_in H H' := match type of H with | ?X = _ => match type of H' with | context [ ?Y ] => change Y with X in H' ; rewrite H in H' end end. Tactic Notation "change_rewrite" hyp(H) := (change_rewrite H). Tactic Notation "change_rewrite" hyp(H) "in" hyp(H') := (change_rewrite_in H H'). Ltac rewrite_all_goal := repeat match goal with | [ H : _ |- _ ] => progress (erewrite H by eauto with typeclass_instances) end. Ltac rewrite_all_in H' := repeat match goal with | [ H : _ |- _ ] => progress (erewrite H in H' by eauto with typeclass_instances) end. Ltac rewrite_all_star := repeat match goal with | [ H : _ |- _ ] => progress (erewrite H in * by eauto with typeclass_instances) end. (* Ltac rewrite_all := rewrite_all_goal. *) coq-ext-lib-0.12.0/theories/Tactics/Consider.v000066400000000000000000000106141451523051500210720ustar00rootroot00000000000000(** The [consider] tactic recovers some of the ease of reasoning about decision procedures when they are implemented as functions into bool. ** Implementation by Thomas Braibant (thomas.braibant@gmail.com) **) (*Require Setoid. *) (** This file defines some inductives, type-classes and tactics to perform reflection on a small scale *) (** Two inductives to perform case-based reasonning *) Inductive reflect (P Q : Prop) : bool -> Type := | reflect_true : P -> reflect P Q true | reflect_false : Q -> reflect P Q false. Inductive semi_reflect (P : Prop) : bool -> Type := | semi_reflect_true : P -> semi_reflect P true | semi_reflect_false : semi_reflect P false. Lemma iff_to_reflect {A B} (P : A -> B -> Prop) (T : A -> B -> bool) : (forall x y, T x y = true <-> P x y) -> (forall x y, reflect (P x y) (~P x y) (T x y)). Proof. intros. case_eq (T x y); intros Hxy; constructor. apply H. assumption. intros Hf. apply H in Hf. congruence. Qed. Lemma impl_to_semireflect {A B} (P : A -> B -> Prop) (T : A -> B -> bool) : (forall x y, T x y = true -> P x y) -> (forall x y, semi_reflect (P x y) (T x y)). Proof. intros. case_eq (T x y); intros Hxy; constructor. apply H; auto. Qed. Lemma reflect_true_inv P Q : reflect P Q true -> P. Proof. exact (fun x => match x in reflect _ _ b return if b then P else ID with | reflect_true _ _ H => H | reflect_false _ _ H => (fun _ x => x) end). Qed. Lemma reflect_false_inv P Q : reflect P Q false -> Q. Proof. exact (fun x => match x in reflect _ _ b return if b then ID else Q with | reflect_true _ _ H => fun _ x => x | reflect_false _ _ H => H end). Qed. Lemma semi_reflect_true_inv P : semi_reflect P true -> P. Proof. exact (fun x => match x in semi_reflect _ b return if b then P else ID with | semi_reflect_true _ H => H | semi_reflect_false _ => (fun _ x => x) end). Qed. Class Reflect (T : bool) (P Q : Prop) := _Reflect : reflect P Q T. Class SemiReflect (T : bool) (P : Prop) := _SemiReflect : semi_reflect P T. Section boolean_logic. Ltac t := repeat match goal with | H: Reflect true ?P ?Q |- _ => apply (reflect_true_inv P Q) in H | H: Reflect false ?P ?Q |- _ => apply (reflect_false_inv P Q) in H end. Context {T1 T2 P1 Q1 P2 Q2} {R1 : Reflect T1 P1 Q1} {R2: Reflect T2 P2 Q2}. Global Instance Reflect_andb : Reflect (T1 && T2)%bool (P1 /\ P2) (Q1 \/ Q2). Proof. destruct T1; destruct T2; t; constructor; tauto. Qed. Global Instance Reflect_orb : Reflect (T1 || T2)%bool (P1 \/ P2) (Q1 /\ Q2). Proof. destruct T1; destruct T2; t; constructor; tauto. Qed. Global Instance Reflect_negb : Reflect (negb T1)%bool Q1 P1. Proof. destruct T1; t; constructor; tauto. Qed. End boolean_logic. Require Import ExtLib.Core.RelDec. Section from_rel_dec. Variable T : Type. Variable eqt : T -> T -> Prop. Variable rd : RelDec eqt. Variable rdc : RelDec_Correct rd. Global Instance Reflect_RelDecCorrect (a b : T) : Reflect (rel_dec a b) (eqt a b) (~(eqt a b)). Proof. eapply iff_to_reflect. eapply rel_dec_correct. Qed. End from_rel_dec. #[global] Hint Extern 10 (@Reflect (?f ?a ?b) _ _) => eapply (@Reflect_RelDecCorrect _ _ (@Build_RelDec _ _ f) _) : typeclass_instances. (** The main tactic. [consider f] will perform case-analysis (using [case]) on the function symbol [f] using a reflection-lemma that is inferred by type-class resolution. *) Ltac consider f := let rec clean := match goal with | |- true = true -> _ => intros _ ; clean | |- false = true -> _ => discriminate | |- ?P1 -> ?P2 => let H := fresh in intros H ; clean; revert H | |- _ => idtac end in (repeat match goal with | [ H : context [ f ] |- _ ] => revert H end) ; match type of f with | sumbool _ _ => destruct f | _ => match goal with | _ => ((let c := constr:(_ : Reflect f _ _) in case c)) (*; let H := fresh in intros H; try rewrite H; revert H)) *) | _ => ((let c := constr:(_ : SemiReflect f _) in case c)) (*; let H := fresh in try (intros H; try rewrite H; revert H))) *) | _ => (** default to remembering the equality **) case_eq f end end ; clean. coq-ext-lib-0.12.0/theories/Tactics/EqDep.v000066400000000000000000000050731451523051500203250ustar00rootroot00000000000000Require Import Coq.Classes.EquivDec. Require Import ExtLib.Structures.EqDep. Require Coq.Logic.Eqdep_dec. Set Implicit Arguments. Set Strict Implicit. Section Classes. Context {A : Type}. Context {dec : EqDec A (@eq A)}. Theorem UIP_refl : forall {x : A} (p1 : x = x), p1 = refl_equal _. intros. eapply Eqdep_dec.UIP_dec. apply equiv_dec. Qed. Theorem UIP_equal : forall {x y : A} (p1 p2 : x = y), p1 = p2. eapply Eqdep_dec.UIP_dec. apply equiv_dec. Qed. Lemma inj_pair2 : forall (P:A -> Type) (p:A) (x y:P p), existT P p x = existT P p y -> x = y. Proof. intros. eapply Eqdep_dec.inj_pair2_eq_dec; auto. Qed. End Classes. Ltac notVar X := match X with | _ _ => idtac | _ _ _ => idtac | _ _ _ _ => idtac | _ _ _ _ _ => idtac | _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ _ _ _ _ _ => idtac | _ _ _ _ _ _ _ _ _ _ _ _ _ _ => idtac end. Ltac gen_refl := repeat match goal with | H : context [ @eq_refl ?X ?Y ] |- _ => generalize dependent (@eq_refl X Y) | |- context [ @eq_refl ?X ?Y ] => generalize dependent (@eq_refl X Y) end. Ltac uip_all := repeat match goal with | [ H : _ = _ |- _ ] => rewrite H | [ |- context [ match ?X in _ = t return _ with | refl_equal => _ end ] ] => notVar X; generalize X | [ |- context [ eq_rect_r _ _ ?X ] ] => notVar X; generalize X end; intros; repeat match goal with | [ H : ?X = ?X |- _ ] => rewrite (UIP_refl H) in * | [ _ : context [ ?H ] |- _ ] => rewrite (UIP_refl H) in * | [ |- context [ ?H ] ] => rewrite (UIP_refl H) in * end. Ltac uip_all' := repeat match goal with | [ H : _ = _ |- _ ] => rewrite H | [ |- context [ match ?X in _ = t return _ with | refl_equal => _ end ] ] => notVar X; generalize X | [ |- context [ eq_rect_r _ _ ?X ] ] => notVar X; generalize X end; intros; repeat match goal with | [ H : ?X = ?X |- _ ] => generalize dependent H; let pf := fresh in intro pf; rewrite (UIP_refl pf) in * ; try clear pf end. Export EquivDec. coq-ext-lib-0.12.0/theories/Tactics/Equality.v000066400000000000000000000004771451523051500211270ustar00rootroot00000000000000Require Import ExtLib.Data.Eq. Ltac eq_rw_goal := autorewrite with eq_rw. Ltac eq_rw_hyp H := autorewrite with eq_rw in H. Ltac eq_rw_star := autorewrite with eq_rw in *. Tactic Notation "eq_rw" := eq_rw_goal. Tactic Notation "eq_rw" "in" hyp(H) := eq_rw_hyp H. Tactic Notation "eq_rw" "in" "*" := eq_rw_star.coq-ext-lib-0.12.0/theories/Tactics/Forward.v000066400000000000000000000025151451523051500207310ustar00rootroot00000000000000Ltac forward_reason := repeat match goal with | H : exists x, _ |- _ => destruct H | H : _ /\ _ |- _ => destruct H | H' : ?X , H : ?X -> ?Y |- _ => match type of X with | Prop => specialize (H H') end | H : ?X -> ?Y |- _ => match type of X with | Prop => let H' := fresh in assert (H' : X) by eauto ; specialize (H H') ; clear H' end end. Ltac rwHyps := repeat match goal with [ H: _ = _ |- _] => rewrite -> H end. Ltac rwHypsR := repeat match goal with [ H: _ = _ |- _] => rewrite <- H end. Ltac rwHypsA := repeat match goal with [ H: _ = _ |- _] => rewrite -> H in * end. Ltac rwHypsRA := repeat match goal with [ H: _ = _ |- _] => rewrite <- H in * end. (* based on a tactic written by Vincent Rahli *) Ltac clear_trivials := repeat match goal with | [ H : ?T = ?T |- _ ] => clear H | [ H : ?T <-> ?T |- _ ] => clear H | [ H : ?T -> ?T |- _ ] => clear H | [ H1 : ?T, H2 : ?T |- _ ] => clear H2 | [ H : True |- _ ] => clear H | [ H : not False |- _ ] => clear H end. coq-ext-lib-0.12.0/theories/Tactics/Hide.v000066400000000000000000000013001451523051500201650ustar00rootroot00000000000000(* The names of the tactics here come from the 2013 distribution of Software Foundations (SF). The implementations are different, though: 1) The hiding mechanism is SF was not fully reliable: tactics that compute on hypotheses could unhide stuff 2) Hiding in SF was always reversible. Here, unhiding only works when proving a Prop. We can change the return type to [Type]. But then hiding hypothesis can make things unprovable by introducing universe constraints. *) Inductive Hidden (P:Type) : Prop:= | hidden (p:P): Hidden P. Ltac show_hyp H := destruct H as [H]. Ltac hide_hyp H := apply hidden in H. Ltac show_hyps := repeat match goal with H: Hidden _ |- _ => show_hyp H end. coq-ext-lib-0.12.0/theories/Tactics/Injection.v000066400000000000000000000016171451523051500212510ustar00rootroot00000000000000Set Implicit Arguments. Set Strict Implicit. Class Injective (P : Prop) : Type := { result : Prop ; injection : P -> result }. Ltac destruct_ands H := match type of H with | _ /\ _ => let H1 := fresh in let H2 := fresh in destruct H as [ H1 H2 ] ; destruct_ands H1 ; destruct_ands H2 | exists x , _ => let H1 := fresh in destruct H as [ ? H1 ] ; destruct_ands H1 | _ => idtac end. Ltac inv_all := repeat match goal with | [ H : ?X |- _ ] => let z := constr:(_ : Injective X) in eapply (@injection X z) in H; do 2 red in H ; destruct_ands H end. (* Example Global Instance Injective_Some (T : Type) (a b : T) : Injective (Some a = Some b) := { result := a = b }. abstract (inversion 1; auto). Defined. Goal forall x y : nat, Some x = Some y -> x = y. Proof. intros; inv_all; assumption. Qed. *)coq-ext-lib-0.12.0/theories/Tactics/MonadTac.v000066400000000000000000000016461451523051500210170ustar00rootroot00000000000000Require Import ExtLib.Structures.Monads. Require Import ExtLib.Structures.MonadLaws. Set Implicit Arguments. Set Strict Implicit. (* Section monad. Context {m : Type -> Type}. Variable meq : forall T {tT : type T}, type (m T). Variable meqOk : forall T (tT : type T), typeOk tT -> typeOk (meq tT). Context {M : Monad m} (ML : MonadLaws M meq). Theorem bind_rw_0 : forall A B (tA : type A) (tB : type B), typeOk tA -> typeOk tB -> forall (x z : m A) (y : A -> m B), equal x z -> proper y -> equal (bind x y) (bind z y). Proof. intros. eapply bind_proper; eauto. Qed. Theorem bind_rw_1 : forall A B (tA : type A) (tB : type B), typeOk tA -> typeOk tB -> forall (x z : A -> m B) (y : m A), (forall a b, equal a b -> equal (x a) (z b)) -> proper y -> equal (bind y x) (bind y z). Proof. intros. eapply bind_proper; eauto. solve_equal. Qed. End monad. *) coq-ext-lib-0.12.0/theories/Tactics/Parametric.v000066400000000000000000000073231451523051500214160ustar00rootroot00000000000000Require Import Setoid. Require Import RelationClasses. Require Import Morphisms. Set Implicit Arguments. Set Strict Implicit. (** The purpose of this tactic is to try to automatically derive morphisms for functions **) Theorem Proper_red : forall T U (rT : relation T) (rU : relation U) (f : T -> U), (forall x x', rT x x' -> rU (f x) (f x')) -> Proper (rT ==> rU) f. intuition. Qed. Theorem respectful_red : forall T U (rT : relation T) (rU : relation U) (f g : T -> U), (forall x x', rT x x' -> rU (f x) (g x')) -> respectful rT rU f g. intuition. Qed. Theorem respectful_if_bool T : forall (x x' : bool) (t t' f f' : T) eqT, x = x' -> eqT t t' -> eqT f f' -> eqT (if x then t else f) (if x' then t' else f') . intros; subst; auto; destruct x'; auto. Qed. Ltac derive_morph := repeat first [ lazymatch goal with | |- Proper _ _ => red; intros | |- (_ ==> _)%signature _ _ => red; intros end | apply respectful_red; intros | apply respectful_if_bool; intros | match goal with | [ H : (_ ==> ?EQ)%signature ?F ?F' |- ?EQ (?F _) (?F' _) ] => apply H | [ |- ?EQ (?F _) (?F _) ] => let inst := constr:(_ : Proper (_ ==> EQ) F) in apply inst | [ H : (_ ==> _ ==> ?EQ)%signature ?F ?F' |- ?EQ (?F _ _) (?F' _ _) ] => apply H | [ |- ?EQ (?F _ _) (?F' _ _) ] => let inst := constr:(_ : Proper (_ ==> _ ==> EQ) F) in apply inst | [ |- ?EQ (?F _ _ _) (?F _ _ _) ] => let inst := constr:(_ : Proper (_ ==> _ ==> _ ==> EQ) F) in apply inst | [ |- ?EQ (?F _) (?F _) ] => unfold F | [ |- ?EQ (?F _ _) (?F _ _) ] => unfold F | [ |- ?EQ (?F _ _ _) (?F _ _ _) ] => unfold F end ]. Global Instance Proper_andb : Proper (@eq bool ==> @eq bool ==> @eq bool) andb. derive_morph; auto. Qed. Section K. Variable F : bool -> bool -> bool. Hypothesis Fproper : Proper (@eq bool ==> @eq bool ==> @eq bool) F. Existing Instance Fproper. Definition food (x y z : bool) : bool := F x (F y z). Global Instance Proper_food : Proper (@eq bool ==> @eq bool ==> @eq bool ==> @eq bool) food. Proof. derive_morph; auto. Qed. Global Instance Proper_S : Proper (@eq nat ==> @eq nat) S. Proof. derive_morph; auto. Qed. End K. Require Import List. Section Map. Variable T : Type. Variable eqT : relation T. Inductive listEq {T} (eqT : relation T) : relation (list T) := | listEq_nil : listEq eqT nil nil | listEq_cons : forall x x' y y', eqT x x' -> listEq eqT y y' ->listEq eqT (x :: y) (x' :: y'). Theorem listEq_match V U (eqV : relation V) (eqU : relation U) : forall x x' : list V, forall X X' Y Y', eqU X X' -> (eqV ==> listEq eqV ==> eqU)%signature Y Y' -> listEq eqV x x' -> eqU (match x with | nil => X | x :: xs => Y x xs end) (match x' with | nil => X' | x :: xs => Y' x xs end). Proof. intros. induction H1; auto. derive_morph; auto. Qed. Variable U : Type. Variable eqU : relation U. Variable f : T -> U. Variable fproper : Proper (eqT ==> eqU) f. Definition hd (l : list T) : option T := match l with | nil => None | l :: _ => Some l end. (* Global Instance Proper_hd : Proper (listEq eqT ==> optionEq eqT) hd. Proof. foo. (** This has binders in the match... **) Abort. *) Fixpoint map' (l : list T) : list U := match l with | nil => nil | l :: ls => f l :: map' ls end. Global Instance Proper_map' : Proper (listEq eqT ==> listEq eqU) map'. Proof. derive_morph. induction H; econstructor; derive_morph; auto. Qed. End Map. coq-ext-lib-0.12.0/theories/Tactics/Reify.v000066400000000000000000000012361451523051500204020ustar00rootroot00000000000000Set Implicit Arguments. Set Strict Implicit. Section ClassReify. Variable P Q : Type. Variable D : P -> Q. Class ClassReify (v : Q) : Type := { reify : P ; reify_sound : D reify = v }. End ClassReify. Require Import Lists.List. Section ListReify. Variables (T U : Type) (f : T -> U). Global Instance Reflect_nil : ClassReify (map f) nil := { reify := nil ; reify_sound := refl_equal }. Global Instance Reflect_cons a b (Ra : ClassReify f a) (Rb : ClassReify (map f) b) : ClassReify (map f) (a :: b). refine {| reify := cons (@reify _ _ _ _ Ra) (@reify _ _ _ _ Rb) |}. simpl; f_equal; eapply reify_sound. Defined. End ListReify. coq-ext-lib-0.12.0/tools/000077500000000000000000000000001451523051500150575ustar00rootroot00000000000000coq-ext-lib-0.12.0/tools/deps.py000077500000000000000000000015621451523051500163730ustar00rootroot00000000000000#!/usr/bin/python import os, sys def get_name(n): n = n.strip() if n.startswith('./'): n = n[2:] if n.endswith('.vo'): n = n[:-3] return n def get_ident(n): n = get_name(n) return n.replace('/','_') def gather_deps(files): result = {} for f in files: name = f[:-4] # ends in ".v.d" l = open(f).readlines() (_, d) = l[0].split(':') deps = [ get_name(x) for x in d.split(' ') if x.strip().endswith('.vo') ] result[name] = deps return result def print_dot(deps): print 'digraph dependencies {' for k in deps.keys(): print '\t%s [label="%s"] ;' % (get_ident(k), k) for d in deps[k]: print '\t%s -> %s ;' % (get_ident(k), get_ident(d)) print '}' if __name__ == '__main__': deps = gather_deps(sys.argv[1:]) print_dot(deps) coq-ext-lib-0.12.0/tools/dir-locals.el000066400000000000000000000001111451523051500174230ustar00rootroot00000000000000((coq-mode . ((coq-load-path . ( (nonrec "PWD/theories" "ExtLib") ))))) coq-ext-lib-0.12.0/tools/whitespace.sh000077500000000000000000000000721451523051500175510ustar00rootroot00000000000000#!/bin/sh for x in $* do sed -i 's/[ \t]*$//' $x done