pax_global_header00006660000000000000000000000064131554522020014511gustar00rootroot0000000000000052 comment=db160802e15b4661ae86486e7feb68934614b7f0 agda-stdlib-0.14/000077500000000000000000000000001315545220200136105ustar00rootroot00000000000000agda-stdlib-0.14/.boring000066400000000000000000000001221315545220200150640ustar00rootroot00000000000000\.l?agda\.el$ \.agdai$ (^|/)MAlonzo($|/) ^dist($|/) ^html($|/) ^Everything\.agda$ agda-stdlib-0.14/.gitignore000066400000000000000000000002041315545220200155740ustar00rootroot00000000000000# Keep this file in alphabetic order please! *~ .*.swp *.agdai *.agda.el *.lagda.el *.hi *.o *.tix *.vim dist Everything.agda html agda-stdlib-0.14/.mailmap000066400000000000000000000020611315545220200152300ustar00rootroot00000000000000# The information from some Git commands, e.g. git shortlog -nse, is # better by using this file. # Please keep this file in alphabetic order! ############################################################################## Alan Jeffrey ajeffrey Andreas Abel andreas.abel Darin Morrison dwm Dominique Devriese Evgeny Kotelnikov aztek Gergő Érdi gergo Jean-Philippe Bernardy jeanphilippe.bernardy Noam Zeilberger noam.zeilberger Patrik Jansson patrikj Shin-Cheng Mu scm Ulf Norell ulf.norell Ulf Norell ulfn Ulf Norell ulfn agda-stdlib-0.14/.travis.yml000066400000000000000000000050321315545220200157210ustar00rootroot00000000000000language: c branches: only: - master sudo: false dist: trusty cache: directories: - $HOME/.cabsnap matrix: include: - env: TEST=MAIN GHC_VER=8.0.2 BUILD=CABAL CABAL_VER=1.24 addons: apt: packages: - alex-3.1.7 - cabal-install-1.24 - ghc-8.0.2 - happy-1.19.5 sources: - hvr-ghc before_install: - export PATH=/opt/ghc/$GHC_VER/bin:/opt/cabal/$CABAL_VER/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:~/.cabal/bin/:$PATH; install: - git clone https://github.com/agda/agda --depth=1 --single-branch - cabal update - sed -i 's/^jobs:/-- jobs:/' $HOME/.cabal/config # checking whether .ghc is still valid - cabal install --only-dependencies --dry -v > $HOME/installplan.txt - sed -i -e '1,/^Resolving /d' $HOME/installplan.txt; cat $HOME/installplan.txt - touch $HOME/.cabsnap/intallplan.txt - mkdir -p $HOME/.cabsnap/ghc $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin - if diff -u $HOME/.cabsnap/installplan.txt $HOME/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; fi - cabal install cpphs - cd agda && cabal install --only-dependencies && make CABAL_OPTS=-v2 install-bin # snapshot package-db on cache miss - echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin $HOME/installplan.txt $HOME/.cabsnap/; # generating Everything.agda - cd $HOME/build/agda/agda-stdlib - runghc GenerateEverything.hs script: # generating index.agda - ./index.sh # building the docs - agda -i . -i src/ --html src/index.agda # moving everything at the root - mv html/* . after_success: # uploading to gh-pages - git init - git config --global user.name "Travis CI bot" - git config --global user.email "travis-ci-bot@travis.fake" - git remote add upstream https://$GH_TOKEN@github.com/agda/agda-stdlib.git &>/dev/null - git fetch upstream && git reset upstream/gh-pages - git add -f \*.html - git commit -m "Automatic HTML update via Travis" - if [ "$TRAVIS_PULL_REQUEST" = "false" ]; then git push -q upstream HEAD:gh-pages &>/dev/null; fi notifications: email: false agda-stdlib-0.14/AllNonAsciiChars.hs000066400000000000000000000020721315545220200172620ustar00rootroot00000000000000-- | This module extracts all the non-ASCII characters used by the -- library code (along with how many times they are used). module Main where import qualified Data.List as L import Data.Char import Data.Function import Control.Applicative import Numeric ( showHex ) import System.FilePath.Find import System.IO readUTF8File :: FilePath -> IO String readUTF8File f = do h <- openFile f ReadMode hSetEncoding h utf8 hGetContents h main :: IO () main = do agdaFiles <- find always (extension ==? ".agda" ||? extension ==? ".lagda") "src" nonAsciiChars <- filter (not . isAscii) . concat <$> mapM readUTF8File agdaFiles let table = reverse $ L.sortBy (compare `on` snd) $ map (\cs -> (head cs, length cs)) $ L.group $ L.sort $ nonAsciiChars let codePoint :: Char -> String codePoint c = showHex (ord c) "" uPlus :: Char -> String uPlus c = "(U+" ++ codePoint c ++ ")" mapM_ (\(c, count) -> putStrLn (c : " " ++ uPlus c ++ ": " ++ show count)) table agda-stdlib-0.14/CHANGELOG.md000066400000000000000000001236241315545220200154310ustar00rootroot00000000000000Version 0.14 ============ The library has been tested using Agda version 2.5.3. Non-backwards compatible changes -------------------------------- #### 1st stage of overhaul of list membership * The current setup for list membership is difficult to work with as both setoid membership and propositional membership exist as internal modules of `Data.Any`. Furthermore the top-level module `Data.List.Any.Membership` actually contains properties of propositional membership rather than the membership relation itself as its name would suggest. Consequently this leaves no place to reason about the properties of setoid membership. Therefore the two internal modules `Membership` and `Membership-≡` have been moved out of `Data.List.Any` into top-level `Data.List.Any.Membership` and `Data.List.Any.Membership.Propositional` respectively. The previous module `Data.List.Any.Membership` has been renamed `Data.List.Any.Membership.Propositional.Properties`. Accordingly some lemmas have been moved to more logical locations: - `lift-resp` has been moved from `Data.List.Any.Membership` to `Data.List.Any.Properties` - `∈-resp-≈`, `⊆-preorder` and `⊆-Reasoning` have been moved from `Data.List.Any.Membership` to `Data.List.Any.Membership.Properties`. - `∈-resp-list-≈` has been moved from `Data.List.Any.Membership` to `Data.List.Any.Membership.Properties` and renamed `∈-resp-≋`. - `swap` in `Data.List.Any.Properties` has been renamed `swap↔` and made more generic with respect to levels. #### Moving `decTotalOrder` and `decSetoid` from `Data.X` to `Data.X.Properties` * Currently the library does not directly expose proofs of basic properties such as reflexivity, transitivity etc. for `_≤_` in numeric datatypes such as `Nat`, `Integer` etc. In order to use these properties it was necessary to first import the `decTotalOrder` proof from `Data.X` and then separately open it, often having to rename the proofs as well. This adds unneccessary lines of code to the import statements for what are very commonly used properties. These basic proofs have now been added in `Data.X.Properties` along with proofs that they form pre-orders, partial orders and total orders. This should make them considerably easier to work with and simplify files' import preambles. However consequently the records `decTotalOrder` and `decSetoid` have been moved from `Data.X` to `≤-decTotalOrder` and `≡-decSetoid` in `Data.X.Properties`. The numeric datatypes for which this has been done are `Nat`, `Integer`, `Rational` and `Bin`. As a consequence the module `≤-Reasoning` has also had to have been moved from `Data.Nat` to `Data.Nat.Properties`. #### New well-founded induction proofs for `Data.Nat` * Currently `Induction.Nat` only proves that the non-standard `_<′_`relation over `ℕ` is well-founded. Unfortunately these existing proofs are named `<-Rec` and `<-well-founded` which clash with the sensible names for new proofs over the standard `_<_` relation. Therefore `<-Rec` and `<-well-founded` have been renamed to `<′-Rec` and `<′-well-founded` respectively. The original names `<-Rec` and `<-well-founded` now refer to new corresponding proofs for `_<_`. #### Other * Changed the implementation of `map` and `zipWith` in `Data.Vec` to use native (pattern-matching) definitions. Previously they were defined using the `applicative` operations of `Vec`. The new definitions can be converted back to the old using the new proofs `⊛-is-zipWith`, `map-is-⊛` and `zipWith-is-⊛` in `Data.Vec.Properties`. It has been argued that `zipWith` is fundamental than `_⊛_` and this change allows better printing of goals involving `map` or `zipWith`. * Changed the implementation of `All₂` in `Data.Vec.All` to a native datatype. This improved improves pattern matching on terms and allows the new datatype to be more generic with respect to types and levels. * Changed the implementation of `downFrom` in `Data.List` to a native (pattern-matching) definition. Previously it was defined using a private internal module which made pattern matching difficult. * The arguments of `≤pred⇒≤` and `≤⇒pred≤` in `Data.Nat.Properties` are now implicit rather than explicit (was `∀ m n → m ≤ pred n → m ≤ n` and is now `∀ {m n} → m ≤ pred n → m ≤ n`). This makes it consistent with `<⇒≤pred` which already used implicit arguments, and shouldn't introduce any significant problems as both parameters can be inferred by Agda. * Moved `¬∀⟶∃¬` from `Relation.Nullary.Negation` to `Data.Fin.Dec`. Its old location was causing dependency cyles to form between `Data.Fin.Dec`, `Relation.Nullary.Negation` and `Data.Fin`. * Moved `fold`, `add` and `mul` from `Data.Nat` to new module `Data.Nat.GeneralisedArithmetic`. * Changed type of second parameter of `Relation.Binary.StrictPartialOrderReasoning._<⟨_⟩_` from `x < y ⊎ x ≈ y` to `x < y`. `_≈⟨_⟩_` is left unchanged to take a value with type `x ≈ y`. Old code may be fixed by prefixing the contents of `_<⟨_⟩_` with `inj₁`. Deprecated features ------------------- Deprecated features still exist and therefore existing code should still work but they may be removed in some future release of the library. * The module `Data.Nat.Properties.Simple` is now deprecated. All proofs have been moved to `Data.Nat.Properties` where they should be used directly. The `Simple` file still exists for backwards compatability reasons and re-exports the proofs from `Data.Nat.Properties` but will be removed in some future release. * The modules `Data.Integer.Addition.Properties` and `Data.Integer.Multiplication.Properties` are now deprecated. All proofs have been moved to `Data.Integer.Properties` where they should be used directly. The `Addition.Properties` and `Multiplication.Properties` files still exist for backwards compatability reasons and re-exports the proofs from `Data.Integer.Properties` but will be removed in some future release. * The following renaming has occured in `Data.Nat.Properties` ```agda _+-mono_ ↦ +-mono-≤ _*-mono_ ↦ *-mono-≤ +-right-identity ↦ +-identityʳ *-right-zero ↦ *-zeroʳ distribʳ-*-+ ↦ *-distribʳ-+ *-distrib-∸ʳ ↦ *-distribʳ-∸ cancel-+-left ↦ +-cancelˡ-≡ cancel-+-left-≤ ↦ +-cancelˡ-≤ cancel-*-right ↦ *-cancelʳ-≡ cancel-*-right-≤ ↦ *-cancelʳ-≤ strictTotalOrder ↦ <-strictTotalOrder isCommutativeSemiring ↦ *-+-isCommutativeSemiring commutativeSemiring ↦ *-+-commutativeSemiring isDistributiveLattice ↦ ⊓-⊔-isDistributiveLattice distributiveLattice ↦ ⊓-⊔-distributiveLattice ⊔-⊓-0-isSemiringWithoutOne ↦ ⊔-⊓-isSemiringWithoutOne ⊔-⊓-0-isCommutativeSemiringWithoutOne ↦ ⊔-⊓-isCommutativeSemiringWithoutOne ⊔-⊓-0-commutativeSemiringWithoutOne ↦ ⊔-⊓-commutativeSemiringWithoutOne ``` * The following renaming has occurred in `Data.Nat.Divisibility`: ```agda ∣-* ↦ n|m*n ∣-+ ↦ ∣m∣n⇒∣m+n ∣-∸ ↦ ∣m+n|m⇒|n ``` Backwards compatible changes ---------------------------- * Added support for GHC 8.0.2 and 8.2.1. * Removed the empty `Irrelevance` module * Added `Category.Functor.Morphism` and module `Category.Functor.Identity`. * `Data.Container` and `Data.Container.Indexed` now allow for different levels in the container and in the data it contains. * Made `Data.BoundedVec` polymorphic with respect to levels. * Access to `primForce` and `primForceLemma` has been provided via the new top-level module `Strict`. * New call-by-value application combinator `_$!_` in `Function`. * Added properties to `Algebra.FunctionProperties`: ```agda LeftCancellative _•_ = ∀ x {y z} → (x • y) ≈ (x • z) → y ≈ z RightCancellative _•_ = ∀ {x} y z → (y • x) ≈ (z • x) → y ≈ z Cancellative _•_ = LeftCancellative _•_ × RightCancellative _•_ ``` * Added new module `Algebra.FunctionProperties.Consequences` for basic causal relationships between properties, containing: ```agda comm+idˡ⇒idʳ : Commutative _•_ → LeftIdentity e _•_ → RightIdentity e _•_ comm+idʳ⇒idˡ : Commutative _•_ → RightIdentity e _•_ → LeftIdentity e _•_ comm+zeˡ⇒zeʳ : Commutative _•_ → LeftZero e _•_ → RightZero e _•_ comm+zeʳ⇒zeˡ : Commutative _•_ → RightZero e _•_ → LeftZero e _•_ comm+invˡ⇒invʳ : Commutative _•_ → LeftInverse e _⁻¹ _•_ → RightInverse e _⁻¹ _•_ comm+invʳ⇒invˡ : Commutative _•_ → RightInverse e _⁻¹ _•_ → LeftInverse e _⁻¹ _•_ comm+distrˡ⇒distrʳ : Commutative _•_ → _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ comm+distrʳ⇒distrˡ : Commutative _•_ → _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ comm+cancelˡ⇒cancelʳ : Commutative _•_ → LeftCancellative _•_ → RightCancellative _•_ comm+cancelˡ⇒cancelʳ : Commutative _•_ → LeftCancellative _•_ → RightCancellative _•_ sel⇒idem : Selective _•_ → Idempotent _•_ ``` * Added proofs to `Algebra.Properties.BooleanAlgebra`: ```agda ∨-complementˡ : LeftInverse ⊤ ¬_ _∨_ ∧-complementˡ : LeftInverse ⊥ ¬_ _∧_ ∧-identityʳ : RightIdentity ⊤ _∧_ ∧-identityˡ : LeftIdentity ⊤ _∧_ ∧-identity : Identity ⊤ _∧_ ∨-identityʳ : RightIdentity ⊥ _∨_ ∨-identityˡ : LeftIdentity ⊥ _∨_ ∨-identity : Identity ⊥ _∨_ ∧-zeroʳ : RightZero ⊥ _∧_ ∧-zeroˡ : LeftZero ⊥ _∧_ ∧-zero : Zero ⊥ _∧_ ∨-zeroʳ : RightZero ⊤ _∨_ ∨-zeroˡ : LeftZero ⊤ _∨_ ∨-zero : Zero ⊤ _∨_ ⊕-identityˡ : LeftIdentity ⊥ _⊕_ ⊕-identityʳ : RightIdentity ⊥ _⊕_ ⊕-identity : Identity ⊥ _⊕_ ⊕-inverseˡ : LeftInverse ⊥ id _⊕_ ⊕-inverseʳ : RightInverse ⊥ id _⊕_ ⊕-inverse : Inverse ⊥ id _⊕_ ⊕-cong : Congruent₂ _⊕_ ⊕-comm : Commutative _⊕_ ⊕-assoc : Associative _⊕_ ∧-distribˡ-⊕ : _∧_ DistributesOverˡ _⊕_ ∧-distribʳ-⊕ : _∧_ DistributesOverʳ _⊕_ ∧-distrib-⊕ : _∧_ DistributesOver _⊕_ ∨-isSemigroup : IsSemigroup _≈_ _∨_ ∧-isSemigroup : IsSemigroup _≈_ _∧_ ∨-⊥-isMonoid : IsMonoid _≈_ _∨_ ⊥ ∧-⊤-isMonoid : IsMonoid _≈_ _∧_ ⊤ ∨-⊥-isCommutativeMonoid : IsCommutativeMonoid _≈_ _∨_ ⊥ ∧-⊤-isCommutativeMonoid : IsCommutativeMonoid _≈_ _∧_ ⊤ ⊕-isSemigroup : IsSemigroup _≈_ _⊕_ ⊕-⊥-isMonoid : IsMonoid _≈_ _⊕_ ⊥ ⊕-⊥-isGroup : IsGroup _≈_ _⊕_ ⊥ id ⊕-⊥-isAbelianGroup : IsAbelianGroup _≈_ _⊕_ ⊥ id ⊕-∧-isRing : IsRing _≈_ _⊕_ _∧_ id ⊥ ⊤ ``` * Added proofs to `Algebra.Properties.DistributiveLattice`: ```agda ∨-∧-distribˡ : _∨_ DistributesOverˡ _∧_ ∧-∨-distribˡ : _∧_ DistributesOverˡ _∨_ ∧-∨-distribʳ : _∧_ DistributesOverʳ _∨_ ``` * Added pattern synonyms to `Data.Bin` to improve readability: ```agda pattern 0b = zero pattern 1b = 1+ zero pattern ⊥b = 1+ 1+ () ``` * A new module `Data.Bin.Properties` has been added, containing proofs: ```agda 1#-injective : as 1# ≡ bs 1# → as ≡ bs _≟_ : Decidable {A = Bin} _≡_ ≡-isDecEquivalence : IsDecEquivalence _≡_ ≡-decSetoid : DecSetoid _ _ <-trans : Transitive _<_ <-asym : Asymmetric _<_ <-irrefl : Irreflexive _≡_ _<_ <-cmp : Trichotomous _≡_ _<_ <-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ <⇒≢ : a < b → a ≢ b 1<[23] : [] 1# < (b ∷ []) 1# 1<2+ : [] 1# < (b ∷ bs) 1# 0<1+ : 0# < bs 1# ``` * Added functions to `Data.BoundedVec`: ```agda toInefficient : BoundedVec A n → Ineff.BoundedVec A n fromInefficient : Ineff.BoundedVec A n → BoundedVec A n ``` * Added the following to `Data.Digit`: ```agda Expansion : ℕ → Set Expansion base = List (Fin base) ``` * Added new module `Data.Empty.Irrelevant` containing an irrelevant version of `⊥-elim`. * Added functions to `Data.Fin`: ```agda punchIn i j ≈ if j≥i then j+1 else j punchOut i j ≈ if j>i then j-1 else j ``` * Added proofs to `Data.Fin.Properties`: ```agda isDecEquivalence : ∀ {n} → IsDecEquivalence (_≡_ {A = Fin n}) ≤-reflexive : ∀ {n} → _≡_ ⇒ (_≤_ {n}) ≤-refl : ∀ {n} → Reflexive (_≤_ {n}) ≤-trans : ∀ {n} → Transitive (_≤_ {n}) ≤-antisymmetric : ∀ {n} → Antisymmetric _≡_ (_≤_ {n}) ≤-total : ∀ {n} → Total (_≤_ {n}) ≤-isPreorder : ∀ {n} → IsPreorder _≡_ (_≤_ {n}) ≤-isPartialOrder : ∀ {n} → IsPartialOrder _≡_ (_≤_ {n}) ≤-isTotalOrder : ∀ {n} → IsTotalOrder _≡_ (_≤_ {n}) __ : Rel ℤ _ _≰_ : Rel ℤ _ _≱_ : Rel ℤ _ _≮_ : Rel ℤ _ _≯_ : Rel ℤ _ ``` * Added proofs to `Data.Integer.Properties` ```agda +-injective : + m ≡ + n → m ≡ n -[1+-injective : -[1+ m ] ≡ -[1+ n ] → m ≡ n doubleNeg : - - n ≡ n neg-injective : - m ≡ - n → m ≡ n ∣n∣≡0⇒n≡0 : ∣ n ∣ ≡ 0 → n ≡ + 0 ∣-n∣≡∣n∣ : ∣ - n ∣ ≡ ∣ n ∣ +◃n≡+n : Sign.+ ◃ n ≡ + n -◃n≡-n : Sign.- ◃ n ≡ - + n signₙ◃∣n∣≡n : sign n ◃ ∣ n ∣ ≡ n ∣s◃m∣*∣t◃n∣≡m*n : ∣ s ◃ m ∣ ℕ* ∣ t ◃ n ∣ ≡ m ℕ* n ⊖-≰ : n ≰ m → m ⊖ n ≡ - + (n ∸ m) ∣⊖∣-≰ : n ≰ m → ∣ m ⊖ n ∣ ≡ n ∸ m sign-⊖-≰ : n ≰ m → sign (m ⊖ n) ≡ Sign.- -[n⊖m]≡-m+n : - (m ⊖ n) ≡ (- (+ m)) + (+ n) +-identity : Identity (+ 0) _+_ +-inverse : Inverse (+ 0) -_ _+_ +-0-isMonoid : IsMonoid _≡_ _+_ (+ 0) +-0-isGroup : IsGroup _≡_ _+_ (+ 0) (-_) +-0-abelianGroup : AbelianGroup _ _ n≢1+n : n ≢ suc n 1-[1+n]≡-n : suc -[1+ n ] ≡ - (+ n) neg-distrib-+ : - (m + n) ≡ (- m) + (- n) ◃-distrib-+ : s ◃ (m + n) ≡ (s ◃ m) + (s ◃ n) *-identityʳ : RightIdentity (+ 1) _*_ *-identity : Identity (+ 1) _*_ *-zeroˡ : LeftZero (+ 0) _*_ *-zeroʳ : RightZero (+ 0) _*_ *-zero : Zero (+ 0) _*_ *-1-isMonoid : IsMonoid _≡_ _*_ (+ 1) -1*n≡-n : -[1+ 0 ] * n ≡ - n ◃-distrib-* : (s 𝕊* t) ◃ (m ℕ* n) ≡ (s ◃ m) * (t ◃ n) +-*-isRing : IsRing _≡_ _+_ _*_ -_ (+ 0) (+ 1) +-*-isCommutativeRing : IsCommutativeRing _≡_ _+_ _*_ -_ (+ 0) (+ 1) ≤-reflexive : _≡_ ⇒ _≤_ ≤-refl : Reflexive _≤_ ≤-trans : Transitive _≤_ ≤-antisym : Antisymmetric _≡_ _≤_ ≤-total : Total _≤_ ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPartialOrder : IsPartialOrder _≡_ _≤_ ≤-isTotalOrder : IsTotalOrder _≡_ _≤_ ≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ ≤-step : n ≤ m → n ≤ suc m n≤1+n : n ≤ + 1 + n <-irrefl : Irreflexive _≡_ _<_ <-asym : Asymmetric _<_ <-trans : Transitive _<_ <-cmp : Trichotomous _≡_ _<_ <-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ n≮n : n ≮ n -<+ : -[1+ m ] < + n <⇒≤ : m < n → m ≤ n ≰→> : x ≰ y → x > y ``` * Added functions to `Data.List` ```agda applyUpTo f n ≈ f[0] ∷ f[1] ∷ ... ∷ f[n-1] ∷ [] upTo n ≈ 0 ∷ 1 ∷ ... ∷ n-1 ∷ [] applyDownFrom f n ≈ f[n-1] ∷ f[n-2] ∷ ... ∷ f[0] ∷ [] tabulate f ≈ f[0] ∷ f[1] ∷ ... ∷ f[n-1] ∷ [] allFin n ≈ 0f ∷ 1f ∷ ... ∷ n-1f ∷ [] ``` * Added proofs to `Data.List.Properties` ```agda map-id₂ : All (λ x → f x ≡ x) xs → map f xs ≡ xs map-cong₂ : All (λ x → f x ≡ g x) xs → map f xs ≡ map g xs foldr-++ : foldr f x (ys ++ zs) ≡ foldr f (foldr f x zs) ys foldl-++ : foldl f x (ys ++ zs) ≡ foldl f (foldl f x ys) zs foldr-∷ʳ : foldr f x (ys ∷ʳ y) ≡ foldr f (f y x) ys foldl-∷ʳ : foldl f x (ys ∷ʳ y) ≡ f (foldl f x ys) y reverse-foldr : foldr f x (reverse ys) ≡ foldl (flip f) x ys reverse-foldr : foldl f x (reverse ys) ≡ foldr (flip f) x ys length-reverse : length (reverse xs) ≡ length xs ``` * Added proofs to `Data.List.All.Properties` ```agda All-universal : Universal P → All P xs ¬Any⇒All¬ : ¬ Any P xs → All (¬_ ∘ P) xs All¬⇒¬Any : All (¬_ ∘ P) xs → ¬ Any P xs ¬All⇒Any¬ : Decidable P → ¬ All P xs → Any (¬_ ∘ P) xs ++⁺ : All P xs → All P ys → All P (xs ++ ys) ++⁻ˡ : All P (xs ++ ys) → All P xs ++⁻ʳ : All P (xs ++ ys) → All P ys ++⁻ : All P (xs ++ ys) → All P xs × All P ys concat⁺ : All (All P) xss → All P (concat xss) concat⁻ : All P (concat xss) → All (All P) xss drop⁺ : All P xs → All P (drop n xs) take⁺ : All P xs → All P (take n xs) tabulate⁺ : (∀ i → P (f i)) → All P (tabulate f) tabulate⁻ : All P (tabulate f) → (∀ i → P (f i)) applyUpTo⁺₁ : (∀ {i} → i < n → P (f i)) → All P (applyUpTo f n) applyUpTo⁺₂ : (∀ i → P (f i)) → All P (applyUpTo f n) applyUpTo⁻ : All P (applyUpTo f n) → ∀ {i} → i < n → P (f i) ``` * Added proofs to `Data.List.Any.Properties` ```agda lose∘find : uncurry′ lose (proj₂ (find p)) ≡ p find∘lose : find (lose x∈xs pp) ≡ (x , x∈xs , pp) swap : Any (λ x → Any (P x) ys) xs → Any (λ y → Any (flip P y) xs) ys swap-invol : swap (swap any) ≡ any ∃∈-Any : (∃ λ x → x ∈ xs × P x) → Any P xs Any-⊎⁺ : Any P xs ⊎ Any Q xs → Any (λ x → P x ⊎ Q x) xs Any-⊎⁻ : Any (λ x → P x ⊎ Q x) xs → Any P xs ⊎ Any Q xs Any-×⁺ : Any P xs × Any Q ys → Any (λ x → Any (λ y → P x × Q y) ys) xs Any-×⁻ : Any (λ x → Any (λ y → P x × Q y) ys) xs → Any P xs × Any Q ys map⁺ : Any (P ∘ f) xs → Any P (map f xs) map⁻ : Any P (map f xs) → Any (P ∘ f) xs ++⁺ˡ : Any P xs → Any P (xs ++ ys) ++⁺ʳ : Any P ys → Any P (xs ++ ys) ++⁻ : Any P (xs ++ ys) → Any P xs ⊎ Any P ys concat⁺ : Any (Any P) xss → Any P (concat xss) concat⁻ : Any P (concat xss) → Any (Any P) xss applyUpTo⁺ : P (f i) → i < n → Any P (applyUpTo f n) applyUpTo⁻ : Any P (applyUpTo f n) → ∃ λ i → i < n × P (f i) tabulate⁺ : P (f i) → Any P (tabulate f) tabulate⁻ : Any P (tabulate f) → ∃ λ i → P (f i) map-with-∈⁺ : (∃₂ λ x (x∈xs : x ∈ xs) → P (f x∈xs)) → Any P (map-with-∈ xs f) map-with-∈⁻ : Any P (map-with-∈ xs f) → ∃₂ λ x (x∈xs : x ∈ xs) → P (f x∈xs) return⁺ : P x → Any P (return x) return⁻ : Any P (return x) → P x ``` * Added proofs to `Data.List.Any.Membership.Properties` ```agda ∈-map⁺ : x ∈ xs → f x ∈ map f xs ∈-map⁻ : y ∈ map f xs → ∃ λ x → x ∈ xs × y ≈ f x ``` * Added proofs to `Data.List.Any.Membership.Propositional.Properties` ```agda ∈-map⁺ : x ∈ xs → f x ∈ map f xs ∈-map⁻ : y ∈ map f xs → ∃ λ x → x ∈ xs × y ≈ f x ``` * Added proofs to `Data.Maybe`: ```agda Eq-refl : Reflexive _≈_ → Reflexive (Eq _≈_) Eq-sym : Symmetric _≈_ → Symmetric (Eq _≈_) Eq-trans : Transitive _≈_ → Transitive (Eq _≈_) Eq-dec : Decidable _≈_ → Decidable (Eq _≈_) Eq-isEquivalence : IsEquivalence _≈_ → IsEquivalence (Eq _≈_) Eq-isDecEquivalence : IsDecEquivalence _≈_ → IsDecEquivalence (Eq _≈_) ``` * Added exponentiation operator `_^_` to `Data.Nat.Base` * Added proofs to `Data.Nat.Properties`: ```agda suc-injective : suc m ≡ suc n → m ≡ n ≡-isDecEquivalence : IsDecEquivalence (_≡_ {A = ℕ}) ≡-decSetoid : DecSetoid _ _ ≤-reflexive : _≡_ ⇒ _≤_ ≤-refl : Reflexive _≤_ ≤-trans : Antisymmetric _≡_ _≤_ ≤-antisymmetric : Transitive _≤_ ≤-total : Total _≤_ ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPartialOrder : IsPartialOrder _≡_ _≤_ ≤-isTotalOrder : IsTotalOrder _≡_ _≤_ ≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ __ = map} ``` * Added proofs to `Data.Vec.Equality` ```agda to-≅ : xs ≈ ys → xs ≅ ys xs++[]≈xs : xs ++ [] ≈ xs xs++[]≅xs : xs ++ [] ≅ xs ``` * Added proofs to `Data.Vec.Properties` ```agda lookup-map : lookup i (map f xs) ≡ f (lookup i xs) lookup-functor-morphism : Morphism functor IdentityFunctor map-replicate : map f (replicate x) ≡ replicate (f x) ⊛-is-zipWith : fs ⊛ xs ≡ zipWith _$_ fs xs map-is-⊛ : map f xs ≡ replicate f ⊛ xs zipWith-is-⊛ : zipWith f xs ys ≡ replicate f ⊛ xs ⊛ ys zipWith-replicate₁ : zipWith _⊕_ (replicate x) ys ≡ map (x ⊕_) ys zipWith-replicate₂ : zipWith _⊕_ xs (replicate y) ≡ map (_⊕ y) xs zipWith-map₁ : zipWith _⊕_ (map f xs) ys ≡ zipWith (λ x y → f x ⊕ y) xs ys zipWith-map₂ : zipWith _⊕_ xs (map f ys) ≡ zipWith (λ x y → x ⊕ f y) xs ys ``` * Added proofs to `Data.Vec.All.Properties` ```agda All-++⁺ : All P xs → All P ys → All P (xs ++ ys) All-++ˡ⁻ : All P (xs ++ ys) → All P xs All-++ʳ⁻ : All P (xs ++ ys) → All P ys All-++⁻ : All P (xs ++ ys) → All P xs × All P ys All₂-++⁺ : All₂ _~_ ws xs → All₂ _~_ ys zs → All₂ _~_ (ws ++ ys) (xs ++ zs) All₂-++ˡ⁻ : All₂ _~_ (ws ++ ys) (xs ++ zs) → All₂ _~_ ws xs All₂-++ʳ⁻ : All₂ _~_ (ws ++ ys) (xs ++ zs) → All₂ _~_ ys zs All₂-++⁻ : All₂ _~_ (ws ++ ys) (xs ++ zs) → All₂ _~_ ws xs × All₂ _~_ ys zs All-concat⁺ : All (All P) xss → All P (concat xss) All-concat⁻ : All P (concat xss) → All (All P) xss All₂-concat⁺ : All₂ (All₂ _~_) xss yss → All₂ _~_ (concat xss) (concat yss) All₂-concat⁻ : All₂ _~_ (concat xss) (concat yss) → All₂ (All₂ _~_) xss yss ``` * Added non-dependant versions of the application combinators in `Function` for use cases where the most general one leads to unsolved meta variables: ```agda _$′_ : (A → B) → (A → B) _$!′_ : (A → B) → (A → B) ``` * Added proofs to `Relation.Binary.Consequences` ```agda P-resp⟶¬P-resp : Symmetric _≈_ → P Respects _≈_ → (¬_ ∘ P) Respects _≈_ ``` * Added conversion lemmas to `Relation.Binary.HeterogeneousEquality` ```agda ≅-to-type-≡ : {x : A} {y : B} → x ≅ y → A ≡ B ≅-to-subst-≡ : (p : x ≅ y) → subst (λ x → x) (≅-to-type-≡ p) x ≡ y ``` Version 0.13 ============ The library has been tested using Agda version 2.5.2. Important changes since 0.12: * Added the `Selective` property in `Algebra.FunctionProperties` as well as proofs of the selectivity of `min` and `max` in `Data.Nat.Properties`. * Added `Relation.Binary.Product.StrictLex.×-total₂`, an alternative (non-degenerative) proof for totality, and renamed `×-total` to `x-total₁` in that module. * Added the `length-filter` property to `Data.List.Properties` (the `filter` equivalent to the pre-existing `length-gfilter`). * Added `_≤?_` decision procedure for `Data.Fin`. * Added `allPairs` function to `Data.Vec`. * Added additional properties of `_∈_` to `Data.Vec.Properties`: `∈-map`, `∈-++ₗ`, `∈-++ᵣ`, `∈-allPairs`. * Added some `zip`/`unzip`-related properties to `Data.Vec.Properties`. * Added an `All` predicate and related properties for `Data.Vec` (see `Data.Vec.All` and `Data.Vec.All.Properties`). * Added order-theoretic lattices and some related properties in `Relation.Binary.Lattice` and `Relation.Binary.Properties`. * Added symmetric and equivalence closures of binary relations in `Relation.Binary.SymmetricClosure` and `Relation.Binary.EquivalenceClosure`. * Added `Congruent₁` and `Congruent₂` to `Algebra.FunctionProperties`. These are aliases for `_Preserves _≈_ ⟶ _≈_` and `_Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_` from `Relation.Binary.Core`. * Useful lemmas and properties that were previously in private scope, either explicitly or within records, have been made public in several `Properties.agda` files. These include: ```agda Data.Bool.Properties Data.Fin.Properties Data.Integer.Properties Data.Integer.Addition.Properties Data.Integer.Multiplication.Properties ``` Version 0.12 ============ The library has been tested using Agda version 2.5.1. Important changes since 0.11: * Added support for GHC 8.0.1. Version 0.11 ============ The library has been tested using Agda version 2.4.2.4. Important changes since 0.10: * `Relation.Binary.PropositionalEquality.TrustMe.erase` was added. * Added `Data.Nat.Base.{_≤″_,_≥″_,_<″_,_>″_,erase}`, `Data.Nat.Properties.{≤⇒≤″,≤″⇒≤}`, `Data.Fin.fromℕ≤″`, and `Data.Fin.Properties.fromℕ≤≡fromℕ≤″`. * The functions in `Data.Nat.DivMod` have been optimised. * Turned on η-equality for `Record.Record`, removed `Record.Signature′` and `Record.Record′`. * Renamed `Data.AVL.agda._⊕_sub1` to `pred[_⊕_]`. Version 0.10 ============ The library has been tested using Agda version 2.4.2.3. Important changes since 0.9: * Renamed `Data.Unit.Core` to `Data.Unit.NonEta`. * Removed `Data.String.Core`. The module `Data.String.Base` now contains these definitions. * Removed `Relation.Nullary.Core`. The module `Relation.Nullary` now contains these definitions directly. * Inspect on steroids has been simplified (see `Relation.Binary.PropositionalEquality` and `Relation.Binary.HeterogeneousEquality`). The old version has been deprecated (see the above modules) and it will be removed in the next release. * Using `Data.X.Base` modules. The `Data.X.Base` modules are used for cheaply importing a data type and the most common definitions. The use of these modules reduce type-checking and compilation times. At the moment, the modules added are: ```agda Data.Bool.Base Data.Char.Base Data.Integer.Base Data.List.Base Data.Maybe.Base Data.Nat.Base Data.String.Base Data.Unit.Base ``` These modules are also cheap to import and can be considered basic: ```agda Data.BoundedVec.Inefficient Data.Empty Data.Product Data.Sign Data.Sum Function Level Relation.Binary Relation.Binary.PropositionalEquality.TrustMe Relation.Nullary ``` * Added singleton sets to `Relation.Unary`. There used to be an isomorphic definition of singleton sets in `Monad.Predicate`, this has been removed and the module has been cleaned up accordingly. The singleton set is also used to define generic operations (Plotkin and Power's terminology) in `Data.Container.Indexed.FreeMonad`. * Proved properties of `Data.List.gfilter`. The following definitions have been added to Data.List.Properties: ```agda gfilter-just : ... → gfilter just xs ≡ xs gfilter-nothing : ... → gfilter (λ _ → nothing) xs ≡ [] gfilter-concatMap : ... → gfilter f ≗ concatMap (fromMaybe ∘ f) ``` * New in `Data.Nat.Properties`: ```agda <⇒≤pred : ∀ {m n} → m < n → m ≤ pred n ``` * New in `Data.Fin`: ```agda strengthen : ∀ {n} (i : Fin n) → Fin′ (suc i) ``` * New in `Data.Fin.Properties`: ```agda from-to : ∀ {n} (i : Fin n) → fromℕ (toℕ i) ≡ strengthen i toℕ-strengthen : ∀ {n} (i : Fin n) → toℕ (strengthen i) ≡ toℕ i fromℕ-def : ∀ n → fromℕ n ≡ fromℕ≤ ℕ≤-refl reverse-suc : ∀{n}{i : Fin n} → toℕ (reverse (suc i)) ≡ toℕ (reverse i) inject≤-refl : ∀ {n} (i : Fin n) (n≤n : n ℕ≤ n) → inject≤ i n≤n ≡ i ``` * New in `Data.List.NonEmpty`: ```agda foldr₁ : ∀ {a} {A : Set a} → (A → A → A) → List⁺ A → A foldl₁ : ∀ {a} {A : Set a} → (A → A → A) → List⁺ A → A ``` * `Data.AVL.Height-invariants._∼_` was replaced by `_∼_⊔_`, following Conor McBride's principle of pushing information into indices rather than pulling information out. Some lemmas in `Data.AVL.Height-invariants` (`1+`, `max∼max` and `max-lemma`) were removed. The implementations of some functions in `Data.AVL` were simplified. This could mean that they, and other functions depending on them (in `Data.AVL`, `Data.AVL.IndexedMap` and `Data.AVL.Sets`), reduce in a different way than they used to. * The fixity of all `_∎` and `finally` operators, as well as `Category.Monad.Partiality.All._⟨_⟩P`, was changed from `infix 2` to `infix 3`. * The fixity of `Category.Monad.Partiality._≟-Kind_`, `Data.AVL._∈?_`, `Data.AVL.IndexedMap._∈?_`, `Data.AVL.Sets._∈?_`, `Data.Bool._≟_`, `Data.Char._≟_`, `Data.Float._≟_`, `Data.Nat._≤?_`, `Data.Nat.Divisibility._∣?_`, `Data.Sign._≟_`, `Data.String._≟_`, `Data.Unit._≟_`, `Data.Unit._≤?_` and `Data.Vec.Equality.DecidableEquality._≟_` was changed from the default to `infix 4`. * The fixity of all `_≟_` operators in `Reflection` is now `infix 4` (some of them already had this fixity). * The fixity of `Algebra.Operations._×′_` was changed from the default to `infixr 7`. * The fixity of `Data.Fin.#_` was changed from the default to `infix 10`. * The fixity of `Data.Nat.Divisibility.1∣_` and `_∣0` was changed from the default to `infix 10`. * The fixity of `Data.Nat.DivMod._divMod_`, `_div_` and `_mod_` was changed from the default to `infixl 7`. * The fixity of `Data.Product.Σ-syntax` was changed from the default to `infix 2`. * The fixity of `Relation.Unary._~` was changed from the default to `infix 10`. Version 0.9 =========== The library has been tested using Agda version 2.4.2.1. Important changes since 0.8.1: * `Data.List.NonEmpty` Non-empty lists are no longer defined in terms of `Data.Product._×_`, instead, now they are defined as record with fields head and tail. * Reflection API + Quoting levels was fixed. This fix could break some code (see Agda Issue [#1207](https://github.com/agda/agda/issues/1269)). + The `Reflection.type` function returns a normalised `Reflection.Type` and `quoteTerm` returns an η-contracted `Reflection.Term` now. These changes could break some code (see Agda Issue [#1269](https://github.com/agda/agda/issues/1269)). + The primitive function for showing names, `primShowQName`, is now exposed as `Reflection.showName`. * Removed compatibility modules for `Props -> Properties` rename Use `Foo.Properties.Bar` instead of `Foo.Props.Bar`. Version 0.8.1 ============= The library has been tested using Agda version 2.4.2. Important changes since 0.8: * Reflection API Agda 2.4.2 added support for literals, function definitions, pattern matching lambdas and absurd clause/patterns (see Agda release notes). The new supported entities were added to the `Reflection.agda` module. * Modules renamed `Foo.Props.Bar` -> `Foo.Properties.Bar` The current compatibility modules `Foo.Props.Bar` will be removed in the next release. Version 0.8 =========== Version 0.8 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.4.0. Version 0.7 =========== Version 0.7 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.3.2. Version 0.6 =========== Version 0.6 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.3.0. Version 0.5 =========== Version 0.5 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.10. Version 0.4 =========== Version 0.4 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.8. Version 0.3 =========== Version 0.3 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.6. Version 0.2 =========== Version 0.2 of the ["standard" library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.4. Note that the library sources are now located in the sub-directory `lib-/src` of the installation tarball. Version 0.1 =========== Version 0.1 of the ["standard" library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.2. agda-stdlib-0.14/GNUmakefile000066400000000000000000000010331315545220200156570ustar00rootroot00000000000000AGDA=agda # Before running `make test` the `fix-agda-whitespace` program should # be installed: # # cd agda-development-version-path/src/fix-agda-whitespace # cabal install test: Everything.agda cabal exec -- fix-agda-whitespace --check $(AGDA) -i. -isrc README.agda setup: Everything.agda .PHONY: Everything.agda Everything.agda: cabal clean && cabal install cabal exec -- GenerateEverything .PHONY: listings listings: Everything.agda $(AGDA) -i. -isrc --html README.agda -v0 clean : find . -type f -name '*.agdai' -delete agda-stdlib-0.14/GenerateEverything.hs000066400000000000000000000055651315545220200177560ustar00rootroot00000000000000{-# LANGUAGE PatternGuards #-} import qualified Data.List as List import Control.Applicative import System.Environment import System.IO import System.Exit import System.FilePath import System.FilePath.Find headerFile = "Header" outputFile = "Everything.agda" srcDir = "src" main = do args <- getArgs case args of [] -> return () _ -> hPutStr stderr usage >> exitFailure header <- readFileUTF8 headerFile modules <- filter isLibraryModule . List.sort <$> find always (extension ==? ".agda" ||? extension ==? ".lagda") srcDir headers <- mapM extractHeader modules writeFileUTF8 outputFile $ header ++ format (zip modules headers) -- | Usage info. usage :: String usage = unlines [ "GenerateEverything: A utility program for Agda's standard library." , "" , "Usage: GenerateEverything" , "" , "This program should be run in the base directory of a clean checkout of" , "the library." , "" , "The program generates documentation for the library by extracting" , "headers from library modules. The output is written to " ++ outputFile , "with the file " ++ headerFile ++ " inserted verbatim at the beginning." ] -- | Returns 'True' for all Agda files except for core modules. isLibraryModule :: FilePath -> Bool isLibraryModule f = takeExtension f `elem` [".agda", ".lagda"] && dropExtension (takeFileName f) /= "Core" && dropExtension (takeFileName f) /= "index" -- | Reads a module and extracts the header. extractHeader :: FilePath -> IO [String] extractHeader mod = fmap (extract . lines) $ readFileUTF8 mod where delimiter = all (== '-') extract (d1 : "-- The Agda standard library" : "--" : ss) | delimiter d1 , (info, d2 : rest) <- span ("-- " `List.isPrefixOf`) ss , delimiter d2 = info extract _ = error $ mod ++ " is malformed." -- | Formats the extracted module information. format :: [(FilePath, [String])] -- ^ Pairs of module names and headers. All lines in the -- headers are already prefixed with \"-- \". -> String format = unlines . concat . map fmt where fmt (mod, header) = "" : header ++ ["import " ++ fileToMod mod] -- | Translates a file name to the corresponding module name. It is -- assumed that the file name corresponds to an Agda module under -- 'srcDir'. fileToMod :: FilePath -> String fileToMod = map slashToDot . dropExtension . makeRelative srcDir where slashToDot c | isPathSeparator c = '.' | otherwise = c -- | A variant of 'readFile' which uses the 'utf8' encoding. readFileUTF8 :: FilePath -> IO String readFileUTF8 f = do h <- openFile f ReadMode hSetEncoding h utf8 hGetContents h -- | A variant of 'writeFile' which uses the 'utf8' encoding. writeFileUTF8 :: FilePath -> String -> IO () writeFileUTF8 f s = withFile f WriteMode $ \h -> do hSetEncoding h utf8 hPutStr h s agda-stdlib-0.14/HACKING.md000066400000000000000000000022731315545220200152020ustar00rootroot00000000000000Testing and documenting your changes ------------------------------------ When you implement a new feature of fix a bug: 1. Document it in `CHANGELOG.md`. 2. Test your changes by running ``` make clean make test ``` Where to commit changes ----------------------- CURRENT_AGDA = current released Agda version, e.g. 2.4.2.5 AGDA_MAINT = Agda maintenance version, e.g. 2.4.2.6 A. Your change is independent of Agda 1. Push your commit in the `CURRENT_AGDA` branch 2. Merge the `CURRENT_AGDA` branch into the `AGDA_MAINT` branch 3. Merge the `AGDA_MAINT` branch into the master branch B. Your change is due to a change in the `AGDA_MAINT` version of Agda 1. Push your commit in the `AGDA_MAINT` branch 2. Merge the `AGDA_MAINT` branch into the master branch C. Your change is due to a change in the master version of Agda 1. Push your commit in the master branch This scheme should guarantee that: a. the stdlib `CURRENT_AGDA` branch always builds with the current released Agda version, b. the stdlib `AGDA_MAINT` branch always build with the Agda maint branch and c. the stdlib master branch always builds with the Agda master branch. agda-stdlib-0.14/Header000066400000000000000000000004561315545220200147300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- All library modules, along with short descriptions ------------------------------------------------------------------------ -- Note that core modules are not included. module Everything where agda-stdlib-0.14/LICENCE000066400000000000000000000030441315545220200145760ustar00rootroot00000000000000Copyright (c) 2007-2017 Nils Anders Danielsson, Ulf Norell, Shin-Cheng Mu, Samuel Bronson, Dan Doel, Patrik Jansson, Liang-Ting Chen, Jean-Philippe Bernardy, Andrés Sicard-Ramírez, Nicolas Pouillard, Darin Morrison, Peter Berry, Daniel Brown, Simon Foster, Dominique Devriese, Andreas Abel, Alcatel-Lucent, Eric Mertens, Joachim Breitner, Liyang Hu, Noam Zeilberger, Érdi Gergő, Stevan Andjelkovic, Helmut Grohne, Guilhem Moulin, Noriyuki OHKAWA, Evgeny Kotelnikov, James Chapman, Pepijn Kokke, Matthew Daggitt and some anonymous contributors. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. agda-stdlib-0.14/README.agda000066400000000000000000000240431315545220200153660ustar00rootroot00000000000000module README where ------------------------------------------------------------------------ -- The Agda standard library, version 0.14 -- -- Author: Nils Anders Danielsson, with contributions from Andreas -- Abel, Stevan Andjelkovic, Jean-Philippe Bernardy, Peter Berry, -- Joachim Breitner, Samuel Bronson, Daniel Brown, James Chapman, -- Liang-Ting Chen, Matthew Daggitt, Dominique Devriese, Dan Doel, -- Érdi Gergő, Helmut Grohne, Simon Foster, Liyang Hu, Patrik Jansson, -- Alan Jeffrey, Pepijn Kokke, Evgeny Kotelnikov, Sergei Meshveliani -- Eric Mertens, Darin Morrison, Guilhem Moulin, Shin-Cheng Mu, -- Ulf Norell, Noriyuki OHKAWA, Nicolas Pouillard, Andrés Sicard-Ramírez, -- Noam Zeilberger and some anonymous contributors. -- ---------------------------------------------------------------------- -- This version of the library has been tested using Agda 2.5.3. -- Note that no guarantees are currently made about forwards or -- backwards compatibility, the library is still at an experimental -- stage. -- The library comes with a .agda-lib file, for use with the library -- management system. -- Currently the library does not support the JavaScript compiler -- backend. -- Contributions to this library are welcome (but to avoid wasted work -- it is suggested that you discuss large changes before implementing -- them). Please send contributions in the form of git pull requests, -- patch bundles or ask for commmit rights to the repository. It is -- appreciated if every patch contains a single, complete change, and -- if the coding style used in the library is adhered to. ------------------------------------------------------------------------ -- Module hierarchy ------------------------------------------------------------------------ -- The top-level module names of the library are currently allocated -- as follows: -- -- • Algebra -- Abstract algebra (monoids, groups, rings etc.), along with -- properties needed to specify these structures (associativity, -- commutativity, etc.), and operations on and proofs about the -- structures. -- • Category -- Category theory-inspired idioms used to structure functional -- programs (functors and monads, for instance). -- • Coinduction -- Support for coinduction. -- • Data -- Data types and properties about data types. -- • Function -- Combinators and properties related to functions. -- • Foreign -- Related to the foreign function interface. -- • Induction -- A general framework for induction (includes lexicographic and -- well-founded induction). -- • IO -- Input/output-related functions. -- • Level -- Universe levels. -- • Record -- An encoding of record types with manifest fields and "with". -- • Reflection -- Support for reflection. -- • Relation -- Properties of and proofs about relations (mostly homogeneous -- binary relations). -- • Size -- Sizes used by the sized types mechanism. -- • Strict -- Provides access to the builtins relating to strictness. -- • Universe -- A definition of universes. ------------------------------------------------------------------------ -- A selection of useful library modules ------------------------------------------------------------------------ -- Note that module names in source code are often hyperlinked to the -- corresponding module. In the Emacs mode you can follow these -- hyperlinks by typing M-. or clicking with the middle mouse button. -- • Some data types import Data.Bool -- Booleans. import Data.Char -- Characters. import Data.Empty -- The empty type. import Data.Fin -- Finite sets. import Data.List -- Lists. import Data.Maybe -- The maybe type. import Data.Nat -- Natural numbers. import Data.Product -- Products. import Data.Stream -- Streams. import Data.String -- Strings. import Data.Sum -- Disjoint sums. import Data.Unit -- The unit type. import Data.Vec -- Fixed-length vectors. -- • Some types used to structure computations import Category.Functor -- Functors. import Category.Applicative -- Applicative functors. import Category.Monad -- Monads. -- • Equality -- Propositional equality: import Relation.Binary.PropositionalEquality -- Convenient syntax for "equational reasoning" using a preorder: import Relation.Binary.PreorderReasoning -- Solver for commutative ring or semiring equalities: import Algebra.RingSolver -- • Properties of functions, sets and relations -- Monoids, rings and similar algebraic structures: import Algebra -- Negation, decidability, and similar operations on sets: import Relation.Nullary -- Properties of homogeneous binary relations: import Relation.Binary -- • Induction -- An abstraction of various forms of recursion/induction: import Induction -- Well-founded induction: import Induction.WellFounded -- Various forms of induction for natural numbers: import Induction.Nat -- • Support for coinduction import Coinduction -- • IO import IO ------------------------------------------------------------------------ -- Record hierarchies ------------------------------------------------------------------------ -- When an abstract hierarchy of some sort (for instance semigroup → -- monoid → group) is included in the library the basic approach is to -- specify the properties of every concept in terms of a record -- containing just properties, parameterised on the underlying -- operations, sets etc.: -- -- record IsSemigroup {A} (≈ : Rel A) (∙ : Op₂ A) : Set where -- open FunctionProperties ≈ -- field -- isEquivalence : IsEquivalence ≈ -- assoc : Associative ∙ -- ∙-cong : ∙ Preserves₂ ≈ ⟶ ≈ ⟶ ≈ -- -- More specific concepts are then specified in terms of the simpler -- ones: -- -- record IsMonoid {A} (≈ : Rel A) (∙ : Op₂ A) (ε : A) : Set where -- open FunctionProperties ≈ -- field -- isSemigroup : IsSemigroup ≈ ∙ -- identity : Identity ε ∙ -- -- open IsSemigroup isSemigroup public -- -- Note here that open IsSemigroup isSemigroup public ensures that the -- fields of the isSemigroup record can be accessed directly; this -- technique enables the user of an IsMonoid record to use underlying -- records without having to manually open an entire record hierarchy. -- This is not always possible, though. Consider the following definition -- of preorders: -- -- record IsPreorder {A : Set} -- (_≈_ : Rel A) -- The underlying equality. -- (_∼_ : Rel A) -- The relation. -- : Set where -- field -- isEquivalence : IsEquivalence _≈_ -- -- Reflexivity is expressed in terms of an underlying equality: -- reflexive : _≈_ ⇒ _∼_ -- trans : Transitive _∼_ -- -- module Eq = IsEquivalence isEquivalence -- -- ... -- -- The Eq module in IsPreorder is not opened publicly, because it -- contains some fields which clash with fields or other definitions -- in IsPreorder. -- Records packing up properties with the corresponding operations, -- sets, etc. are sometimes also defined: -- -- record Semigroup : Set₁ where -- infixl 7 _∙_ -- infix 4 _≈_ -- field -- Carrier : Set -- _≈_ : Rel Carrier -- _∙_ : Op₂ Carrier -- isSemigroup : IsSemigroup _≈_ _∙_ -- -- open IsSemigroup isSemigroup public -- -- setoid : Setoid -- setoid = record { isEquivalence = isEquivalence } -- -- record Monoid : Set₁ where -- infixl 7 _∙_ -- infix 4 _≈_ -- field -- Carrier : Set -- _≈_ : Rel Carrier -- _∙_ : Op₂ Carrier -- ε : Carrier -- isMonoid : IsMonoid _≈_ _∙_ ε -- -- open IsMonoid isMonoid public -- -- semigroup : Semigroup -- semigroup = record { isSemigroup = isSemigroup } -- -- open Semigroup semigroup public using (setoid) -- -- Note that the Monoid record does not include a Semigroup field. -- Instead the Monoid /module/ includes a "repackaging function" -- semigroup which converts a Monoid to a Semigroup. -- The above setup may seem a bit complicated, but we think it makes the -- library quite easy to work with, while also providing enough -- flexibility. ------------------------------------------------------------------------ -- More documentation ------------------------------------------------------------------------ -- Some examples showing where the natural numbers/integers and some -- related operations and properties are defined, and how they can be -- used: import README.Nat import README.Integer -- Some examples showing how the AVL tree module can be used. import README.AVL -- An example showing how the Record module can be used. import README.Record -- An example showing how the case expression can be used. import README.Case -- An example showing how the free monad construction on containers can be -- used import README.Container.FreeMonad ------------------------------------------------------------------------ -- Core modules ------------------------------------------------------------------------ -- Some modules have names ending in ".Core". These modules are -- internal, and have (mostly) been created to avoid mutual recursion -- between modules. They should not be imported directly; their -- contents are reexported by other modules. ------------------------------------------------------------------------ -- All library modules ------------------------------------------------------------------------ -- For short descriptions of every library module, see Everything: import Everything -- Note that the Everything module is generated automatically. If you -- have downloaded the library from its Git repository and want to -- type check README then you can (try to) construct Everything by -- running "cabal install && GenerateEverything". -- Note that all library sources are located under src or ffi. The -- modules README, README.* and Everything are not really part of the -- library, so these modules are located in the top-level directory -- instead. agda-stdlib-0.14/README.md000066400000000000000000000002371315545220200150710ustar00rootroot00000000000000agda-stdlib =========== The Agda standard library. You can browse the source in glorious clickable html here: https://agda.github.io/agda-stdlib/README.html agda-stdlib-0.14/README/000077500000000000000000000000001315545220200145455ustar00rootroot00000000000000agda-stdlib-0.14/README/AVL.agda000066400000000000000000000061421315545220200160100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing how the AVL tree module can be used ------------------------------------------------------------------------ module README.AVL where ------------------------------------------------------------------------ -- Setup -- AVL trees are defined in Data.AVL. import Data.AVL -- This module is parametrised by keys, which have to form a (strict) -- total order, and values, which are indexed by keys. Let us use -- natural numbers as keys and vectors of strings as values. open import Data.Nat.Properties using (<-isStrictTotalOrder) open import Data.String using (String) open import Data.Vec using (Vec; _∷_; []) open Data.AVL (Vec String) (<-isStrictTotalOrder) ------------------------------------------------------------------------ -- Construction of trees -- Some values. v₁ = "cepa" ∷ [] v₁′ = "depa" ∷ [] v₂ = "apa" ∷ "bepa" ∷ [] -- Empty and singleton trees. t₀ : Tree t₀ = empty t₁ : Tree t₁ = singleton 2 v₂ -- Insertion of a key-value pair into a tree. t₂ = insert 1 v₁ t₁ -- If you insert a key-value pair and the key already exists in the -- tree, then the old value is thrown away. t₂′ = insert 1 v₁′ t₂ -- Deletion of the mapping for a certain key. t₃ = delete 2 t₂ -- Conversion of a list of key-value mappings to a tree. open import Data.List using (_∷_; []) open import Data.Product as Prod using (_,_; _,′_) t₄ = fromList ((2 , v₂) ∷ (1 , v₁) ∷ []) ------------------------------------------------------------------------ -- Queries -- Let us formulate queries as unit tests. open import Relation.Binary.PropositionalEquality using (_≡_; refl) -- Searching for a key. open import Data.Bool.Base using (true; false) open import Data.Maybe.Base as Maybe using (just; nothing) q₀ : lookup 2 t₂ ≡ just v₂ q₀ = refl q₁ : lookup 2 t₃ ≡ nothing q₁ = refl q₂ : (3 ∈? t₂) ≡ false q₂ = refl q₃ : (1 ∈? t₄) ≡ true q₃ = refl -- Turning a tree into a sorted list of key-value pairs. q₄ : toList t₁ ≡ (2 , v₂) ∷ [] q₄ = refl q₅ : toList t₂ ≡ (1 , v₁) ∷ (2 , v₂) ∷ [] q₅ = refl q₅′ : toList t₂′ ≡ (1 , v₁′) ∷ (2 , v₂) ∷ [] q₅′ = refl ------------------------------------------------------------------------ -- Views -- Partitioning a tree into the smallest element plus the rest, or the -- largest element plus the rest. open import Function using (id) v₆ : headTail t₀ ≡ nothing v₆ = refl v₇ : Maybe.map (Prod.map id toList) (headTail t₂) ≡ just ((1 , v₁) , ((2 , v₂) ∷ [])) v₇ = refl v₈ : initLast t₀ ≡ nothing v₈ = refl v₉ : Maybe.map (Prod.map toList id) (initLast t₄) ≡ just (((1 , v₁) ∷ []) ,′ (2 , v₂)) v₉ = refl ------------------------------------------------------------------------ -- Further reading -- Variations of the AVL tree module are available: -- • Finite maps with indexed keys and values. import Data.AVL.IndexedMap -- • Finite sets. import Data.AVL.Sets agda-stdlib-0.14/README/Case.agda000066400000000000000000000016531315545220200162430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the case expressions can be used ------------------------------------------------------------------------ module README.Case where open import Data.Fin hiding (pred) open import Data.Maybe hiding (from-just) open import Data.Nat hiding (pred) open import Function -- Some simple examples. empty : ∀ {a} {A : Set a} → Fin 0 → A empty i = case i of λ() pred : ℕ → ℕ pred n = case n of λ { zero → zero ; (suc n) → n } from-just : ∀ {a} {A : Set a} (x : Maybe A) → From-just A x from-just x = case x return From-just _ of λ { (just x) → x ; nothing → _ } -- Note that some natural uses of case are rejected by the termination -- checker: -- -- plus : ℕ → ℕ → ℕ -- plus m n = case m of λ -- { zero → n -- ; (suc m) → suc (plus m n) -- } agda-stdlib-0.14/README/Container/000077500000000000000000000000001315545220200164675ustar00rootroot00000000000000agda-stdlib-0.14/README/Container/FreeMonad.agda000066400000000000000000000036321315545220200211510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example showing how the free monad construction on containers can be -- used ------------------------------------------------------------------------ module README.Container.FreeMonad where open import Category.Monad open import Data.Empty open import Data.Unit open import Data.Bool.Base using (Bool; true) open import Data.Nat open import Data.Sum using (inj₁; inj₂) open import Data.Product renaming (_×_ to _⟨×⟩_) open import Data.Container open import Data.Container.Combinator open import Data.Container.FreeMonad open import Data.W open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- The signature of state and its (generic) operations. State : Set → Container _ State S = ⊤ ⟶ S ⊎ S ⟶ ⊤ where _⟶_ : Set → Set → Container _ I ⟶ O = I ▷ λ _ → O get : ∀ {S} → State S ⋆ S get = do (inj₁ _ , return) where open RawMonad rawMonad put : ∀ {S} → S → State S ⋆ ⊤ put s = do (inj₂ s , return) where open RawMonad rawMonad -- Using the above we can, for example, write a stateful program that -- delivers a boolean. prog : State ℕ ⋆ Bool prog = get >>= λ n → put (suc n) >> return true where open RawMonad rawMonad runState : ∀ {S X} → State S ⋆ X → (S → X ⟨×⟩ S) runState (sup (inj₁ x) _) = λ s → x , s runState (sup (inj₂ (inj₁ _)) k) = λ s → runState (k s) s runState (sup (inj₂ (inj₂ s)) k) = λ _ → runState (k _) s test : runState prog 0 ≡ (true , 1) test = refl -- It should be noted that @State S ⋆ X@ is not the state monad. If we -- could quotient @State S ⋆ X@ by the seven axioms of state (see -- Plotkin and Power's "Notions of Computation Determine Monads", 2002) -- then we would get the state monad. agda-stdlib-0.14/README/Integer.agda000066400000000000000000000037341315545220200167670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing where the integers and some related -- operations and properties are defined, and how they can be used ------------------------------------------------------------------------ module README.Integer where -- The integers and various arithmetic operations are defined in -- Data.Integer. open import Data.Integer -- The +_ function converts natural numbers into integers. ex₁ : ℤ ex₁ = + 2 -- The -_ function negates an integer. ex₂ : ℤ ex₂ = - + 4 -- Some binary operators are also defined, including addition, -- subtraction and multiplication. ex₃ : ℤ ex₃ = + 1 + + 3 * - + 2 - + 4 -- Propositional equality and some related properties can be found -- in Relation.Binary.PropositionalEquality. open import Relation.Binary.PropositionalEquality as P using (_≡_) ex₄ : ex₃ ≡ - + 9 ex₄ = P.refl -- Data.Integer.Properties contains a number of properties related to -- integers. Algebra defines what a commutative ring is, among other -- things. open import Algebra import Data.Integer.Properties as Integer private module CR = CommutativeRing Integer.commutativeRing ex₅ : ∀ i j → i * j ≡ j * i ex₅ i j = CR.*-comm i j -- The module ≡-Reasoning in Relation.Binary.PropositionalEquality -- provides some combinators for equational reasoning. open P.≡-Reasoning open import Data.Product ex₆ : ∀ i j → i * (j + + 0) ≡ j * i ex₆ i j = begin i * (j + + 0) ≡⟨ P.cong (_*_ i) (proj₂ CR.+-identity j) ⟩ i * j ≡⟨ CR.*-comm i j ⟩ j * i ∎ -- The module RingSolver in Data.Integer.Properties contains a solver -- for integer equalities involving variables, constants, _+_, _*_, -_ -- and _-_. ex₇ : ∀ i j → i * - j - j * i ≡ - + 2 * i * j ex₇ = solve 2 (λ i j → i :* :- j :- j :* i := :- con (+ 2) :* i :* j) P.refl where open Integer.RingSolver agda-stdlib-0.14/README/Nat.agda000066400000000000000000000026721315545220200161140ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing where the natural numbers and some related -- operations and properties are defined, and how they can be used ------------------------------------------------------------------------ module README.Nat where -- The natural numbers and various arithmetic operations are defined -- in Data.Nat. open import Data.Nat ex₁ : ℕ ex₁ = 1 + 3 -- Propositional equality and some related properties can be found -- in Relation.Binary.PropositionalEquality. open import Relation.Binary.PropositionalEquality ex₂ : 3 + 5 ≡ 2 * 4 ex₂ = refl -- Data.Nat.Properties contains a number of properties about natural -- numbers. import Data.Nat.Properties as Nat ex₃ : ∀ m n → m * n ≡ n * m ex₃ m n = Nat.*-comm m n -- The module ≡-Reasoning in Relation.Binary.PropositionalEquality -- provides some combinators for equational reasoning. open ≡-Reasoning ex₄ : ∀ m n → m * (n + 0) ≡ n * m ex₄ m n = begin m * (n + 0) ≡⟨ cong (_*_ m) (Nat.+-identityʳ n) ⟩ m * n ≡⟨ Nat.*-comm m n ⟩ n * m ∎ -- The module SemiringSolver in Data.Nat.Properties contains a solver -- for natural number equalities involving variables, constants, _+_ -- and _*_. open Nat.SemiringSolver ex₅ : ∀ m n → m * (n + 0) ≡ n * m ex₅ = solve 2 (λ m n → m :* (n :+ con 0) := n :* m) refl agda-stdlib-0.14/README/Record.agda000066400000000000000000000022071315545220200166020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how the Record module can be used ------------------------------------------------------------------------ -- Taken from Randy Pollack's paper "Dependently Typed Records in Type -- Theory". module README.Record where open import Data.Product open import Data.String open import Function using (flip) open import Level import Record open import Relation.Binary -- Let us use strings as labels. open Record String _≟_ -- Partial equivalence relations. PER : Signature _ PER = ∅ , "S" ∶ (λ _ → Set) , "R" ∶ (λ r → r · "S" → r · "S" → Set) , "sym" ∶ (λ r → Lift (Symmetric (r · "R"))) , "trans" ∶ (λ r → Lift (Transitive (r · "R"))) -- Given a PER the converse relation is also a PER. converse : (P : Record PER) → Record (PER With "S" ≔ (λ _ → P · "S") With "R" ≔ (λ _ → flip (P · "R"))) converse P = rec (rec (_ , lift λ {_} → lower (P · "sym")) , lift λ {_} yRx zRy → lower (P · "trans") zRy yRx) agda-stdlib-0.14/Setup.hs000066400000000000000000000000571315545220200152460ustar00rootroot00000000000000import Distribution.Simple main = defaultMain agda-stdlib-0.14/doc/000077500000000000000000000000001315545220200143555ustar00rootroot00000000000000agda-stdlib-0.14/doc/release-notes/000077500000000000000000000000001315545220200171235ustar00rootroot00000000000000agda-stdlib-0.14/doc/release-notes/future.txt000066400000000000000000000021631315545220200212000ustar00rootroot00000000000000NOTE: Put drafts of release notes here that might be included in some future release. Don't remove this message please! ------------------------------------------------------------------------------ * Support for the UHC backend has been added. * The tri⟶irr function has been made more general. * The field <-resp-≈ has been removed from the IsStrictTotalOrder record. The property can be derived (see the new lemma Relation.Binary.Consequences.trans∧tri⟶resp≈), and is available from the IsStrictTotalOrder record module. * Various changes required by changes in Agda (see Agda CHANGELOG): ** Hiding some modules in import directives after fixing #836. ** Removed COMPILED_DATA for Bool.Base.agda. ** Removed the IRRAXIOM built-in from Irrelevance.agda ** Added BUILTIN bindings in Data/Integer.agda ** IO FFI calls work with the now Data.Text-backed String builtins. ** Added parentheses for fixing operators and sections parsing. ** Added BUILTIN binding in Data/Unit.agda. ** Various changes in Reflection.agda ** Use COMPILE and FOREIGN compiler pragmas instead of old deprecated ones. agda-stdlib-0.14/index.sh000077500000000000000000000002451315545220200152570ustar00rootroot00000000000000for i in $( find src -name "*.agda" | grep -v "index.agda" | sed 's/src\/\(.*\)\.agda/\1/' | sed 's/\//\./g' | sort ); do echo "import $i" >> src/index.agda; done agda-stdlib-0.14/lib.cabal000066400000000000000000000014011315545220200153360ustar00rootroot00000000000000name: lib version: 0.14 cabal-version: >= 1.10 build-type: Simple description: Helper programs. license: MIT tested-with: GHC == 7.8.4 GHC == 7.10.3 GHC == 8.0.2 GHC == 8.2.1 executable GenerateEverything hs-source-dirs: . main-is: GenerateEverything.hs default-language: Haskell2010 build-depends: base >= 4.7.0.2 && < 4.11 , filemanip >= 0.3.6.2 && < 0.4 , filepath >= 1.3.0.2 && < 1.5 executable AllNonAsciiChars hs-source-dirs: . main-is: AllNonAsciiChars.hs default-language: Haskell2010 build-depends: base >= 4.7.0.2 && < 4.11 , filemanip >= 0.3.6.2 && < 0.4 agda-stdlib-0.14/notes/000077500000000000000000000000001315545220200147405ustar00rootroot00000000000000agda-stdlib-0.14/notes/stdlib-releases.txt000066400000000000000000000026611315545220200205700ustar00rootroot00000000000000When releasing a new version of Agda standard library, the following procedure can be followed: * Update README.agda: ** Replace 'development version' by 'version X.Y' in the title. ** After the list of authors, replace -- The development version of the library often requires the latest -- development version of Agda. by -- This version of the library has been tested using Agda A.B.C. * Update the lib.cabal version to X.Y. * Ensure that the library type-checks using Agda A.B.C: make test * If necessary, copy the contents of notes/future-version.txt to CHANGELOG. Remove the contents from notes/future-version.txt * Finish the CHANGELOG. * Update the copyright year range in the LICENSE file, if necessary. * Tag version X.Y (do not forget to record the changes above first): VERSION=X.Y git tag -a v$VERSION -m "Agda standard library version $VERSION" * Removed release-specific information from README.agda. * Add a new header to CHANGELOG (do not forget to record the changes). * Push all the changes and the new tag (requires Git >= 1.8.3): git push --follow-tags * Update submodule commit for the stable library in Agda: cd agda make fast-forward-std-lib record-the-changes-and-push * Update the Agda wiki: ** The standard library page. ** News section on the main page. * Announce the release of the new version on the Agda mailing lists (users and developers). agda-stdlib-0.14/publish-listings.sh000077500000000000000000000007031315545220200174470ustar00rootroot00000000000000#!/bin/bash cd /tmp git clone git@github.com:agda/agda-stdlib.git cd agda-stdlib git checkout gh-pages git merge master -m "[auto] merge master into gh-pages" make listings if [ "`git status --porcelain`" != "" ]; then echo "Updates:" git status --porcelain changed=`git status --porcelain | cut -c4-` git add --all -- $changed git commit -m "[auto] updated html listings" git push else echo "No changes!" fi cd .. rm -rf agda-stdlib agda-stdlib-0.14/src/000077500000000000000000000000001315545220200143775ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra.agda000066400000000000000000000340211315545220200165520ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of algebraic structures like monoids and rings -- (packed in records together with sets, operations, etc.) ------------------------------------------------------------------------ module Algebra where open import Relation.Binary open import Algebra.FunctionProperties open import Algebra.Structures open import Function open import Level ------------------------------------------------------------------------ -- Semigroups, (commutative) monoids and (abelian) groups record Semigroup c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isSemigroup : IsSemigroup _≈_ _∙_ open IsSemigroup isSemigroup public setoid : Setoid _ _ setoid = record { isEquivalence = isEquivalence } -- A raw monoid is a monoid without any laws. record RawMonoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier record Monoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier isMonoid : IsMonoid _≈_ _∙_ ε open IsMonoid isMonoid public semigroup : Semigroup _ _ semigroup = record { isSemigroup = isSemigroup } open Semigroup semigroup public using (setoid) rawMonoid : RawMonoid _ _ rawMonoid = record { _≈_ = _≈_ ; _∙_ = _∙_ ; ε = ε } record CommutativeMonoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier isCommutativeMonoid : IsCommutativeMonoid _≈_ _∙_ ε open IsCommutativeMonoid isCommutativeMonoid public monoid : Monoid _ _ monoid = record { isMonoid = isMonoid } open Monoid monoid public using (setoid; semigroup; rawMonoid) record IdempotentCommutativeMonoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier isIdempotentCommutativeMonoid : IsIdempotentCommutativeMonoid _≈_ _∙_ ε open IsIdempotentCommutativeMonoid isIdempotentCommutativeMonoid public commutativeMonoid : CommutativeMonoid _ _ commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } open CommutativeMonoid commutativeMonoid public using (setoid; semigroup; rawMonoid; monoid) record Group c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 _⁻¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier _⁻¹ : Op₁ Carrier isGroup : IsGroup _≈_ _∙_ ε _⁻¹ open IsGroup isGroup public monoid : Monoid _ _ monoid = record { isMonoid = isMonoid } open Monoid monoid public using (setoid; semigroup; rawMonoid) record AbelianGroup c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 _⁻¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier _⁻¹ : Op₁ Carrier isAbelianGroup : IsAbelianGroup _≈_ _∙_ ε _⁻¹ open IsAbelianGroup isAbelianGroup public group : Group _ _ group = record { isGroup = isGroup } open Group group public using (setoid; semigroup; monoid; rawMonoid) commutativeMonoid : CommutativeMonoid _ _ commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } ------------------------------------------------------------------------ -- Various kinds of semirings record NearSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier isNearSemiring : IsNearSemiring _≈_ _+_ _*_ 0# open IsNearSemiring isNearSemiring public +-monoid : Monoid _ _ +-monoid = record { isMonoid = +-isMonoid } open Monoid +-monoid public using (setoid) renaming ( semigroup to +-semigroup ; rawMonoid to +-rawMonoid) *-semigroup : Semigroup _ _ *-semigroup = record { isSemigroup = *-isSemigroup } record SemiringWithoutOne c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier isSemiringWithoutOne : IsSemiringWithoutOne _≈_ _+_ _*_ 0# open IsSemiringWithoutOne isSemiringWithoutOne public nearSemiring : NearSemiring _ _ nearSemiring = record { isNearSemiring = isNearSemiring } open NearSemiring nearSemiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; *-semigroup ) +-commutativeMonoid : CommutativeMonoid _ _ +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } record SemiringWithoutAnnihilatingZero c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero _≈_ _+_ _*_ 0# 1# open IsSemiringWithoutAnnihilatingZero isSemiringWithoutAnnihilatingZero public +-commutativeMonoid : CommutativeMonoid _ _ +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } open CommutativeMonoid +-commutativeMonoid public using (setoid) renaming ( semigroup to +-semigroup ; rawMonoid to +-rawMonoid ; monoid to +-monoid ) *-monoid : Monoid _ _ *-monoid = record { isMonoid = *-isMonoid } open Monoid *-monoid public using () renaming ( semigroup to *-semigroup ; rawMonoid to *-rawMonoid ) record Semiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isSemiring : IsSemiring _≈_ _+_ _*_ 0# 1# open IsSemiring isSemiring public semiringWithoutAnnihilatingZero : SemiringWithoutAnnihilatingZero _ _ semiringWithoutAnnihilatingZero = record { isSemiringWithoutAnnihilatingZero = isSemiringWithoutAnnihilatingZero } open SemiringWithoutAnnihilatingZero semiringWithoutAnnihilatingZero public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid ) semiringWithoutOne : SemiringWithoutOne _ _ semiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne } open SemiringWithoutOne semiringWithoutOne public using (nearSemiring) record CommutativeSemiringWithoutOne c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne _≈_ _+_ _*_ 0# open IsCommutativeSemiringWithoutOne isCommutativeSemiringWithoutOne public semiringWithoutOne : SemiringWithoutOne _ _ semiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne } open SemiringWithoutOne semiringWithoutOne public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup ; nearSemiring ) record CommutativeSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# open IsCommutativeSemiring isCommutativeSemiring public semiring : Semiring _ _ semiring = record { isSemiring = isSemiring } open Semiring semiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ) *-commutativeMonoid : CommutativeMonoid _ _ *-commutativeMonoid = record { isCommutativeMonoid = *-isCommutativeMonoid } commutativeSemiringWithoutOne : CommutativeSemiringWithoutOne _ _ commutativeSemiringWithoutOne = record { isCommutativeSemiringWithoutOne = isCommutativeSemiringWithoutOne } ------------------------------------------------------------------------ -- (Commutative) rings -- A raw ring is a ring without any laws. record RawRing c : Set (suc c) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ field Carrier : Set c _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier record Ring c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier isRing : IsRing _≈_ _+_ _*_ -_ 0# 1# open IsRing isRing public +-abelianGroup : AbelianGroup _ _ +-abelianGroup = record { isAbelianGroup = +-isAbelianGroup } semiring : Semiring _ _ semiring = record { isSemiring = isSemiring } open Semiring semiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ) open AbelianGroup +-abelianGroup public using () renaming (group to +-group) rawRing : RawRing _ rawRing = record { _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0# ; 1# = 1# } record CommutativeRing c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ 0# 1# open IsCommutativeRing isCommutativeRing public ring : Ring _ _ ring = record { isRing = isRing } commutativeSemiring : CommutativeSemiring _ _ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open Ring ring public using (rawRing; +-group; +-abelianGroup) open CommutativeSemiring commutativeSemiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid; *-commutativeMonoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero; semiring ; commutativeSemiringWithoutOne ) ------------------------------------------------------------------------ -- (Distributive) lattices and boolean algebras record Lattice c ℓ : Set (suc (c ⊔ ℓ)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∨_ : Op₂ Carrier _∧_ : Op₂ Carrier isLattice : IsLattice _≈_ _∨_ _∧_ open IsLattice isLattice public setoid : Setoid _ _ setoid = record { isEquivalence = isEquivalence } record DistributiveLattice c ℓ : Set (suc (c ⊔ ℓ)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∨_ : Op₂ Carrier _∧_ : Op₂ Carrier isDistributiveLattice : IsDistributiveLattice _≈_ _∨_ _∧_ open IsDistributiveLattice isDistributiveLattice public lattice : Lattice _ _ lattice = record { isLattice = isLattice } open Lattice lattice public using (setoid) record BooleanAlgebra c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 ¬_ infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∨_ : Op₂ Carrier _∧_ : Op₂ Carrier ¬_ : Op₁ Carrier ⊤ : Carrier ⊥ : Carrier isBooleanAlgebra : IsBooleanAlgebra _≈_ _∨_ _∧_ ¬_ ⊤ ⊥ open IsBooleanAlgebra isBooleanAlgebra public distributiveLattice : DistributiveLattice _ _ distributiveLattice = record { isDistributiveLattice = isDistributiveLattice } open DistributiveLattice distributiveLattice public using (setoid; lattice) agda-stdlib-0.14/src/Algebra/000077500000000000000000000000001315545220200157345ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/CommutativeMonoidSolver.agda000066400000000000000000000150661315545220200234200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for equations in commutative monoids -- -- Adapted from Algebra.Monoid-solver ------------------------------------------------------------------------ open import Algebra open import Data.Fin using (Fin; zero; suc) open import Data.Maybe as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; _+_) open import Data.Nat.GeneralisedArithmetic using (fold) open import Data.Product using (_×_; proj₁; proj₂; uncurry) open import Data.Vec using (Vec; []; _∷_; lookup; replicate) open import Function using (_∘_) import Relation.Binary.EqReasoning as EqReasoning import Relation.Binary.Reflection as Reflection import Relation.Binary.Vec.Pointwise as Pointwise import Relation.Nullary.Decidable as Dec open import Relation.Binary.PropositionalEquality as P using (_≡_; decSetoid) open import Relation.Nullary using (Dec) module Algebra.CommutativeMonoidSolver {m₁ m₂} (M : CommutativeMonoid m₁ m₂) where open CommutativeMonoid M open EqReasoning setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ infixr 10 _•_ data Expr (n : ℕ) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : ℕ → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ ρ = lookup x ρ ⟦ id ⟧ ρ = ε ⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ------------------------------------------------------------------------ -- Normal forms -- A normal form is a vector of multiplicities (a bag). Normal : ℕ → Set Normal n = Vec ℕ n -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ _ = ε ⟦ n ∷ v ⟧⇓ (a ∷ ρ) = fold (⟦ v ⟧⇓ ρ) (λ b → a ∙ b) n ------------------------------------------------------------------------ -- Constructions on normal forms -- The empty bag. empty : ∀{n} → Normal n empty = replicate 0 -- A singleton bag. sg : ∀{n} (i : Fin n) → Normal n sg zero = 1 ∷ empty sg (suc i) = 0 ∷ sg i -- The composition of normal forms. _•_ : ∀{n} (v w : Normal n) → Normal n [] • [] = [] (l ∷ v) • (m ∷ w) = l + m ∷ v • w ------------------------------------------------------------------------ -- Correctness of the constructions on normal forms -- The empty bag stands for the unit ε. empty-correct : ∀{n} (ρ : Env n) → ⟦ empty ⟧⇓ ρ ≈ ε empty-correct [] = refl empty-correct (a ∷ ρ) = empty-correct ρ -- The singleton bag stands for a single variable. sg-correct : ∀{n} (x : Fin n) (ρ : Env n) → ⟦ sg x ⟧⇓ ρ ≈ lookup x ρ sg-correct zero (x ∷ ρ) = begin x ∙ ⟦ empty ⟧⇓ ρ ≈⟨ ∙-cong refl (empty-correct ρ) ⟩ x ∙ ε ≈⟨ proj₂ identity _ ⟩ x ∎ sg-correct (suc x) (m ∷ ρ) = sg-correct x ρ -- Normal form composition corresponds to the composition of the monoid. comp-correct : ∀ {n} (v w : Normal n) (ρ : Env n) → ⟦ v • w ⟧⇓ ρ ≈ (⟦ v ⟧⇓ ρ ∙ ⟦ w ⟧⇓ ρ) comp-correct [] [] ρ = sym (proj₁ identity _) comp-correct (l ∷ v) (m ∷ w) (a ∷ ρ) = lemma l m (comp-correct v w ρ) where flip12 : ∀ a b c → a ∙ (b ∙ c) ≈ b ∙ (a ∙ c) flip12 a b c = begin a ∙ (b ∙ c) ≈⟨ sym (assoc _ _ _) ⟩ (a ∙ b) ∙ c ≈⟨ ∙-cong (comm _ _) refl ⟩ (b ∙ a) ∙ c ≈⟨ assoc _ _ _ ⟩ b ∙ (a ∙ c) ∎ lemma : ∀ l m {d b c} (p : d ≈ b ∙ c) → fold d (a ∙_) (l + m) ≈ fold b (a ∙_) l ∙ fold c (a ∙_) m lemma zero zero p = p lemma zero (suc m) p = trans (∙-cong refl (lemma zero m p)) (flip12 _ _ _) lemma (suc l) m p = trans (∙-cong refl (lemma l m p)) (sym (assoc a _ _)) ------------------------------------------------------------------------ -- Normalization -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = sg x normalise id = empty normalise (e₁ ⊕ e₂) = normalise e₁ • normalise e₂ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (ρ : Env n) → ⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ normalise-correct (var x) ρ = sg-correct x ρ normalise-correct id ρ = empty-correct ρ normalise-correct (e₁ ⊕ e₂) ρ = begin ⟦ normalise e₁ • normalise e₂ ⟧⇓ ρ ≈⟨ comp-correct (normalise e₁) (normalise e₂) ρ ⟩ ⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ ≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩ ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactics" open module R = Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} (nf₁ nf₂ : Normal n) → Dec (nf₁ ≡ nf₂) nf₁ ≟ nf₂ = Dec.map Pointwise-≡ (decidable ℕ._≟_ nf₁ nf₂) where open Pointwise -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (e₁ e₂ : Expr n) → Maybe (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) prove′ e₁ e₂ = Maybe.map lemma (decToMaybe (normalise e₁ ≟ normalise e₂)) where lemma : normalise e₁ ≡ normalise e₂ → ∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ lemma eq ρ = R.prove ρ e₁ e₂ (begin ⟦ normalise e₁ ⟧⇓ ρ ≡⟨ P.cong (λ e → ⟦ e ⟧⇓ ρ) eq ⟩ ⟦ normalise e₂ ⟧⇓ ρ ∎) -- This procedure can be combined with from-just. prove : ∀ n (e₁ e₂ : Expr n) → From-just (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) (prove′ e₁ e₂) prove _ e₁ e₂ = from-just (prove′ e₁ e₂) -- prove : ∀ n (es : Expr n × Expr n) → -- From-just (∀ ρ → ⟦ proj₁ es ⟧ ρ ≈ ⟦ proj₂ es ⟧ ρ) -- (uncurry prove′ es) -- prove _ = from-just ∘ uncurry prove′ agda-stdlib-0.14/src/Algebra/CommutativeMonoidSolver/000077500000000000000000000000001315545220200225725ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/CommutativeMonoidSolver/Example.agda000066400000000000000000000033151315545220200250050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how Algebra.CommutativeMonoidSolver can be used ------------------------------------------------------------------------ module Algebra.CommutativeMonoidSolver.Example where open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong₂; isEquivalence) open import Data.Bool.Base using (Bool; true; false; if_then_else_; not; _∧_; _∨_) open import Data.Bool.Properties using (isBooleanAlgebra) open import Data.Fin using (zero; suc) open import Data.Vec using ([]; _∷_) open import Algebra open import Algebra.Structures using (module IsBooleanAlgebra; module IsDistributiveLattice; module IsLattice) open IsBooleanAlgebra isBooleanAlgebra using (∧-comm; ∧-assoc; ∨-comm; ∨-assoc; ∨-∧-distribʳ; isDistributiveLattice; isLattice) open import Algebra.Properties.DistributiveLattice (record { isDistributiveLattice = isDistributiveLattice }) ∨-cm : CommutativeMonoid _ _ ∨-cm = record { Carrier = Bool ; _≈_ = _≡_ ; _∙_ = _∨_ ; ε = false ; isCommutativeMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∨-assoc ; ∙-cong = cong₂ _∨_ } ; identityˡ = λ x → refl ; comm = ∨-comm } } open import Algebra.CommutativeMonoidSolver ∨-cm test : ∀ x y z → (x ∨ y) ∨ (x ∨ z) ≡ (z ∨ y) ∨ (x ∨ x) test a b c = let _∨_ = _⊕_ in prove 3 ((x ∨ y) ∨ (x ∨ z)) ((z ∨ y) ∨ (x ∨ x)) (a ∷ b ∷ c ∷ []) where x = var zero y = var (suc zero) z = var (suc (suc zero)) agda-stdlib-0.14/src/Algebra/FunctionProperties.agda000066400000000000000000000065521315545220200224240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of functions, such as associativity and commutativity ------------------------------------------------------------------------ -- These properties can (for instance) be used to define algebraic -- structures. open import Level open import Relation.Binary open import Data.Sum -- The properties are specified using the following relation as -- "equality". module Algebra.FunctionProperties {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) where open import Data.Product ------------------------------------------------------------------------ -- Unary and binary operations open import Algebra.FunctionProperties.Core public ------------------------------------------------------------------------ -- Properties of operations Associative : Op₂ A → Set _ Associative _∙_ = ∀ x y z → ((x ∙ y) ∙ z) ≈ (x ∙ (y ∙ z)) Commutative : Op₂ A → Set _ Commutative _∙_ = ∀ x y → (x ∙ y) ≈ (y ∙ x) LeftIdentity : A → Op₂ A → Set _ LeftIdentity e _∙_ = ∀ x → (e ∙ x) ≈ x RightIdentity : A → Op₂ A → Set _ RightIdentity e _∙_ = ∀ x → (x ∙ e) ≈ x Identity : A → Op₂ A → Set _ Identity e ∙ = LeftIdentity e ∙ × RightIdentity e ∙ LeftZero : A → Op₂ A → Set _ LeftZero z _∙_ = ∀ x → (z ∙ x) ≈ z RightZero : A → Op₂ A → Set _ RightZero z _∙_ = ∀ x → (x ∙ z) ≈ z Zero : A → Op₂ A → Set _ Zero z ∙ = LeftZero z ∙ × RightZero z ∙ LeftInverse : A → Op₁ A → Op₂ A → Set _ LeftInverse e _⁻¹ _∙_ = ∀ x → ((x ⁻¹) ∙ x) ≈ e RightInverse : A → Op₁ A → Op₂ A → Set _ RightInverse e _⁻¹ _∙_ = ∀ x → (x ∙ (x ⁻¹)) ≈ e Inverse : A → Op₁ A → Op₂ A → Set _ Inverse e ⁻¹ ∙ = LeftInverse e ⁻¹ ∙ × RightInverse e ⁻¹ ∙ _DistributesOverˡ_ : Op₂ A → Op₂ A → Set _ _*_ DistributesOverˡ _+_ = ∀ x y z → (x * (y + z)) ≈ ((x * y) + (x * z)) _DistributesOverʳ_ : Op₂ A → Op₂ A → Set _ _*_ DistributesOverʳ _+_ = ∀ x y z → ((y + z) * x) ≈ ((y * x) + (z * x)) _DistributesOver_ : Op₂ A → Op₂ A → Set _ * DistributesOver + = (* DistributesOverˡ +) × (* DistributesOverʳ +) _IdempotentOn_ : Op₂ A → A → Set _ _∙_ IdempotentOn x = (x ∙ x) ≈ x Idempotent : Op₂ A → Set _ Idempotent ∙ = ∀ x → ∙ IdempotentOn x IdempotentFun : Op₁ A → Set _ IdempotentFun f = ∀ x → f (f x) ≈ f x Selective : Op₂ A → Set _ Selective _∙_ = ∀ x y → (x ∙ y) ≈ x ⊎ (x ∙ y) ≈ y _Absorbs_ : Op₂ A → Op₂ A → Set _ _∙_ Absorbs _∘_ = ∀ x y → (x ∙ (x ∘ y)) ≈ x Absorptive : Op₂ A → Op₂ A → Set _ Absorptive ∙ ∘ = (∙ Absorbs ∘) × (∘ Absorbs ∙) Involutive : Op₁ A → Set _ Involutive f = ∀ x → f (f x) ≈ x LeftCancellative : Op₂ A → Set _ LeftCancellative _•_ = ∀ x {y z} → (x • y) ≈ (x • z) → y ≈ z RightCancellative : Op₂ A → Set _ RightCancellative _•_ = ∀ {x} y z → (y • x) ≈ (z • x) → y ≈ z Cancellative : Op₂ A → Set _ Cancellative _•_ = LeftCancellative _•_ × RightCancellative _•_ Congruent₁ : Op₁ A → Set _ Congruent₁ f = f Preserves _≈_ ⟶ _≈_ Congruent₂ : Op₂ A → Set _ Congruent₂ ∙ = ∙ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_ agda-stdlib-0.14/src/Algebra/FunctionProperties/000077500000000000000000000000001315545220200215765ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/FunctionProperties/Consequences.agda000066400000000000000000000105451315545220200250540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Relations between properties of functions, such as associativity and -- commutativity ------------------------------------------------------------------------ open import Relation.Binary using (Setoid) module Algebra.FunctionProperties.Consequences {a ℓ} (S : Setoid a ℓ) where open Setoid S open import Algebra.FunctionProperties _≈_ open import Relation.Binary.EqReasoning S open import Data.Sum using (inj₁; inj₂) ------------------------------------------------------------------------ -- Transposing identity elements comm+idˡ⇒idʳ : ∀ {_•_} → Commutative _•_ → ∀ {e} → LeftIdentity e _•_ → RightIdentity e _•_ comm+idˡ⇒idʳ {_•_} comm {e} idˡ x = begin x • e ≈⟨ comm x e ⟩ e • x ≈⟨ idˡ x ⟩ x ∎ comm+idʳ⇒idˡ : ∀ {_•_} → Commutative _•_ → ∀ {e} → RightIdentity e _•_ → LeftIdentity e _•_ comm+idʳ⇒idˡ {_•_} comm {e} idʳ x = begin e • x ≈⟨ comm e x ⟩ x • e ≈⟨ idʳ x ⟩ x ∎ ------------------------------------------------------------------------ -- Transposing zero elements comm+zeˡ⇒zeʳ : ∀ {_•_} → Commutative _•_ → ∀ {e} → LeftZero e _•_ → RightZero e _•_ comm+zeˡ⇒zeʳ {_•_} comm {e} zeˡ x = begin x • e ≈⟨ comm x e ⟩ e • x ≈⟨ zeˡ x ⟩ e ∎ comm+zeʳ⇒zeˡ : ∀ {_•_} → Commutative _•_ → ∀ {e} → RightZero e _•_ → LeftZero e _•_ comm+zeʳ⇒zeˡ {_•_} comm {e} zeʳ x = begin e • x ≈⟨ comm e x ⟩ x • e ≈⟨ zeʳ x ⟩ e ∎ ------------------------------------------------------------------------ -- Transposing inverse elements comm+invˡ⇒invʳ : ∀ {e _⁻¹ _•_} → Commutative _•_ → LeftInverse e _⁻¹ _•_ → RightInverse e _⁻¹ _•_ comm+invˡ⇒invʳ {e} {_⁻¹} {_•_} comm invˡ x = begin x • (x ⁻¹) ≈⟨ comm x (x ⁻¹) ⟩ (x ⁻¹) • x ≈⟨ invˡ x ⟩ e ∎ comm+invʳ⇒invˡ : ∀ {e _⁻¹ _•_} → Commutative _•_ → RightInverse e _⁻¹ _•_ → LeftInverse e _⁻¹ _•_ comm+invʳ⇒invˡ {e} {_⁻¹} {_•_} comm invʳ x = begin (x ⁻¹) • x ≈⟨ comm (x ⁻¹) x ⟩ x • (x ⁻¹) ≈⟨ invʳ x ⟩ e ∎ ------------------------------------------------------------------------ -- Transposing distributivity comm+distrˡ⇒distrʳ : ∀ {_•_ _◦_} → Congruent₂ _◦_ → Commutative _•_ → _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ comm+distrˡ⇒distrʳ {_•_} {_◦_} cong comm distrˡ x y z = begin (y ◦ z) • x ≈⟨ comm (y ◦ z) x ⟩ x • (y ◦ z) ≈⟨ distrˡ x y z ⟩ (x • y) ◦ (x • z) ≈⟨ cong (comm x y) (comm x z) ⟩ (y • x) ◦ (z • x) ∎ comm+distrʳ⇒distrˡ : ∀ {_•_ _◦_} → Congruent₂ _◦_ → Commutative _•_ → _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ comm+distrʳ⇒distrˡ {_•_} {_◦_} cong comm distrˡ x y z = begin x • (y ◦ z) ≈⟨ comm x (y ◦ z) ⟩ (y ◦ z) • x ≈⟨ distrˡ x y z ⟩ (y • x) ◦ (z • x) ≈⟨ cong (comm y x) (comm z x) ⟩ (x • y) ◦ (x • z) ∎ ------------------------------------------------------------------------ -- Transposing cancellativity comm+cancelˡ⇒cancelʳ : ∀ {_•_} → Commutative _•_ → LeftCancellative _•_ → RightCancellative _•_ comm+cancelˡ⇒cancelʳ {_•_} comm cancelˡ {x} y z eq = cancelˡ x (begin x • y ≈⟨ comm x y ⟩ y • x ≈⟨ eq ⟩ z • x ≈⟨ comm z x ⟩ x • z ∎) comm+cancelʳ⇒cancelˡ : ∀ {_•_} → Commutative _•_ → RightCancellative _•_ → LeftCancellative _•_ comm+cancelʳ⇒cancelˡ {_•_} comm cancelʳ x {y} {z} eq = cancelʳ y z (begin y • x ≈⟨ comm y x ⟩ x • y ≈⟨ eq ⟩ x • z ≈⟨ comm x z ⟩ z • x ∎) ------------------------------------------------------------------------ -- Selectivity implies idempotence sel⇒idem : ∀ {_•_} → Selective _•_ → Idempotent _•_ sel⇒idem sel x with sel x x ... | inj₁ x•x≈x = x•x≈x ... | inj₂ x•x≈x = x•x≈x agda-stdlib-0.14/src/Algebra/FunctionProperties/Core.agda000066400000000000000000000014361315545220200233100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of functions, such as associativity and commutativity ------------------------------------------------------------------------ -- This file contains some core definitions which are reexported by -- Algebra.FunctionProperties. They are placed here because -- Algebra.FunctionProperties is a parameterised module, and some of -- the parameters are irrelevant for these definitions. module Algebra.FunctionProperties.Core where open import Level ------------------------------------------------------------------------ -- Unary and binary operations Op₁ : ∀ {ℓ} → Set ℓ → Set ℓ Op₁ A = A → A Op₂ : ∀ {ℓ} → Set ℓ → Set ℓ Op₂ A = A → A → A agda-stdlib-0.14/src/Algebra/IdempotentCommutativeMonoidSolver.agda000066400000000000000000000162141315545220200254450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for equations in commutative monoids -- -- Adapted from Algebra.Monoid-solver ------------------------------------------------------------------------ open import Algebra open import Data.Bool.Base as Bool using (Bool; true; false; if_then_else_; _∨_) open import Data.Fin using (Fin; zero; suc) open import Data.Maybe as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; _+_) open import Data.Product using (_×_; proj₁; proj₂; uncurry) open import Data.Vec using (Vec; []; _∷_; lookup; replicate) open import Function using (_∘_) import Relation.Binary.EqReasoning as EqReasoning import Relation.Binary.Reflection as Reflection import Relation.Binary.Vec.Pointwise as Pointwise import Relation.Nullary.Decidable as Dec open import Relation.Binary.PropositionalEquality as P using (_≡_; decSetoid) open import Relation.Nullary using (Dec) module Algebra.IdempotentCommutativeMonoidSolver {m₁ m₂} (M : IdempotentCommutativeMonoid m₁ m₂) where open IdempotentCommutativeMonoid M open EqReasoning setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ infixr 10 _•_ data Expr (n : ℕ) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : ℕ → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ ρ = lookup x ρ ⟦ id ⟧ ρ = ε ⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ------------------------------------------------------------------------ -- Normal forms -- A normal form is a vector of bits (a set). Normal : ℕ → Set Normal n = Vec Bool n -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ _ = ε ⟦ b ∷ v ⟧⇓ (a ∷ ρ) = if b then a ∙ (⟦ v ⟧⇓ ρ) else (⟦ v ⟧⇓ ρ) ------------------------------------------------------------------------ -- Constructions on normal forms -- The empty bag. empty : ∀{n} → Normal n empty = replicate false -- A singleton bag. sg : ∀{n} (i : Fin n) → Normal n sg zero = true ∷ empty sg (suc i) = false ∷ sg i -- The composition of normal forms. _•_ : ∀{n} (v w : Normal n) → Normal n [] • [] = [] (l ∷ v) • (m ∷ w) = (l ∨ m) ∷ v • w ------------------------------------------------------------------------ -- Correctness of the constructions on normal forms -- The empty bag stands for the unit ε. empty-correct : ∀{n} (ρ : Env n) → ⟦ empty ⟧⇓ ρ ≈ ε empty-correct [] = refl empty-correct (a ∷ ρ) = empty-correct ρ -- The singleton bag stands for a single variable. sg-correct : ∀{n} (x : Fin n) (ρ : Env n) → ⟦ sg x ⟧⇓ ρ ≈ lookup x ρ sg-correct zero (x ∷ ρ) = begin x ∙ ⟦ empty ⟧⇓ ρ ≈⟨ ∙-cong refl (empty-correct ρ) ⟩ x ∙ ε ≈⟨ proj₂ identity _ ⟩ x ∎ sg-correct (suc x) (m ∷ ρ) = sg-correct x ρ -- Normal form composition corresponds to the composition of the monoid. flip12 : ∀ a b c → a ∙ (b ∙ c) ≈ b ∙ (a ∙ c) flip12 a b c = begin a ∙ (b ∙ c) ≈⟨ sym (assoc _ _ _) ⟩ (a ∙ b) ∙ c ≈⟨ ∙-cong (comm _ _) refl ⟩ (b ∙ a) ∙ c ≈⟨ assoc _ _ _ ⟩ b ∙ (a ∙ c) ∎ distr : ∀ a b c → a ∙ (b ∙ c) ≈ (a ∙ b) ∙ (a ∙ c) distr a b c = begin a ∙ (b ∙ c) ≈⟨ ∙-cong (sym (idem a)) refl ⟩ (a ∙ a) ∙ (b ∙ c) ≈⟨ assoc _ _ _ ⟩ a ∙ (a ∙ (b ∙ c)) ≈⟨ ∙-cong refl (sym (assoc _ _ _)) ⟩ a ∙ ((a ∙ b) ∙ c) ≈⟨ ∙-cong refl (∙-cong (comm _ _) refl) ⟩ a ∙ ((b ∙ a) ∙ c) ≈⟨ ∙-cong refl (assoc _ _ _) ⟩ a ∙ (b ∙ (a ∙ c)) ≈⟨ sym (assoc _ _ _) ⟩ (a ∙ b) ∙ (a ∙ c) ∎ comp-correct : ∀ {n} (v w : Normal n) (ρ : Env n) → ⟦ v • w ⟧⇓ ρ ≈ (⟦ v ⟧⇓ ρ ∙ ⟦ w ⟧⇓ ρ) comp-correct [] [] ρ = sym (proj₁ identity _) comp-correct (true ∷ v) (true ∷ w) (a ∷ ρ) = trans (∙-cong refl (comp-correct v w ρ)) (distr _ _ _) comp-correct (true ∷ v) (false ∷ w) (a ∷ ρ) = trans (∙-cong refl (comp-correct v w ρ)) (sym (assoc _ _ _)) comp-correct (false ∷ v) (true ∷ w) (a ∷ ρ) = trans (∙-cong refl (comp-correct v w ρ)) (flip12 _ _ _) comp-correct (false ∷ v) (false ∷ w) (a ∷ ρ) = comp-correct v w ρ ------------------------------------------------------------------------ -- Normalization -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = sg x normalise id = empty normalise (e₁ ⊕ e₂) = normalise e₁ • normalise e₂ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (ρ : Env n) → ⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ normalise-correct (var x) ρ = sg-correct x ρ normalise-correct id ρ = empty-correct ρ normalise-correct (e₁ ⊕ e₂) ρ = begin ⟦ normalise e₁ • normalise e₂ ⟧⇓ ρ ≈⟨ comp-correct (normalise e₁) (normalise e₂) ρ ⟩ ⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ ≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩ ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactics" open module R = Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} (nf₁ nf₂ : Normal n) → Dec (nf₁ ≡ nf₂) nf₁ ≟ nf₂ = Dec.map Pointwise-≡ (decidable Bool._≟_ nf₁ nf₂) where open Pointwise -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (e₁ e₂ : Expr n) → Maybe (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) prove′ e₁ e₂ = Maybe.map lemma (decToMaybe (normalise e₁ ≟ normalise e₂)) where lemma : normalise e₁ ≡ normalise e₂ → ∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ lemma eq ρ = R.prove ρ e₁ e₂ (begin ⟦ normalise e₁ ⟧⇓ ρ ≡⟨ P.cong (λ e → ⟦ e ⟧⇓ ρ) eq ⟩ ⟦ normalise e₂ ⟧⇓ ρ ∎) -- This procedure can be combined with from-just. prove : ∀ n (e₁ e₂ : Expr n) → From-just (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) (prove′ e₁ e₂) prove _ e₁ e₂ = from-just (prove′ e₁ e₂) -- prove : ∀ n (es : Expr n × Expr n) → -- From-just (∀ ρ → ⟦ proj₁ es ⟧ ρ ≈ ⟦ proj₂ es ⟧ ρ) -- (uncurry prove′ es) -- prove _ = from-just ∘ uncurry prove′ -- -} agda-stdlib-0.14/src/Algebra/IdempotentCommutativeMonoidSolver/000077500000000000000000000000001315545220200246235ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/IdempotentCommutativeMonoidSolver/Example.agda000066400000000000000000000035231315545220200270370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how Algebra.IdempotentCommutativeMonoidSolver can be -- used ------------------------------------------------------------------------ module Algebra.IdempotentCommutativeMonoidSolver.Example where open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong₂; isEquivalence) open import Data.Bool.Base using (Bool; true; false; if_then_else_; not; _∧_; _∨_) open import Data.Bool.Properties using (isBooleanAlgebra) open import Data.Fin using (zero; suc) open import Data.Vec using ([]; _∷_) open import Algebra open import Algebra.Structures using (module IsBooleanAlgebra; module IsDistributiveLattice; module IsLattice) open IsBooleanAlgebra isBooleanAlgebra using (∧-comm; ∧-assoc; ∨-comm; ∨-assoc; ∨-∧-distribʳ; isDistributiveLattice; isLattice) open import Algebra.Properties.DistributiveLattice (record { isDistributiveLattice = isDistributiveLattice }) ∨-icm : IdempotentCommutativeMonoid _ _ ∨-icm = record { Carrier = Bool ; _≈_ = _≡_ ; _∙_ = _∨_ ; ε = false ; isIdempotentCommutativeMonoid = record { isCommutativeMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∨-assoc ; ∙-cong = cong₂ _∨_ } ; identityˡ = λ x → refl ; comm = ∨-comm } ; idem = ∨-idempotent } } open import Algebra.IdempotentCommutativeMonoidSolver ∨-icm test : ∀ x y z → (x ∨ y) ∨ (x ∨ z) ≡ (z ∨ y) ∨ x test a b c = let _∨_ = _⊕_ in prove 3 ((x ∨ y) ∨ (x ∨ z)) ((z ∨ y) ∨ x) (a ∷ b ∷ c ∷ []) where x = var zero y = var (suc zero) z = var (suc (suc zero)) agda-stdlib-0.14/src/Algebra/Monoid-solver.agda000066400000000000000000000113721315545220200213130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for monoid equalities ------------------------------------------------------------------------ open import Algebra module Algebra.Monoid-solver {m₁ m₂} (M : Monoid m₁ m₂) where open import Data.Fin import Data.Fin.Properties as Fin open import Data.List.Base open import Data.Maybe as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat.Base using (ℕ) open import Data.Product open import Data.Vec using (Vec; lookup) open import Function using (_∘_; _$_) import Relation.Binary.EqReasoning import Relation.Binary.List.Pointwise as Pointwise open import Relation.Binary.PropositionalEquality as P using (_≡_) import Relation.Binary.Reflection open import Relation.Nullary import Relation.Nullary.Decidable as Dec open Monoid M open Relation.Binary.EqReasoning setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ data Expr (n : ℕ) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : ℕ → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ ρ = lookup x ρ ⟦ id ⟧ ρ = ε ⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ------------------------------------------------------------------------ -- Normal forms -- A normal form is a list of variables. Normal : ℕ → Set Normal n = List (Fin n) -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ ρ = ε ⟦ x ∷ nf ⟧⇓ ρ = lookup x ρ ∙ ⟦ nf ⟧⇓ ρ -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = x ∷ [] normalise id = [] normalise (e₁ ⊕ e₂) = normalise e₁ ++ normalise e₂ -- The normaliser is homomorphic with respect to _++_/_∙_. homomorphic : ∀ {n} (nf₁ nf₂ : Normal n) (ρ : Env n) → ⟦ nf₁ ++ nf₂ ⟧⇓ ρ ≈ (⟦ nf₁ ⟧⇓ ρ ∙ ⟦ nf₂ ⟧⇓ ρ) homomorphic [] nf₂ ρ = begin ⟦ nf₂ ⟧⇓ ρ ≈⟨ sym $ proj₁ identity _ ⟩ ε ∙ ⟦ nf₂ ⟧⇓ ρ ∎ homomorphic (x ∷ nf₁) nf₂ ρ = begin lookup x ρ ∙ ⟦ nf₁ ++ nf₂ ⟧⇓ ρ ≈⟨ ∙-cong refl (homomorphic nf₁ nf₂ ρ) ⟩ lookup x ρ ∙ (⟦ nf₁ ⟧⇓ ρ ∙ ⟦ nf₂ ⟧⇓ ρ) ≈⟨ sym $ assoc _ _ _ ⟩ lookup x ρ ∙ ⟦ nf₁ ⟧⇓ ρ ∙ ⟦ nf₂ ⟧⇓ ρ ∎ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (ρ : Env n) → ⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ normalise-correct (var x) ρ = begin lookup x ρ ∙ ε ≈⟨ proj₂ identity _ ⟩ lookup x ρ ∎ normalise-correct id ρ = begin ε ∎ normalise-correct (e₁ ⊕ e₂) ρ = begin ⟦ normalise e₁ ++ normalise e₂ ⟧⇓ ρ ≈⟨ homomorphic (normalise e₁) (normalise e₂) ρ ⟩ ⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ ≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩ ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactics" open module R = Relation.Binary.Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} (nf₁ nf₂ : Normal n) → Dec (nf₁ ≡ nf₂) nf₁ ≟ nf₂ = Dec.map′ Rel≡⇒≡ ≡⇒Rel≡ (decidable Fin._≟_ nf₁ nf₂) where open Pointwise -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (e₁ e₂ : Expr n) → Maybe (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) prove′ e₁ e₂ = Maybe.map lemma $ decToMaybe (normalise e₁ ≟ normalise e₂) where lemma : normalise e₁ ≡ normalise e₂ → ∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ lemma eq ρ = R.prove ρ e₁ e₂ (begin ⟦ normalise e₁ ⟧⇓ ρ ≡⟨ P.cong (λ e → ⟦ e ⟧⇓ ρ) eq ⟩ ⟦ normalise e₂ ⟧⇓ ρ ∎) -- This procedure can be combined with from-just. prove : ∀ n (es : Expr n × Expr n) → From-just (∀ ρ → ⟦ proj₁ es ⟧ ρ ≈ ⟦ proj₂ es ⟧ ρ) (uncurry prove′ es) prove _ = from-just ∘ uncurry prove′ agda-stdlib-0.14/src/Algebra/Morphism.agda000066400000000000000000000047671315545220200203660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Morphisms between algebraic structures ------------------------------------------------------------------------ module Algebra.Morphism where open import Relation.Binary open import Algebra open import Algebra.FunctionProperties import Algebra.Properties.Group as GroupP open import Function open import Data.Product open import Level import Relation.Binary.EqReasoning as EqR ------------------------------------------------------------------------ -- Basic definitions module Definitions {f t ℓ} (From : Set f) (To : Set t) (_≈_ : Rel To ℓ) where Morphism : Set _ Morphism = From → To Homomorphic₀ : Morphism → From → To → Set _ Homomorphic₀ ⟦_⟧ ∙ ∘ = ⟦ ∙ ⟧ ≈ ∘ Homomorphic₁ : Morphism → Fun₁ From → Op₁ To → Set _ Homomorphic₁ ⟦_⟧ ∙_ ∘_ = ∀ x → ⟦ ∙ x ⟧ ≈ (∘ ⟦ x ⟧) Homomorphic₂ : Morphism → Fun₂ From → Op₂ To → Set _ Homomorphic₂ ⟦_⟧ _∙_ _∘_ = ∀ x y → ⟦ x ∙ y ⟧ ≈ (⟦ x ⟧ ∘ ⟦ y ⟧) ------------------------------------------------------------------------ -- An example showing how a morphism type can be defined -- Ring homomorphisms. record _-Ring⟶_ {r₁ r₂ r₃ r₄} (From : Ring r₁ r₂) (To : Ring r₃ r₄) : Set (r₁ ⊔ r₂ ⊔ r₃ ⊔ r₄) where private module F = Ring From module T = Ring To open Definitions F.Carrier T.Carrier T._≈_ field ⟦_⟧ : Morphism ⟦⟧-cong : ⟦_⟧ Preserves F._≈_ ⟶ T._≈_ +-homo : Homomorphic₂ ⟦_⟧ F._+_ T._+_ *-homo : Homomorphic₂ ⟦_⟧ F._*_ T._*_ 1-homo : Homomorphic₀ ⟦_⟧ F.1# T.1# open EqR T.setoid 0-homo : Homomorphic₀ ⟦_⟧ F.0# T.0# 0-homo = GroupP.left-identity-unique T.+-group ⟦ F.0# ⟧ ⟦ F.0# ⟧ (begin T._+_ ⟦ F.0# ⟧ ⟦ F.0# ⟧ ≈⟨ T.sym (+-homo F.0# F.0#) ⟩ ⟦ F._+_ F.0# F.0# ⟧ ≈⟨ ⟦⟧-cong (proj₁ F.+-identity F.0#) ⟩ ⟦ F.0# ⟧ ∎) -‿homo : Homomorphic₁ ⟦_⟧ (F.-_) (T.-_) -‿homo x = GroupP.left-inverse-unique T.+-group ⟦ F.-_ x ⟧ ⟦ x ⟧ (begin T._+_ ⟦ F.-_ x ⟧ ⟦ x ⟧ ≈⟨ T.sym (+-homo (F.-_ x) x) ⟩ ⟦ F._+_ (F.-_ x) x ⟧ ≈⟨ ⟦⟧-cong (proj₁ F.-‿inverse x) ⟩ ⟦ F.0# ⟧ ≈⟨ 0-homo ⟩ T.0# ∎) agda-stdlib-0.14/src/Algebra/Operations.agda000066400000000000000000000116011315545220200206740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some defined operations (multiplication by natural number and -- exponentiation) ------------------------------------------------------------------------ open import Algebra module Algebra.Operations {s₁ s₂} (S : Semiring s₁ s₂) where open Semiring S renaming (zero to *-zero) open import Data.Nat.Base using (zero; suc; ℕ) renaming (_+_ to _ℕ+_; _*_ to _ℕ*_) open import Data.Product using (module Σ) open import Function open import Relation.Binary open import Relation.Binary.PropositionalEquality as PropEq using (_≡_) import Relation.Binary.EqReasoning as EqR open EqR setoid ------------------------------------------------------------------------ -- Operations -- Multiplication by natural number. infixr 7 _×_ _×′_ _×_ : ℕ → Carrier → Carrier 0 × x = 0# suc n × x = x + n × x -- A variant that includes a "redundant" case which ensures that 1 × y -- is definitionally equal to y. _×′_ : ℕ → Carrier → Carrier 0 ×′ x = 0# 1 ×′ x = x suc n ×′ x = x + n ×′ x -- Exponentiation. infixr 8 _^_ _^_ : Carrier → ℕ → Carrier x ^ zero = 1# x ^ suc n = x * x ^ n ------------------------------------------------------------------------ -- Some properties -- Unfolding lemma for _×′_. 1+×′ : ∀ n x → suc n ×′ x ≈ x + n ×′ x 1+×′ 0 x = begin x ≈⟨ sym $ Σ.proj₂ +-identity x ⟩ x + 0# ∎ 1+×′ (suc n) x = begin x + suc n ×′ x ≡⟨⟩ x + suc n ×′ x ∎ -- _×_ and _×′_ are extensionally equal (up to the setoid -- equivalence). ×≈×′ : ∀ n x → n × x ≈ n ×′ x ×≈×′ 0 x = begin 0# ∎ ×≈×′ (suc n) x = begin x + n × x ≈⟨ +-cong refl (×≈×′ n x) ⟩ x + n ×′ x ≈⟨ sym $ 1+×′ n x ⟩ suc n ×′ x ∎ -- _×_ is homomorphic with respect to _ℕ+_/_+_. ×-homo-+ : ∀ c m n → (m ℕ+ n) × c ≈ m × c + n × c ×-homo-+ c 0 n = begin n × c ≈⟨ sym $ Σ.proj₁ +-identity (n × c) ⟩ 0# + n × c ∎ ×-homo-+ c (suc m) n = begin c + (m ℕ+ n) × c ≈⟨ +-cong refl (×-homo-+ c m n) ⟩ c + (m × c + n × c) ≈⟨ sym $ +-assoc c (m × c) (n × c) ⟩ c + m × c + n × c ∎ -- _×′_ is homomorphic with respect to _ℕ+_/_+_. ×′-homo-+ : ∀ c m n → (m ℕ+ n) ×′ c ≈ m ×′ c + n ×′ c ×′-homo-+ c m n = begin (m ℕ+ n) ×′ c ≈⟨ sym $ ×≈×′ (m ℕ+ n) c ⟩ (m ℕ+ n) × c ≈⟨ ×-homo-+ c m n ⟩ m × c + n × c ≈⟨ +-cong (×≈×′ m c) (×≈×′ n c) ⟩ m ×′ c + n ×′ c ∎ -- _× 1# is homomorphic with respect to _ℕ*_/_*_. ×1-homo-* : ∀ m n → (m ℕ* n) × 1# ≈ (m × 1#) * (n × 1#) ×1-homo-* 0 n = begin 0# ≈⟨ sym $ Σ.proj₁ *-zero (n × 1#) ⟩ 0# * (n × 1#) ∎ ×1-homo-* (suc m) n = begin (n ℕ+ m ℕ* n) × 1# ≈⟨ ×-homo-+ 1# n (m ℕ* n) ⟩ n × 1# + (m ℕ* n) × 1# ≈⟨ +-cong refl (×1-homo-* m n) ⟩ n × 1# + (m × 1#) * (n × 1#) ≈⟨ sym $ +-cong (Σ.proj₁ *-identity (n × 1#)) refl ⟩ 1# * (n × 1#) + (m × 1#) * (n × 1#) ≈⟨ sym $ Σ.proj₂ distrib (n × 1#) 1# (m × 1#) ⟩ (1# + m × 1#) * (n × 1#) ∎ -- _×′ 1# is homomorphic with respect to _ℕ*_/_*_. ×′1-homo-* : ∀ m n → (m ℕ* n) ×′ 1# ≈ (m ×′ 1#) * (n ×′ 1#) ×′1-homo-* m n = begin (m ℕ* n) ×′ 1# ≈⟨ sym $ ×≈×′ (m ℕ* n) 1# ⟩ (m ℕ* n) × 1# ≈⟨ ×1-homo-* m n ⟩ (m × 1#) * (n × 1#) ≈⟨ *-cong (×≈×′ m 1#) (×≈×′ n 1#) ⟩ (m ×′ 1#) * (n ×′ 1#) ∎ -- _×_ preserves equality. ×-cong : _×_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_ ×-cong {n} {n′} {x} {x′} n≡n′ x≈x′ = begin n × x ≈⟨ reflexive $ PropEq.cong (λ n → n × x) n≡n′ ⟩ n′ × x ≈⟨ ×-congʳ n′ x≈x′ ⟩ n′ × x′ ∎ where ×-congʳ : ∀ n → (_×_ n) Preserves _≈_ ⟶ _≈_ ×-congʳ 0 x≈x′ = refl ×-congʳ (suc n) x≈x′ = x≈x′ ⟨ +-cong ⟩ ×-congʳ n x≈x′ -- _×′_ preserves equality. ×′-cong : _×′_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_ ×′-cong {n} {n′} {x} {x′} n≡n′ x≈x′ = begin n ×′ x ≈⟨ sym $ ×≈×′ n x ⟩ n × x ≈⟨ ×-cong n≡n′ x≈x′ ⟩ n′ × x′ ≈⟨ ×≈×′ n′ x′ ⟩ n′ ×′ x′ ∎ -- _^_ preserves equality. ^-cong : _^_ Preserves₂ _≈_ ⟶ _≡_ ⟶ _≈_ ^-cong {x} {x'} {n} {n'} x≈x' n≡n' = begin x ^ n ≈⟨ reflexive $ PropEq.cong (_^_ x) n≡n' ⟩ x ^ n' ≈⟨ ^-congˡ n' x≈x' ⟩ x' ^ n' ∎ where ^-congˡ : ∀ n → (λ x → x ^ n) Preserves _≈_ ⟶ _≈_ ^-congˡ zero x≈x' = refl ^-congˡ (suc n) x≈x' = x≈x' ⟨ *-cong ⟩ ^-congˡ n x≈x' agda-stdlib-0.14/src/Algebra/Properties/000077500000000000000000000000001315545220200200705ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/Properties/AbelianGroup.agda000066400000000000000000000032601315545220200232570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.AbelianGroup {g₁ g₂} (G : AbelianGroup g₁ g₂) where import Algebra.Properties.Group as GP open import Data.Product open import Function import Relation.Binary.EqReasoning as EqR open AbelianGroup G open EqR setoid open GP group public private lemma : ∀ x y → x ∙ y ∙ x ⁻¹ ≈ y lemma x y = begin x ∙ y ∙ x ⁻¹ ≈⟨ comm _ _ ⟨ ∙-cong ⟩ refl ⟩ y ∙ x ∙ x ⁻¹ ≈⟨ assoc _ _ _ ⟩ y ∙ (x ∙ x ⁻¹) ≈⟨ refl ⟨ ∙-cong ⟩ proj₂ inverse _ ⟩ y ∙ ε ≈⟨ proj₂ identity _ ⟩ y ∎ ⁻¹-∙-comm : ∀ x y → x ⁻¹ ∙ y ⁻¹ ≈ (x ∙ y) ⁻¹ ⁻¹-∙-comm x y = begin x ⁻¹ ∙ y ⁻¹ ≈⟨ comm _ _ ⟩ y ⁻¹ ∙ x ⁻¹ ≈⟨ sym $ lem ⟨ ∙-cong ⟩ refl ⟩ x ∙ (y ∙ (x ∙ y) ⁻¹ ∙ y ⁻¹) ∙ x ⁻¹ ≈⟨ lemma _ _ ⟩ y ∙ (x ∙ y) ⁻¹ ∙ y ⁻¹ ≈⟨ lemma _ _ ⟩ (x ∙ y) ⁻¹ ∎ where lem = begin x ∙ (y ∙ (x ∙ y) ⁻¹ ∙ y ⁻¹) ≈⟨ sym $ assoc _ _ _ ⟩ x ∙ (y ∙ (x ∙ y) ⁻¹) ∙ y ⁻¹ ≈⟨ sym $ assoc _ _ _ ⟨ ∙-cong ⟩ refl ⟩ x ∙ y ∙ (x ∙ y) ⁻¹ ∙ y ⁻¹ ≈⟨ proj₂ inverse _ ⟨ ∙-cong ⟩ refl ⟩ ε ∙ y ⁻¹ ≈⟨ proj₁ identity _ ⟩ y ⁻¹ ∎ agda-stdlib-0.14/src/Algebra/Properties/BooleanAlgebra.agda000066400000000000000000000601051315545220200235450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.BooleanAlgebra {b₁ b₂} (B : BooleanAlgebra b₁ b₂) where open BooleanAlgebra B import Algebra.Properties.DistributiveLattice private open module DL = Algebra.Properties.DistributiveLattice distributiveLattice public hiding (replace-equality) open import Algebra.Structures open import Algebra.FunctionProperties _≈_ open import Algebra.FunctionProperties.Consequences record {isEquivalence = isEquivalence} open import Relation.Binary.EqReasoning setoid open import Relation.Binary open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product ------------------------------------------------------------------------ -- Some simple generalisations ∨-complementˡ : LeftInverse ⊤ ¬_ _∨_ ∨-complementˡ = comm+invʳ⇒invˡ ∨-comm ∨-complementʳ ∨-complement : Inverse ⊤ ¬_ _∨_ ∨-complement = ∨-complementˡ , ∨-complementʳ ∧-complementˡ : LeftInverse ⊥ ¬_ _∧_ ∧-complementˡ = comm+invʳ⇒invˡ ∧-comm ∧-complementʳ ∧-complement : Inverse ⊥ ¬_ _∧_ ∧-complement = ∧-complementˡ , ∧-complementʳ ------------------------------------------------------------------------ -- The dual construction is also a boolean algebra ∧-∨-isBooleanAlgebra : IsBooleanAlgebra _≈_ _∧_ _∨_ ¬_ ⊥ ⊤ ∧-∨-isBooleanAlgebra = record { isDistributiveLattice = ∧-∨-isDistributiveLattice ; ∨-complementʳ = ∧-complementʳ ; ∧-complementʳ = ∨-complementʳ ; ¬-cong = ¬-cong } ∧-∨-booleanAlgebra : BooleanAlgebra _ _ ∧-∨-booleanAlgebra = record { _∧_ = _∨_ ; _∨_ = _∧_ ; ⊤ = ⊥ ; ⊥ = ⊤ ; isBooleanAlgebra = ∧-∨-isBooleanAlgebra } ------------------------------------------------------------------------ -- (∨, ∧, ⊥, ⊤) and (∧, ∨, ⊤, ⊥) are commutative semirings ∧-identityʳ : RightIdentity ⊤ _∧_ ∧-identityʳ x = begin x ∧ ⊤ ≈⟨ refl ⟨ ∧-cong ⟩ sym (∨-complementʳ _) ⟩ x ∧ (x ∨ ¬ x) ≈⟨ proj₂ absorptive _ _ ⟩ x ∎ ∧-identityˡ : LeftIdentity ⊤ _∧_ ∧-identityˡ = comm+idʳ⇒idˡ ∧-comm ∧-identityʳ ∧-identity : Identity ⊤ _∧_ ∧-identity = ∧-identityˡ , ∧-identityʳ ∨-identityʳ : RightIdentity ⊥ _∨_ ∨-identityʳ x = begin x ∨ ⊥ ≈⟨ refl ⟨ ∨-cong ⟩ sym (∧-complementʳ _) ⟩ x ∨ x ∧ ¬ x ≈⟨ proj₁ absorptive _ _ ⟩ x ∎ ∨-identityˡ : LeftIdentity ⊥ _∨_ ∨-identityˡ = comm+idʳ⇒idˡ ∨-comm ∨-identityʳ ∨-identity : Identity ⊥ _∨_ ∨-identity = ∨-identityˡ , ∨-identityʳ ∧-zeroʳ : RightZero ⊥ _∧_ ∧-zeroʳ x = begin x ∧ ⊥ ≈⟨ refl ⟨ ∧-cong ⟩ sym (∧-complementʳ _) ⟩ x ∧ x ∧ ¬ x ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ x) ∧ ¬ x ≈⟨ ∧-idempotent _ ⟨ ∧-cong ⟩ refl ⟩ x ∧ ¬ x ≈⟨ ∧-complementʳ _ ⟩ ⊥ ∎ ∧-zeroˡ : LeftZero ⊥ _∧_ ∧-zeroˡ = comm+zeʳ⇒zeˡ ∧-comm ∧-zeroʳ ∧-zero : Zero ⊥ _∧_ ∧-zero = ∧-zeroˡ , ∧-zeroʳ ∨-zeroʳ : ∀ x → x ∨ ⊤ ≈ ⊤ ∨-zeroʳ x = begin x ∨ ⊤ ≈⟨ refl ⟨ ∨-cong ⟩ sym (∨-complementʳ _) ⟩ x ∨ x ∨ ¬ x ≈⟨ sym $ ∨-assoc _ _ _ ⟩ (x ∨ x) ∨ ¬ x ≈⟨ ∨-idempotent _ ⟨ ∨-cong ⟩ refl ⟩ x ∨ ¬ x ≈⟨ ∨-complementʳ _ ⟩ ⊤ ∎ ∨-zeroˡ : LeftZero ⊤ _∨_ ∨-zeroˡ _ = ∨-comm _ _ ⟨ trans ⟩ ∨-zeroʳ _ ∨-zero : Zero ⊤ _∨_ ∨-zero = ∨-zeroˡ , ∨-zeroʳ ∨-isSemigroup : IsSemigroup _≈_ _∨_ ∨-isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∨-assoc ; ∙-cong = ∨-cong } ∧-isSemigroup : IsSemigroup _≈_ _∧_ ∧-isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∧-assoc ; ∙-cong = ∧-cong } ∨-⊥-isMonoid : IsMonoid _≈_ _∨_ ⊥ ∨-⊥-isMonoid = record { isSemigroup = ∨-isSemigroup ; identity = ∨-identity } ∧-⊤-isMonoid : IsMonoid _≈_ _∧_ ⊤ ∧-⊤-isMonoid = record { isSemigroup = ∧-isSemigroup ; identity = ∧-identity } ∨-⊥-isCommutativeMonoid : IsCommutativeMonoid _≈_ _∨_ ⊥ ∨-⊥-isCommutativeMonoid = record { isSemigroup = ∨-isSemigroup ; identityˡ = ∨-identityˡ ; comm = ∨-comm } ∧-⊤-isCommutativeMonoid : IsCommutativeMonoid _≈_ _∧_ ⊤ ∧-⊤-isCommutativeMonoid = record { isSemigroup = ∧-isSemigroup ; identityˡ = ∧-identityˡ ; comm = ∧-comm } ∨-∧-isCommutativeSemiring : IsCommutativeSemiring _≈_ _∨_ _∧_ ⊥ ⊤ ∨-∧-isCommutativeSemiring = record { +-isCommutativeMonoid = ∨-⊥-isCommutativeMonoid ; *-isCommutativeMonoid = ∧-⊤-isCommutativeMonoid ; distribʳ = proj₂ ∧-∨-distrib ; zeroˡ = ∧-zeroˡ } ∨-∧-commutativeSemiring : CommutativeSemiring _ _ ∨-∧-commutativeSemiring = record { _+_ = _∨_ ; _*_ = _∧_ ; 0# = ⊥ ; 1# = ⊤ ; isCommutativeSemiring = ∨-∧-isCommutativeSemiring } ∧-∨-isCommutativeSemiring : IsCommutativeSemiring _≈_ _∧_ _∨_ ⊤ ⊥ ∧-∨-isCommutativeSemiring = record { +-isCommutativeMonoid = ∧-⊤-isCommutativeMonoid ; *-isCommutativeMonoid = ∨-⊥-isCommutativeMonoid ; distribʳ = proj₂ ∨-∧-distrib ; zeroˡ = ∨-zeroˡ } ∧-∨-commutativeSemiring : CommutativeSemiring _ _ ∧-∨-commutativeSemiring = record { _+_ = _∧_ ; _*_ = _∨_ ; 0# = ⊤ ; 1# = ⊥ ; isCommutativeSemiring = ∧-∨-isCommutativeSemiring } ------------------------------------------------------------------------ -- Some other properties -- I took the statement of this lemma (called Uniqueness of -- Complements) from some course notes, "Boolean Algebra", written -- by Gert Smolka. private lemma : ∀ x y → x ∧ y ≈ ⊥ → x ∨ y ≈ ⊤ → ¬ x ≈ y lemma x y x∧y=⊥ x∨y=⊤ = begin ¬ x ≈⟨ sym $ ∧-identityʳ _ ⟩ ¬ x ∧ ⊤ ≈⟨ refl ⟨ ∧-cong ⟩ sym x∨y=⊤ ⟩ ¬ x ∧ (x ∨ y) ≈⟨ proj₁ ∧-∨-distrib _ _ _ ⟩ ¬ x ∧ x ∨ ¬ x ∧ y ≈⟨ ∧-complementˡ _ ⟨ ∨-cong ⟩ refl ⟩ ⊥ ∨ ¬ x ∧ y ≈⟨ sym x∧y=⊥ ⟨ ∨-cong ⟩ refl ⟩ x ∧ y ∨ ¬ x ∧ y ≈⟨ sym $ proj₂ ∧-∨-distrib _ _ _ ⟩ (x ∨ ¬ x) ∧ y ≈⟨ ∨-complementʳ _ ⟨ ∧-cong ⟩ refl ⟩ ⊤ ∧ y ≈⟨ ∧-identityˡ _ ⟩ y ∎ ¬⊥=⊤ : ¬ ⊥ ≈ ⊤ ¬⊥=⊤ = lemma ⊥ ⊤ (∧-identityʳ _) (∨-zeroʳ _) ¬⊤=⊥ : ¬ ⊤ ≈ ⊥ ¬⊤=⊥ = lemma ⊤ ⊥ (∧-zeroʳ _) (∨-identityʳ _) ¬-involutive : Involutive ¬_ ¬-involutive x = lemma (¬ x) x (∧-complementˡ _) (∨-complementˡ _) deMorgan₁ : ∀ x y → ¬ (x ∧ y) ≈ ¬ x ∨ ¬ y deMorgan₁ x y = lemma (x ∧ y) (¬ x ∨ ¬ y) lem₁ lem₂ where lem₁ = begin (x ∧ y) ∧ (¬ x ∨ ¬ y) ≈⟨ proj₁ ∧-∨-distrib _ _ _ ⟩ (x ∧ y) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ (∧-comm _ _ ⟨ ∧-cong ⟩ refl) ⟨ ∨-cong ⟩ refl ⟩ (y ∧ x) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ ∧-assoc _ _ _ ⟨ ∨-cong ⟩ ∧-assoc _ _ _ ⟩ y ∧ (x ∧ ¬ x) ∨ x ∧ (y ∧ ¬ y) ≈⟨ (refl ⟨ ∧-cong ⟩ ∧-complementʳ _) ⟨ ∨-cong ⟩ (refl ⟨ ∧-cong ⟩ ∧-complementʳ _) ⟩ (y ∧ ⊥) ∨ (x ∧ ⊥) ≈⟨ ∧-zeroʳ _ ⟨ ∨-cong ⟩ ∧-zeroʳ _ ⟩ ⊥ ∨ ⊥ ≈⟨ ∨-identityʳ _ ⟩ ⊥ ∎ lem₃ = begin (x ∧ y) ∨ ¬ x ≈⟨ proj₂ ∨-∧-distrib _ _ _ ⟩ (x ∨ ¬ x) ∧ (y ∨ ¬ x) ≈⟨ ∨-complementʳ _ ⟨ ∧-cong ⟩ refl ⟩ ⊤ ∧ (y ∨ ¬ x) ≈⟨ ∧-identityˡ _ ⟩ y ∨ ¬ x ≈⟨ ∨-comm _ _ ⟩ ¬ x ∨ y ∎ lem₂ = begin (x ∧ y) ∨ (¬ x ∨ ¬ y) ≈⟨ sym $ ∨-assoc _ _ _ ⟩ ((x ∧ y) ∨ ¬ x) ∨ ¬ y ≈⟨ lem₃ ⟨ ∨-cong ⟩ refl ⟩ (¬ x ∨ y) ∨ ¬ y ≈⟨ ∨-assoc _ _ _ ⟩ ¬ x ∨ (y ∨ ¬ y) ≈⟨ refl ⟨ ∨-cong ⟩ ∨-complementʳ _ ⟩ ¬ x ∨ ⊤ ≈⟨ ∨-zeroʳ _ ⟩ ⊤ ∎ deMorgan₂ : ∀ x y → ¬ (x ∨ y) ≈ ¬ x ∧ ¬ y deMorgan₂ x y = begin ¬ (x ∨ y) ≈⟨ ¬-cong $ sym (¬-involutive _) ⟨ ∨-cong ⟩ sym (¬-involutive _) ⟩ ¬ (¬ ¬ x ∨ ¬ ¬ y) ≈⟨ ¬-cong $ sym $ deMorgan₁ _ _ ⟩ ¬ ¬ (¬ x ∧ ¬ y) ≈⟨ ¬-involutive _ ⟩ ¬ x ∧ ¬ y ∎ -- One can replace the underlying equality with an equivalent one. replace-equality : {_≈′_ : Rel Carrier b₂} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → BooleanAlgebra _ _ replace-equality {_≈′_} ≈⇔≈′ = record { _≈_ = _≈′_ ; _∨_ = _∨_ ; _∧_ = _∧_ ; ¬_ = ¬_ ; ⊤ = ⊤ ; ⊥ = ⊥ ; isBooleanAlgebra = record { isDistributiveLattice = DistributiveLattice.isDistributiveLattice (DL.replace-equality ≈⇔≈′) ; ∨-complementʳ = λ x → to ⟨$⟩ ∨-complementʳ x ; ∧-complementʳ = λ x → to ⟨$⟩ ∧-complementʳ x ; ¬-cong = λ i≈j → to ⟨$⟩ ¬-cong (from ⟨$⟩ i≈j) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) ------------------------------------------------------------------------ -- (⊕, ∧, id, ⊥, ⊤) is a commutative ring -- This construction is parameterised over the definition of xor. module XorRing (xor : Op₂ Carrier) (⊕-def : ∀ x y → xor x y ≈ (x ∨ y) ∧ ¬ (x ∧ y)) where private infixl 6 _⊕_ _⊕_ : Op₂ Carrier _⊕_ = xor helper : ∀ {x y u v} → x ≈ y → u ≈ v → x ∧ ¬ u ≈ y ∧ ¬ v helper x≈y u≈v = x≈y ⟨ ∧-cong ⟩ ¬-cong u≈v ⊕-cong : Congruent₂ _⊕_ ⊕-cong {x} {y} {u} {v} x≈y u≈v = begin x ⊕ u ≈⟨ ⊕-def _ _ ⟩ (x ∨ u) ∧ ¬ (x ∧ u) ≈⟨ helper (x≈y ⟨ ∨-cong ⟩ u≈v) (x≈y ⟨ ∧-cong ⟩ u≈v) ⟩ (y ∨ v) ∧ ¬ (y ∧ v) ≈⟨ sym $ ⊕-def _ _ ⟩ y ⊕ v ∎ ⊕-comm : Commutative _⊕_ ⊕-comm x y = begin x ⊕ y ≈⟨ ⊕-def _ _ ⟩ (x ∨ y) ∧ ¬ (x ∧ y) ≈⟨ helper (∨-comm _ _) (∧-comm _ _) ⟩ (y ∨ x) ∧ ¬ (y ∧ x) ≈⟨ sym $ ⊕-def _ _ ⟩ y ⊕ x ∎ ⊕-¬-distribˡ : ∀ x y → ¬ (x ⊕ y) ≈ ¬ x ⊕ y ⊕-¬-distribˡ x y = begin ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-def _ _ ⟩ ¬ ((x ∨ y) ∧ (¬ (x ∧ y))) ≈⟨ ¬-cong (proj₂ ∧-∨-distrib _ _ _) ⟩ ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (x ∧ y))) ≈⟨ ¬-cong $ refl ⟨ ∨-cong ⟩ (refl ⟨ ∧-cong ⟩ ¬-cong (∧-comm _ _)) ⟩ ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (y ∧ x))) ≈⟨ ¬-cong $ lem _ _ ⟨ ∨-cong ⟩ lem _ _ ⟩ ¬ ((x ∧ ¬ y) ∨ (y ∧ ¬ x)) ≈⟨ deMorgan₂ _ _ ⟩ ¬ (x ∧ ¬ y) ∧ ¬ (y ∧ ¬ x) ≈⟨ deMorgan₁ _ _ ⟨ ∧-cong ⟩ refl ⟩ (¬ x ∨ (¬ ¬ y)) ∧ ¬ (y ∧ ¬ x) ≈⟨ helper (refl ⟨ ∨-cong ⟩ ¬-involutive _) (∧-comm _ _) ⟩ (¬ x ∨ y) ∧ ¬ (¬ x ∧ y) ≈⟨ sym $ ⊕-def _ _ ⟩ ¬ x ⊕ y ∎ where lem : ∀ x y → x ∧ ¬ (x ∧ y) ≈ x ∧ ¬ y lem x y = begin x ∧ ¬ (x ∧ y) ≈⟨ refl ⟨ ∧-cong ⟩ deMorgan₁ _ _ ⟩ x ∧ (¬ x ∨ ¬ y) ≈⟨ proj₁ ∧-∨-distrib _ _ _ ⟩ (x ∧ ¬ x) ∨ (x ∧ ¬ y) ≈⟨ ∧-complementʳ _ ⟨ ∨-cong ⟩ refl ⟩ ⊥ ∨ (x ∧ ¬ y) ≈⟨ ∨-identityˡ _ ⟩ x ∧ ¬ y ∎ ⊕-¬-distribʳ : ∀ x y → ¬ (x ⊕ y) ≈ x ⊕ ¬ y ⊕-¬-distribʳ x y = begin ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-comm _ _ ⟩ ¬ (y ⊕ x) ≈⟨ ⊕-¬-distribˡ _ _ ⟩ ¬ y ⊕ x ≈⟨ ⊕-comm _ _ ⟩ x ⊕ ¬ y ∎ ⊕-annihilates-¬ : ∀ x y → x ⊕ y ≈ ¬ x ⊕ ¬ y ⊕-annihilates-¬ x y = begin x ⊕ y ≈⟨ sym $ ¬-involutive _ ⟩ ¬ ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-¬-distribˡ _ _ ⟩ ¬ (¬ x ⊕ y) ≈⟨ ⊕-¬-distribʳ _ _ ⟩ ¬ x ⊕ ¬ y ∎ ⊕-identityˡ : LeftIdentity ⊥ _⊕_ ⊕-identityˡ x = begin ⊥ ⊕ x ≈⟨ ⊕-def _ _ ⟩ (⊥ ∨ x) ∧ ¬ (⊥ ∧ x) ≈⟨ helper (∨-identityˡ _) (∧-zeroˡ _) ⟩ x ∧ ¬ ⊥ ≈⟨ refl ⟨ ∧-cong ⟩ ¬⊥=⊤ ⟩ x ∧ ⊤ ≈⟨ ∧-identityʳ _ ⟩ x ∎ ⊕-identityʳ : RightIdentity ⊥ _⊕_ ⊕-identityʳ _ = ⊕-comm _ _ ⟨ trans ⟩ ⊕-identityˡ _ ⊕-identity : Identity ⊥ _⊕_ ⊕-identity = ⊕-identityˡ , ⊕-identityʳ ⊕-inverseˡ : LeftInverse ⊥ id _⊕_ ⊕-inverseˡ x = begin x ⊕ x ≈⟨ ⊕-def _ _ ⟩ (x ∨ x) ∧ ¬ (x ∧ x) ≈⟨ helper (∨-idempotent _) (∧-idempotent _) ⟩ x ∧ ¬ x ≈⟨ ∧-complementʳ _ ⟩ ⊥ ∎ ⊕-inverseʳ : RightInverse ⊥ id _⊕_ ⊕-inverseʳ _ = ⊕-comm _ _ ⟨ trans ⟩ ⊕-inverseˡ _ ⊕-inverse : Inverse ⊥ id _⊕_ ⊕-inverse = ⊕-inverseˡ , ⊕-inverseʳ ∧-distribˡ-⊕ : _∧_ DistributesOverˡ _⊕_ ∧-distribˡ-⊕ x y z = begin x ∧ (y ⊕ z) ≈⟨ refl ⟨ ∧-cong ⟩ ⊕-def _ _ ⟩ x ∧ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ (y ∨ z)) ∧ ¬ (y ∧ z) ≈⟨ refl ⟨ ∧-cong ⟩ deMorgan₁ _ _ ⟩ (x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z) ≈⟨ sym $ ∨-identityˡ _ ⟩ ⊥ ∨ ((x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z)) ≈⟨ lem₃ ⟨ ∨-cong ⟩ refl ⟩ ((x ∧ (y ∨ z)) ∧ ¬ x) ∨ ((x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z)) ≈⟨ sym $ proj₁ ∧-∨-distrib _ _ _ ⟩ (x ∧ (y ∨ z)) ∧ (¬ x ∨ (¬ y ∨ ¬ z)) ≈⟨ refl ⟨ ∧-cong ⟩ (refl ⟨ ∨-cong ⟩ sym (deMorgan₁ _ _)) ⟩ (x ∧ (y ∨ z)) ∧ (¬ x ∨ ¬ (y ∧ z)) ≈⟨ refl ⟨ ∧-cong ⟩ sym (deMorgan₁ _ _) ⟩ (x ∧ (y ∨ z)) ∧ ¬ (x ∧ (y ∧ z)) ≈⟨ helper refl lem₁ ⟩ (x ∧ (y ∨ z)) ∧ ¬ ((x ∧ y) ∧ (x ∧ z)) ≈⟨ proj₁ ∧-∨-distrib _ _ _ ⟨ ∧-cong ⟩ refl ⟩ ((x ∧ y) ∨ (x ∧ z)) ∧ ¬ ((x ∧ y) ∧ (x ∧ z)) ≈⟨ sym $ ⊕-def _ _ ⟩ (x ∧ y) ⊕ (x ∧ z) ∎ where lem₂ = begin x ∧ (y ∧ z) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ y) ∧ z ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (y ∧ x) ∧ z ≈⟨ ∧-assoc _ _ _ ⟩ y ∧ (x ∧ z) ∎ lem₁ = begin x ∧ (y ∧ z) ≈⟨ sym (∧-idempotent _) ⟨ ∧-cong ⟩ refl ⟩ (x ∧ x) ∧ (y ∧ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ (x ∧ (y ∧ z)) ≈⟨ refl ⟨ ∧-cong ⟩ lem₂ ⟩ x ∧ (y ∧ (x ∧ z)) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ y) ∧ (x ∧ z) ∎ lem₃ = begin ⊥ ≈⟨ sym $ ∧-zeroʳ _ ⟩ (y ∨ z) ∧ ⊥ ≈⟨ refl ⟨ ∧-cong ⟩ sym (∧-complementʳ _) ⟩ (y ∨ z) ∧ (x ∧ ¬ x) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ ((y ∨ z) ∧ x) ∧ ¬ x ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (y ∨ z)) ∧ ¬ x ∎ ∧-distribʳ-⊕ : _∧_ DistributesOverʳ _⊕_ ∧-distribʳ-⊕ = comm+distrˡ⇒distrʳ ⊕-cong ∧-comm ∧-distribˡ-⊕ ∧-distrib-⊕ : _∧_ DistributesOver _⊕_ ∧-distrib-⊕ = ∧-distribˡ-⊕ , ∧-distribʳ-⊕ private lemma₂ : ∀ x y u v → (x ∧ y) ∨ (u ∧ v) ≈ ((x ∨ u) ∧ (y ∨ u)) ∧ ((x ∨ v) ∧ (y ∨ v)) lemma₂ x y u v = begin (x ∧ y) ∨ (u ∧ v) ≈⟨ proj₁ ∨-∧-distrib _ _ _ ⟩ ((x ∧ y) ∨ u) ∧ ((x ∧ y) ∨ v) ≈⟨ proj₂ ∨-∧-distrib _ _ _ ⟨ ∧-cong ⟩ proj₂ ∨-∧-distrib _ _ _ ⟩ ((x ∨ u) ∧ (y ∨ u)) ∧ ((x ∨ v) ∧ (y ∨ v)) ∎ ⊕-assoc : Associative _⊕_ ⊕-assoc x y z = sym $ begin x ⊕ (y ⊕ z) ≈⟨ refl ⟨ ⊕-cong ⟩ ⊕-def _ _ ⟩ x ⊕ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ⊕-def _ _ ⟩ (x ∨ ((y ∨ z) ∧ ¬ (y ∧ z))) ∧ ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ lem₃ ⟨ ∧-cong ⟩ lem₄ ⟩ (((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ ∧-assoc _ _ _ ⟩ ((x ∨ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈⟨ refl ⟨ ∧-cong ⟩ lem₅ ⟩ ((x ∨ y) ∨ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ lem₁ ⟨ ∧-cong ⟩ lem₂ ⟩ (((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z) ∧ ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ≈⟨ sym $ ⊕-def _ _ ⟩ ((x ∨ y) ∧ ¬ (x ∧ y)) ⊕ z ≈⟨ sym $ ⊕-def _ _ ⟨ ⊕-cong ⟩ refl ⟩ (x ⊕ y) ⊕ z ∎ where lem₁ = begin ((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈⟨ sym $ proj₂ ∨-∧-distrib _ _ _ ⟩ ((x ∨ y) ∧ (¬ x ∨ ¬ y)) ∨ z ≈⟨ (refl ⟨ ∧-cong ⟩ sym (deMorgan₁ _ _)) ⟨ ∨-cong ⟩ refl ⟩ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z ∎ lem₂' = begin (x ∨ ¬ y) ∧ (¬ x ∨ y) ≈⟨ sym $ ∧-identityˡ _ ⟨ ∧-cong ⟩ ∧-identityʳ _ ⟩ (⊤ ∧ (x ∨ ¬ y)) ∧ ((¬ x ∨ y) ∧ ⊤) ≈⟨ sym $ (∨-complementˡ _ ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ (refl ⟨ ∧-cong ⟩ ∨-complementˡ _) ⟩ ((¬ x ∨ x) ∧ (¬ y ∨ x)) ∧ ((¬ x ∨ y) ∧ (¬ y ∨ y)) ≈⟨ sym $ lemma₂ _ _ _ _ ⟩ (¬ x ∧ ¬ y) ∨ (x ∧ y) ≈⟨ sym $ deMorgan₂ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ ¬ (x ∨ y) ∨ ¬ ¬ (x ∧ y) ≈⟨ sym (deMorgan₁ _ _) ⟩ ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∎ lem₂ = begin ((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ sym $ proj₂ ∨-∧-distrib _ _ _ ⟩ ((x ∨ ¬ y) ∧ (¬ x ∨ y)) ∨ ¬ z ≈⟨ lem₂' ⟨ ∨-cong ⟩ refl ⟩ ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ ¬ z ≈⟨ sym $ deMorgan₁ _ _ ⟩ ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ∎ lem₃ = begin x ∨ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ refl ⟨ ∨-cong ⟩ (refl ⟨ ∧-cong ⟩ deMorgan₁ _ _) ⟩ x ∨ ((y ∨ z) ∧ (¬ y ∨ ¬ z)) ≈⟨ proj₁ ∨-∧-distrib _ _ _ ⟩ (x ∨ (y ∨ z)) ∧ (x ∨ (¬ y ∨ ¬ z)) ≈⟨ sym (∨-assoc _ _ _) ⟨ ∧-cong ⟩ sym (∨-assoc _ _ _) ⟩ ((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z) ∎ lem₄' = begin ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ deMorgan₁ _ _ ⟩ ¬ (y ∨ z) ∨ ¬ ¬ (y ∧ z) ≈⟨ deMorgan₂ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ (¬ y ∧ ¬ z) ∨ (y ∧ z) ≈⟨ lemma₂ _ _ _ _ ⟩ ((¬ y ∨ y) ∧ (¬ z ∨ y)) ∧ ((¬ y ∨ z) ∧ (¬ z ∨ z)) ≈⟨ (∨-complementˡ _ ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ (refl ⟨ ∧-cong ⟩ ∨-complementˡ _) ⟩ (⊤ ∧ (y ∨ ¬ z)) ∧ ((¬ y ∨ z) ∧ ⊤) ≈⟨ ∧-identityˡ _ ⟨ ∧-cong ⟩ ∧-identityʳ _ ⟩ (y ∨ ¬ z) ∧ (¬ y ∨ z) ∎ lem₄ = begin ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ deMorgan₁ _ _ ⟩ ¬ x ∨ ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ refl ⟨ ∨-cong ⟩ lem₄' ⟩ ¬ x ∨ ((y ∨ ¬ z) ∧ (¬ y ∨ z)) ≈⟨ proj₁ ∨-∧-distrib _ _ _ ⟩ (¬ x ∨ (y ∨ ¬ z)) ∧ (¬ x ∨ (¬ y ∨ z)) ≈⟨ sym (∨-assoc _ _ _) ⟨ ∧-cong ⟩ sym (∨-assoc _ _ _) ⟩ ((¬ x ∨ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈⟨ ∧-comm _ _ ⟩ ((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ∎ lem₅ = begin ((x ∨ ¬ y) ∨ ¬ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (((¬ x ∨ ¬ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-assoc _ _ _ ⟩ ((¬ x ∨ ¬ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ∎ ⊕-isSemigroup : IsSemigroup _≈_ _⊕_ ⊕-isSemigroup = record { isEquivalence = isEquivalence ; assoc = ⊕-assoc ; ∙-cong = ⊕-cong } ⊕-⊥-isMonoid : IsMonoid _≈_ _⊕_ ⊥ ⊕-⊥-isMonoid = record { isSemigroup = ⊕-isSemigroup ; identity = ⊕-identity } ⊕-⊥-isGroup : IsGroup _≈_ _⊕_ ⊥ id ⊕-⊥-isGroup = record { isMonoid = ⊕-⊥-isMonoid ; inverse = ⊕-inverse ; ⁻¹-cong = id } ⊕-⊥-isAbelianGroup : IsAbelianGroup _≈_ _⊕_ ⊥ id ⊕-⊥-isAbelianGroup = record { isGroup = ⊕-⊥-isGroup ; comm = ⊕-comm } ⊕-∧-isRing : IsRing _≈_ _⊕_ _∧_ id ⊥ ⊤ ⊕-∧-isRing = record { +-isAbelianGroup = ⊕-⊥-isAbelianGroup ; *-isMonoid = ∧-⊤-isMonoid ; distrib = ∧-distrib-⊕ } isCommutativeRing : IsCommutativeRing _≈_ _⊕_ _∧_ id ⊥ ⊤ isCommutativeRing = record { isRing = ⊕-∧-isRing ; *-comm = ∧-comm } commutativeRing : CommutativeRing _ _ commutativeRing = record { _+_ = _⊕_ ; _*_ = _∧_ ; -_ = id ; 0# = ⊥ ; 1# = ⊤ ; isCommutativeRing = isCommutativeRing } infixl 6 _⊕_ _⊕_ : Op₂ Carrier x ⊕ y = (x ∨ y) ∧ ¬ (x ∧ y) module DefaultXorRing = XorRing _⊕_ (λ _ _ → refl) agda-stdlib-0.14/src/Algebra/Properties/BooleanAlgebra/000077500000000000000000000000001315545220200227255ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/Properties/BooleanAlgebra/Expression.agda000066400000000000000000000206261315545220200257100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Boolean algebra expressions ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.BooleanAlgebra.Expression {b} (B : BooleanAlgebra b b) where open BooleanAlgebra B open import Category.Applicative import Category.Applicative.Indexed as Applicative open import Category.Monad open import Category.Monad.Identity open import Data.Fin using (Fin) open import Data.Nat open import Data.Vec as Vec using (Vec) open import Data.Product using (_,_; proj₁; proj₂) import Data.Vec.Properties as VecProp open import Function open import Relation.Binary.PropositionalEquality as P using (_≗_) import Relation.Binary.Reflection as Reflection open import Relation.Binary.Vec.Pointwise as PW using (Pointwise; module Pointwise; ext) -- Expressions made up of variables and the operations of a boolean -- algebra. infixr 7 _and_ infixr 6 _or_ data Expr n : Set b where var : (x : Fin n) → Expr n _or_ _and_ : (e₁ e₂ : Expr n) → Expr n not : (e : Expr n) → Expr n top bot : Expr n -- The semantics of an expression, parametrised by an applicative -- functor. module Semantics {F : Set b → Set b} (A : RawApplicative F) where open RawApplicative A ⟦_⟧ : ∀ {n} → Expr n → Vec (F Carrier) n → F Carrier ⟦ var x ⟧ ρ = Vec.lookup x ρ ⟦ e₁ or e₂ ⟧ ρ = pure _∨_ ⊛ ⟦ e₁ ⟧ ρ ⊛ ⟦ e₂ ⟧ ρ ⟦ e₁ and e₂ ⟧ ρ = pure _∧_ ⊛ ⟦ e₁ ⟧ ρ ⊛ ⟦ e₂ ⟧ ρ ⟦ not e ⟧ ρ = pure ¬_ ⊛ ⟦ e ⟧ ρ ⟦ top ⟧ ρ = pure ⊤ ⟦ bot ⟧ ρ = pure ⊥ -- flip Semantics.⟦_⟧ e is natural. module Naturality {F₁ F₂ : Set b → Set b} {A₁ : RawApplicative F₁} {A₂ : RawApplicative F₂} (f : Applicative.Morphism A₁ A₂) where open P.≡-Reasoning open Applicative.Morphism f open Semantics A₁ renaming (⟦_⟧ to ⟦_⟧₁) open Semantics A₂ renaming (⟦_⟧ to ⟦_⟧₂) open RawApplicative A₁ renaming (pure to pure₁; _⊛_ to _⊛₁_) open RawApplicative A₂ renaming (pure to pure₂; _⊛_ to _⊛₂_) natural : ∀ {n} (e : Expr n) → op ∘ ⟦ e ⟧₁ ≗ ⟦ e ⟧₂ ∘ Vec.map op natural (var x) ρ = begin op (Vec.lookup x ρ) ≡⟨ P.sym $ VecProp.lookup-map x op ρ ⟩ Vec.lookup x (Vec.map op ρ) ∎ natural (e₁ or e₂) ρ = begin op (pure₁ _∨_ ⊛₁ ⟦ e₁ ⟧₁ ρ ⊛₁ ⟦ e₂ ⟧₁ ρ) ≡⟨ op-⊛ _ _ ⟩ op (pure₁ _∨_ ⊛₁ ⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (op-⊛ _ _) P.refl ⟩ op (pure₁ _∨_) ⊛₂ op (⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (P.cong₂ _⊛₂_ (op-pure _) (natural e₁ ρ)) (natural e₂ ρ) ⟩ pure₂ _∨_ ⊛₂ ⟦ e₁ ⟧₂ (Vec.map op ρ) ⊛₂ ⟦ e₂ ⟧₂ (Vec.map op ρ) ∎ natural (e₁ and e₂) ρ = begin op (pure₁ _∧_ ⊛₁ ⟦ e₁ ⟧₁ ρ ⊛₁ ⟦ e₂ ⟧₁ ρ) ≡⟨ op-⊛ _ _ ⟩ op (pure₁ _∧_ ⊛₁ ⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (op-⊛ _ _) P.refl ⟩ op (pure₁ _∧_) ⊛₂ op (⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (P.cong₂ _⊛₂_ (op-pure _) (natural e₁ ρ)) (natural e₂ ρ) ⟩ pure₂ _∧_ ⊛₂ ⟦ e₁ ⟧₂ (Vec.map op ρ) ⊛₂ ⟦ e₂ ⟧₂ (Vec.map op ρ) ∎ natural (not e) ρ = begin op (pure₁ ¬_ ⊛₁ ⟦ e ⟧₁ ρ) ≡⟨ op-⊛ _ _ ⟩ op (pure₁ ¬_) ⊛₂ op (⟦ e ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (op-pure _) (natural e ρ) ⟩ pure₂ ¬_ ⊛₂ ⟦ e ⟧₂ (Vec.map op ρ) ∎ natural top ρ = begin op (pure₁ ⊤) ≡⟨ op-pure _ ⟩ pure₂ ⊤ ∎ natural bot ρ = begin op (pure₁ ⊥) ≡⟨ op-pure _ ⟩ pure₂ ⊥ ∎ -- An example of how naturality can be used: Any boolean algebra can -- be lifted, in a pointwise manner, to vectors of carrier elements. lift : ℕ → BooleanAlgebra b b lift n = record { Carrier = Vec Carrier n ; _≈_ = Pointwise _≈_ ; _∨_ = zipWith _∨_ ; _∧_ = zipWith _∧_ ; ¬_ = map ¬_ ; ⊤ = pure ⊤ ; ⊥ = pure ⊥ ; isBooleanAlgebra = record { isDistributiveLattice = record { isLattice = record { isEquivalence = PW.isEquivalence isEquivalence ; ∨-comm = λ _ _ → ext λ i → solve i 2 (λ x y → x or y , y or x) (∨-comm _ _) _ _ ; ∨-assoc = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (x or y) or z , x or (y or z)) (∨-assoc _ _ _) _ _ _ ; ∨-cong = λ xs≈us ys≈vs → ext λ i → solve₁ i 4 (λ x y u v → x or y , u or v) _ _ _ _ (∨-cong (Pointwise.app xs≈us i) (Pointwise.app ys≈vs i)) ; ∧-comm = λ _ _ → ext λ i → solve i 2 (λ x y → x and y , y and x) (∧-comm _ _) _ _ ; ∧-assoc = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (x and y) and z , x and (y and z)) (∧-assoc _ _ _) _ _ _ ; ∧-cong = λ xs≈ys us≈vs → ext λ i → solve₁ i 4 (λ x y u v → x and y , u and v) _ _ _ _ (∧-cong (Pointwise.app xs≈ys i) (Pointwise.app us≈vs i)) ; absorptive = (λ _ _ → ext λ i → solve i 2 (λ x y → x or (x and y) , x) (proj₁ absorptive _ _) _ _) , (λ _ _ → ext λ i → solve i 2 (λ x y → x and (x or y) , x) (proj₂ absorptive _ _) _ _) } ; ∨-∧-distribʳ = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (y and z) or x , (y or x) and (z or x)) (∨-∧-distribʳ _ _ _) _ _ _ } ; ∨-complementʳ = λ _ → ext λ i → solve i 1 (λ x → x or (not x) , top) (∨-complementʳ _) _ ; ∧-complementʳ = λ _ → ext λ i → solve i 1 (λ x → x and (not x) , bot) (∧-complementʳ _) _ ; ¬-cong = λ xs≈ys → ext λ i → solve₁ i 2 (λ x y → not x , not y) _ _ (¬-cong (Pointwise.app xs≈ys i)) } } where open RawApplicative Vec.applicative using (pure; zipWith) renaming (_<$>_ to map) ⟦_⟧Id : ∀ {n} → Expr n → Vec Carrier n → Carrier ⟦_⟧Id = Semantics.⟦_⟧ (RawMonad.rawIApplicative IdentityMonad) ⟦_⟧Vec : ∀ {m n} → Expr n → Vec (Vec Carrier m) n → Vec Carrier m ⟦_⟧Vec = Semantics.⟦_⟧ Vec.applicative open module R {n} (i : Fin n) = Reflection setoid var (λ e ρ → Vec.lookup i (⟦ e ⟧Vec ρ)) (λ e ρ → ⟦ e ⟧Id (Vec.map (Vec.lookup i) ρ)) (λ e ρ → sym $ reflexive $ Naturality.natural (VecProp.lookup-morphism i) e ρ) agda-stdlib-0.14/src/Algebra/Properties/DistributiveLattice.agda000066400000000000000000000065051315545220200246770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.DistributiveLattice {dl₁ dl₂} (DL : DistributiveLattice dl₁ dl₂) where open DistributiveLattice DL import Algebra.Properties.Lattice private open module L = Algebra.Properties.Lattice lattice public hiding (replace-equality) open import Algebra.Structures open import Algebra.FunctionProperties _≈_ open import Relation.Binary open import Relation.Binary.EqReasoning setoid open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product ∨-∧-distribˡ : _∨_ DistributesOverˡ _∧_ ∨-∧-distribˡ x y z = begin x ∨ y ∧ z ≈⟨ ∨-comm _ _ ⟩ y ∧ z ∨ x ≈⟨ ∨-∧-distribʳ _ _ _ ⟩ (y ∨ x) ∧ (z ∨ x) ≈⟨ ∨-comm _ _ ⟨ ∧-cong ⟩ ∨-comm _ _ ⟩ (x ∨ y) ∧ (x ∨ z) ∎ ∨-∧-distrib : _∨_ DistributesOver _∧_ ∨-∧-distrib = ∨-∧-distribˡ , ∨-∧-distribʳ ∧-∨-distribˡ : _∧_ DistributesOverˡ _∨_ ∧-∨-distribˡ x y z = begin x ∧ (y ∨ z) ≈⟨ sym (proj₂ absorptive _ _) ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (x ∨ y)) ∧ (y ∨ z) ≈⟨ (refl ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (y ∨ x)) ∧ (y ∨ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ ((y ∨ x) ∧ (y ∨ z)) ≈⟨ refl ⟨ ∧-cong ⟩ sym (proj₁ ∨-∧-distrib _ _ _) ⟩ x ∧ (y ∨ x ∧ z) ≈⟨ sym (proj₁ absorptive _ _) ⟨ ∧-cong ⟩ refl ⟩ (x ∨ x ∧ z) ∧ (y ∨ x ∧ z) ≈⟨ sym $ proj₂ ∨-∧-distrib _ _ _ ⟩ x ∧ y ∨ x ∧ z ∎ ∧-∨-distribʳ : _∧_ DistributesOverʳ _∨_ ∧-∨-distribʳ x y z = begin (y ∨ z) ∧ x ≈⟨ ∧-comm _ _ ⟩ x ∧ (y ∨ z) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ x ∧ y ∨ x ∧ z ≈⟨ ∧-comm _ _ ⟨ ∨-cong ⟩ ∧-comm _ _ ⟩ y ∧ x ∨ z ∧ x ∎ ∧-∨-distrib : _∧_ DistributesOver _∨_ ∧-∨-distrib = ∧-∨-distribˡ , ∧-∨-distribʳ -- The dual construction is also a distributive lattice. ∧-∨-isDistributiveLattice : IsDistributiveLattice _≈_ _∧_ _∨_ ∧-∨-isDistributiveLattice = record { isLattice = ∧-∨-isLattice ; ∨-∧-distribʳ = proj₂ ∧-∨-distrib } ∧-∨-distributiveLattice : DistributiveLattice _ _ ∧-∨-distributiveLattice = record { _∧_ = _∨_ ; _∨_ = _∧_ ; isDistributiveLattice = ∧-∨-isDistributiveLattice } -- One can replace the underlying equality with an equivalent one. replace-equality : {_≈′_ : Rel Carrier dl₂} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → DistributiveLattice _ _ replace-equality {_≈′_} ≈⇔≈′ = record { _≈_ = _≈′_ ; _∧_ = _∧_ ; _∨_ = _∨_ ; isDistributiveLattice = record { isLattice = Lattice.isLattice (L.replace-equality ≈⇔≈′) ; ∨-∧-distribʳ = λ x y z → to ⟨$⟩ ∨-∧-distribʳ x y z } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) agda-stdlib-0.14/src/Algebra/Properties/Group.agda000066400000000000000000000053401315545220200220040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.Group {g₁ g₂} (G : Group g₁ g₂) where open Group G import Algebra.FunctionProperties as P; open P _≈_ import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Data.Product ⁻¹-involutive : ∀ x → x ⁻¹ ⁻¹ ≈ x ⁻¹-involutive x = begin x ⁻¹ ⁻¹ ≈⟨ sym $ proj₂ identity _ ⟩ x ⁻¹ ⁻¹ ∙ ε ≈⟨ refl ⟨ ∙-cong ⟩ sym (proj₁ inverse _) ⟩ x ⁻¹ ⁻¹ ∙ (x ⁻¹ ∙ x) ≈⟨ sym $ assoc _ _ _ ⟩ x ⁻¹ ⁻¹ ∙ x ⁻¹ ∙ x ≈⟨ proj₁ inverse _ ⟨ ∙-cong ⟩ refl ⟩ ε ∙ x ≈⟨ proj₁ identity _ ⟩ x ∎ private left-helper : ∀ x y → x ≈ (x ∙ y) ∙ y ⁻¹ left-helper x y = begin x ≈⟨ sym (proj₂ identity x) ⟩ x ∙ ε ≈⟨ refl ⟨ ∙-cong ⟩ sym (proj₂ inverse y) ⟩ x ∙ (y ∙ y ⁻¹) ≈⟨ sym (assoc x y (y ⁻¹)) ⟩ (x ∙ y) ∙ y ⁻¹ ∎ right-helper : ∀ x y → y ≈ x ⁻¹ ∙ (x ∙ y) right-helper x y = begin y ≈⟨ sym (proj₁ identity y) ⟩ ε ∙ y ≈⟨ sym (proj₁ inverse x) ⟨ ∙-cong ⟩ refl ⟩ (x ⁻¹ ∙ x) ∙ y ≈⟨ assoc (x ⁻¹) x y ⟩ x ⁻¹ ∙ (x ∙ y) ∎ left-identity-unique : ∀ x y → x ∙ y ≈ y → x ≈ ε left-identity-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y ⁻¹ ≈⟨ eq ⟨ ∙-cong ⟩ refl ⟩ y ∙ y ⁻¹ ≈⟨ proj₂ inverse y ⟩ ε ∎ right-identity-unique : ∀ x y → x ∙ y ≈ x → y ≈ ε right-identity-unique x y eq = begin y ≈⟨ right-helper x y ⟩ x ⁻¹ ∙ (x ∙ y) ≈⟨ refl ⟨ ∙-cong ⟩ eq ⟩ x ⁻¹ ∙ x ≈⟨ proj₁ inverse x ⟩ ε ∎ identity-unique : ∀ {x} → Identity x _∙_ → x ≈ ε identity-unique {x} id = left-identity-unique x x (proj₂ id x) left-inverse-unique : ∀ x y → x ∙ y ≈ ε → x ≈ y ⁻¹ left-inverse-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y ⁻¹ ≈⟨ eq ⟨ ∙-cong ⟩ refl ⟩ ε ∙ y ⁻¹ ≈⟨ proj₁ identity (y ⁻¹) ⟩ y ⁻¹ ∎ right-inverse-unique : ∀ x y → x ∙ y ≈ ε → y ≈ x ⁻¹ right-inverse-unique x y eq = begin y ≈⟨ sym (⁻¹-involutive y) ⟩ y ⁻¹ ⁻¹ ≈⟨ ⁻¹-cong (sym (left-inverse-unique x y eq)) ⟩ x ⁻¹ ∎ agda-stdlib-0.14/src/Algebra/Properties/Lattice.agda000066400000000000000000000147421315545220200223030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.Lattice {l₁ l₂} (L : Lattice l₁ l₂) where open Lattice L open import Algebra.Structures import Algebra.FunctionProperties as P; open P _≈_ open import Relation.Binary import Relation.Binary.Lattice as R import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product ∧-idempotent : Idempotent _∧_ ∧-idempotent x = begin x ∧ x ≈⟨ refl ⟨ ∧-cong ⟩ sym (proj₁ absorptive _ _) ⟩ x ∧ (x ∨ x ∧ x) ≈⟨ proj₂ absorptive _ _ ⟩ x ∎ ∨-idempotent : Idempotent _∨_ ∨-idempotent x = begin x ∨ x ≈⟨ refl ⟨ ∨-cong ⟩ sym (∧-idempotent _) ⟩ x ∨ x ∧ x ≈⟨ proj₁ absorptive _ _ ⟩ x ∎ -- The dual construction is also a lattice. ∧-∨-isLattice : IsLattice _≈_ _∧_ _∨_ ∧-∨-isLattice = record { isEquivalence = isEquivalence ; ∨-comm = ∧-comm ; ∨-assoc = ∧-assoc ; ∨-cong = ∧-cong ; ∧-comm = ∨-comm ; ∧-assoc = ∨-assoc ; ∧-cong = ∨-cong ; absorptive = swap absorptive } ∧-∨-lattice : Lattice _ _ ∧-∨-lattice = record { _∧_ = _∨_ ; _∨_ = _∧_ ; isLattice = ∧-∨-isLattice } -- Every lattice can be turned into a poset. poset : Poset _ _ _ poset = record { Carrier = Carrier ; _≈_ = _≈_ ; _≤_ = λ x y → x ≈ x ∧ y ; isPartialOrder = record { isPreorder = record { isEquivalence = isEquivalence ; reflexive = λ {i} {j} i≈j → begin i ≈⟨ sym $ ∧-idempotent _ ⟩ i ∧ i ≈⟨ ∧-cong refl i≈j ⟩ i ∧ j ∎ ; trans = λ {i} {j} {k} i≈i∧j j≈j∧k → begin i ≈⟨ i≈i∧j ⟩ i ∧ j ≈⟨ ∧-cong refl j≈j∧k ⟩ i ∧ (j ∧ k) ≈⟨ sym (∧-assoc _ _ _) ⟩ (i ∧ j) ∧ k ≈⟨ ∧-cong (sym i≈i∧j) refl ⟩ i ∧ k ∎ } ; antisym = λ {x} {y} x≈x∧y y≈y∧x → begin x ≈⟨ x≈x∧y ⟩ x ∧ y ≈⟨ ∧-comm _ _ ⟩ y ∧ x ≈⟨ sym y≈y∧x ⟩ y ∎ } } open Poset poset using (_≤_; isPartialOrder) -- Every algebraic lattice can be turned into an order-theoretic one. isOrderTheoreticLattice : R.IsLattice _≈_ _≤_ _∨_ _∧_ isOrderTheoreticLattice = record { isPartialOrder = isPartialOrder ; supremum = λ x y → sym (∧-absorbs-∨ x y) , (begin y ≈⟨ sym (∧-absorbs-∨ y x) ⟩ y ∧ (y ∨ x) ≈⟨ ∧-cong refl (∨-comm y x) ⟩ y ∧ (x ∨ y) ∎) , (λ z x≤z y≤z → sound (begin (x ∨ y) ∨ z ≈⟨ ∨-assoc x y z ⟩ x ∨ (y ∨ z) ≈⟨ ∨-cong refl (complete y≤z) ⟩ x ∨ z ≈⟨ complete x≤z ⟩ z ∎)) ; infimum = λ x y → (begin x ∧ y ≈⟨ ∧-cong (sym (∧-idempotent x)) refl ⟩ (x ∧ x) ∧ y ≈⟨ ∧-assoc x x y ⟩ x ∧ (x ∧ y) ≈⟨ ∧-comm x (x ∧ y) ⟩ (x ∧ y) ∧ x ∎) , (begin x ∧ y ≈⟨ ∧-cong refl (sym (∧-idempotent y)) ⟩ x ∧ (y ∧ y) ≈⟨ sym (∧-assoc x y y) ⟩ (x ∧ y) ∧ y ∎) , (λ z z≈z∧x z≈z∧y → begin z ≈⟨ z≈z∧y ⟩ z ∧ y ≈⟨ ∧-cong z≈z∧x refl ⟩ (z ∧ x) ∧ y ≈⟨ ∧-assoc z x y ⟩ z ∧ (x ∧ y) ∎) } where ∧-absorbs-∨ = proj₂ absorptive -- An alternative but equivalent interpretation of the order _≤_. complete : ∀ {x y} → x ≤ y → x ∨ y ≈ y complete {x} {y} x≈x∧y = begin x ∨ y ≈⟨ ∨-cong x≈x∧y refl ⟩ (x ∧ y) ∨ y ≈⟨ ∨-cong (∧-comm x y) refl ⟩ (y ∧ x) ∨ y ≈⟨ ∨-comm (y ∧ x) y ⟩ y ∨ (y ∧ x) ≈⟨ proj₁ absorptive y x ⟩ y ∎ sound : ∀ {x y} → x ∨ y ≈ y → x ≤ y sound {x} {y} x∨y≈y = begin x ≈⟨ sym (∧-absorbs-∨ x y) ⟩ x ∧ (x ∨ y) ≈⟨ ∧-cong refl x∨y≈y ⟩ x ∧ y ∎ orderTheoreticLattice : R.Lattice _ _ _ orderTheoreticLattice = record { isLattice = isOrderTheoreticLattice } -- One can replace the underlying equality with an equivalent one. replace-equality : {_≈′_ : Rel Carrier l₂} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → Lattice _ _ replace-equality {_≈′_} ≈⇔≈′ = record { _≈_ = _≈′_ ; _∧_ = _∧_ ; _∨_ = _∨_ ; isLattice = record { isEquivalence = record { refl = to ⟨$⟩ refl ; sym = λ x≈y → to ⟨$⟩ sym (from ⟨$⟩ x≈y) ; trans = λ x≈y y≈z → to ⟨$⟩ trans (from ⟨$⟩ x≈y) (from ⟨$⟩ y≈z) } ; ∨-comm = λ x y → to ⟨$⟩ ∨-comm x y ; ∨-assoc = λ x y z → to ⟨$⟩ ∨-assoc x y z ; ∨-cong = λ x≈y u≈v → to ⟨$⟩ ∨-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) ; ∧-comm = λ x y → to ⟨$⟩ ∧-comm x y ; ∧-assoc = λ x y z → to ⟨$⟩ ∧-assoc x y z ; ∧-cong = λ x≈y u≈v → to ⟨$⟩ ∧-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) ; absorptive = (λ x y → to ⟨$⟩ proj₁ absorptive x y) , (λ x y → to ⟨$⟩ proj₂ absorptive x y) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) agda-stdlib-0.14/src/Algebra/Properties/Ring.agda000066400000000000000000000044411315545220200216100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.Ring {r₁ r₂} (R : Ring r₁ r₂) where import Algebra.Properties.AbelianGroup as AGP open import Data.Product open import Function import Relation.Binary.EqReasoning as EqR open Ring R open EqR setoid open AGP +-abelianGroup public renaming ( ⁻¹-involutive to -‿involutive ; left-identity-unique to +-left-identity-unique ; right-identity-unique to +-right-identity-unique ; identity-unique to +-identity-unique ; left-inverse-unique to +-left-inverse-unique ; right-inverse-unique to +-right-inverse-unique ; ⁻¹-∙-comm to -‿+-comm ) -‿*-distribˡ : ∀ x y → - x * y ≈ - (x * y) -‿*-distribˡ x y = begin - x * y ≈⟨ sym $ proj₂ +-identity _ ⟩ - x * y + 0# ≈⟨ refl ⟨ +-cong ⟩ sym (proj₂ -‿inverse _) ⟩ - x * y + (x * y + - (x * y)) ≈⟨ sym $ +-assoc _ _ _ ⟩ - x * y + x * y + - (x * y) ≈⟨ sym (proj₂ distrib _ _ _) ⟨ +-cong ⟩ refl ⟩ (- x + x) * y + - (x * y) ≈⟨ (proj₁ -‿inverse _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ 0# * y + - (x * y) ≈⟨ proj₁ zero _ ⟨ +-cong ⟩ refl ⟩ 0# + - (x * y) ≈⟨ proj₁ +-identity _ ⟩ - (x * y) ∎ -‿*-distribʳ : ∀ x y → x * - y ≈ - (x * y) -‿*-distribʳ x y = begin x * - y ≈⟨ sym $ proj₁ +-identity _ ⟩ 0# + x * - y ≈⟨ sym (proj₁ -‿inverse _) ⟨ +-cong ⟩ refl ⟩ - (x * y) + x * y + x * - y ≈⟨ +-assoc _ _ _ ⟩ - (x * y) + (x * y + x * - y) ≈⟨ refl ⟨ +-cong ⟩ sym (proj₁ distrib _ _ _) ⟩ - (x * y) + x * (y + - y) ≈⟨ refl ⟨ +-cong ⟩ (refl ⟨ *-cong ⟩ proj₂ -‿inverse _) ⟩ - (x * y) + x * 0# ≈⟨ refl ⟨ +-cong ⟩ proj₂ zero _ ⟩ - (x * y) + 0# ≈⟨ proj₂ +-identity _ ⟩ - (x * y) ∎ agda-stdlib-0.14/src/Algebra/RingSolver.agda000066400000000000000000000544271315545220200206600ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for commutative ring or semiring equalities ------------------------------------------------------------------------ -- Uses ideas from the Coq ring tactic. See "Proving Equalities in a -- Commutative Ring Done Right in Coq" by Grégoire and Mahboubi. The -- code below is not optimised like theirs, though (in particular, our -- Horner normal forms are not sparse). open import Algebra open import Algebra.RingSolver.AlmostCommutativeRing open import Relation.Binary module Algebra.RingSolver {r₁ r₂ r₃} (Coeff : RawRing r₁) -- Coefficient "ring". (R : AlmostCommutativeRing r₂ r₃) -- Main "ring". (morphism : Coeff -Raw-AlmostCommutative⟶ R) (_coeff≟_ : Decidable (Induced-equivalence morphism)) where import Algebra.RingSolver.Lemmas as L; open L Coeff R morphism private module C = RawRing Coeff open AlmostCommutativeRing R renaming (zero to zero*) import Algebra.FunctionProperties as P; open P _≈_ open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism renaming (⟦_⟧ to ⟦_⟧′) import Algebra.Operations as Ops; open Ops semiring open import Relation.Binary open import Relation.Nullary import Relation.Binary.EqReasoning as EqR; open EqR setoid import Relation.Binary.PropositionalEquality as PropEq import Relation.Binary.Reflection as Reflection open import Data.Empty open import Data.Product open import Data.Nat.Base as Nat using (ℕ; suc; zero) open import Data.Fin as Fin using (Fin; zero; suc) open import Data.Vec open import Function open import Level using (_⊔_) infix 9 :-_ -H_ -N_ infixr 9 _:^_ _^N_ infix 8 _*x+_ _*x+HN_ _*x+H_ infixl 8 _:*_ _*N_ _*H_ _*NH_ _*HN_ infixl 7 _:+_ _:-_ _+H_ _+N_ infix 4 _≈H_ _≈N_ ------------------------------------------------------------------------ -- Polynomials data Op : Set where [+] : Op [*] : Op -- The polynomials are indexed by the number of variables. data Polynomial (m : ℕ) : Set r₁ where op : (o : Op) (p₁ : Polynomial m) (p₂ : Polynomial m) → Polynomial m con : (c : C.Carrier) → Polynomial m var : (x : Fin m) → Polynomial m _:^_ : (p : Polynomial m) (n : ℕ) → Polynomial m :-_ : (p : Polynomial m) → Polynomial m -- Short-hand notation. _:+_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n _:+_ = op [+] _:*_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n _:*_ = op [*] _:-_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n x :- y = x :+ :- y -- Semantics. sem : Op → Op₂ Carrier sem [+] = _+_ sem [*] = _*_ ⟦_⟧ : ∀ {n} → Polynomial n → Vec Carrier n → Carrier ⟦ op o p₁ p₂ ⟧ ρ = ⟦ p₁ ⟧ ρ ⟨ sem o ⟩ ⟦ p₂ ⟧ ρ ⟦ con c ⟧ ρ = ⟦ c ⟧′ ⟦ var x ⟧ ρ = lookup x ρ ⟦ p :^ n ⟧ ρ = ⟦ p ⟧ ρ ^ n ⟦ :- p ⟧ ρ = - ⟦ p ⟧ ρ ------------------------------------------------------------------------ -- Normal forms of polynomials -- A univariate polynomial of degree d, -- -- p = a_d x^d + a_{d-1}x^{d-1} + … + a_0, -- -- is represented in Horner normal form by -- -- p = ((a_d x + a_{d-1})x + …)x + a_0. -- -- Note that Horner normal forms can be represented as lists, with the -- empty list standing for the zero polynomial of degree "-1". -- -- Given this representation of univariate polynomials over an -- arbitrary ring, polynomials in any number of variables over the -- ring C can be represented via the isomorphisms -- -- C[] ≅ C -- -- and -- -- C[X_0,...X_{n+1}] ≅ C[X_0,...,X_n][X_{n+1}]. mutual -- The polynomial representations are indexed by the polynomial's -- degree. data HNF : ℕ → Set r₁ where ∅ : ∀ {n} → HNF (suc n) _*x+_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) data Normal : ℕ → Set r₁ where con : C.Carrier → Normal zero poly : ∀ {n} → HNF (suc n) → Normal (suc n) -- Note that the data types above do /not/ ensure uniqueness of -- normal forms: the zero polynomial of degree one can be -- represented using both ∅ and ∅ *x+ con C.0#. mutual -- Semantics. ⟦_⟧H : ∀ {n} → HNF (suc n) → Vec Carrier (suc n) → Carrier ⟦ ∅ ⟧H _ = 0# ⟦ p *x+ c ⟧H (x ∷ ρ) = ⟦ p ⟧H (x ∷ ρ) * x + ⟦ c ⟧N ρ ⟦_⟧N : ∀ {n} → Normal n → Vec Carrier n → Carrier ⟦ con c ⟧N _ = ⟦ c ⟧′ ⟦ poly p ⟧N ρ = ⟦ p ⟧H ρ ------------------------------------------------------------------------ -- Equality and decidability mutual -- Equality. data _≈H_ : ∀ {n} → HNF n → HNF n → Set (r₁ ⊔ r₃) where ∅ : ∀ {n} → _≈H_ {suc n} ∅ ∅ _*x+_ : ∀ {n} {p₁ p₂ : HNF (suc n)} {c₁ c₂ : Normal n} → p₁ ≈H p₂ → c₁ ≈N c₂ → (p₁ *x+ c₁) ≈H (p₂ *x+ c₂) data _≈N_ : ∀ {n} → Normal n → Normal n → Set (r₁ ⊔ r₃) where con : ∀ {c₁ c₂} → ⟦ c₁ ⟧′ ≈ ⟦ c₂ ⟧′ → con c₁ ≈N con c₂ poly : ∀ {n} {p₁ p₂ : HNF (suc n)} → p₁ ≈H p₂ → poly p₁ ≈N poly p₂ mutual -- Equality is decidable. _≟H_ : ∀ {n} → Decidable (_≈H_ {n = n}) ∅ ≟H ∅ = yes ∅ ∅ ≟H (_ *x+ _) = no λ() (_ *x+ _) ≟H ∅ = no λ() (p₁ *x+ c₁) ≟H (p₂ *x+ c₂) with p₁ ≟H p₂ | c₁ ≟N c₂ ... | yes p₁≈p₂ | yes c₁≈c₂ = yes (p₁≈p₂ *x+ c₁≈c₂) ... | _ | no c₁≉c₂ = no λ { (_ *x+ c₁≈c₂) → c₁≉c₂ c₁≈c₂ } ... | no p₁≉p₂ | _ = no λ { (p₁≈p₂ *x+ _) → p₁≉p₂ p₁≈p₂ } _≟N_ : ∀ {n} → Decidable (_≈N_ {n = n}) con c₁ ≟N con c₂ with c₁ coeff≟ c₂ ... | yes c₁≈c₂ = yes (con c₁≈c₂) ... | no c₁≉c₂ = no λ { (con c₁≈c₂) → c₁≉c₂ c₁≈c₂} poly p₁ ≟N poly p₂ with p₁ ≟H p₂ ... | yes p₁≈p₂ = yes (poly p₁≈p₂) ... | no p₁≉p₂ = no λ { (poly p₁≈p₂) → p₁≉p₂ p₁≈p₂ } mutual -- The semantics respect the equality relations defined above. ⟦_⟧H-cong : ∀ {n} {p₁ p₂ : HNF (suc n)} → p₁ ≈H p₂ → ∀ ρ → ⟦ p₁ ⟧H ρ ≈ ⟦ p₂ ⟧H ρ ⟦ ∅ ⟧H-cong _ = refl ⟦ p₁≈p₂ *x+ c₁≈c₂ ⟧H-cong (x ∷ ρ) = (⟦ p₁≈p₂ ⟧H-cong (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ ⟦ c₁≈c₂ ⟧N-cong ρ ⟦_⟧N-cong : ∀ {n} {p₁ p₂ : Normal n} → p₁ ≈N p₂ → ∀ ρ → ⟦ p₁ ⟧N ρ ≈ ⟦ p₂ ⟧N ρ ⟦ con c₁≈c₂ ⟧N-cong _ = c₁≈c₂ ⟦ poly p₁≈p₂ ⟧N-cong ρ = ⟦ p₁≈p₂ ⟧H-cong ρ ------------------------------------------------------------------------ -- Ring operations on Horner normal forms -- Zero. 0H : ∀ {n} → HNF (suc n) 0H = ∅ 0N : ∀ {n} → Normal n 0N {zero} = con C.0# 0N {suc n} = poly 0H mutual -- One. 1H : ∀ {n} → HNF (suc n) 1H {n} = ∅ *x+ 1N {n} 1N : ∀ {n} → Normal n 1N {zero} = con C.1# 1N {suc n} = poly 1H -- A simplifying variant of _*x+_. _*x+HN_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) (p *x+ c′) *x+HN c = (p *x+ c′) *x+ c ∅ *x+HN c with c ≟N 0N ... | yes c≈0 = ∅ ... | no c≉0 = ∅ *x+ c mutual -- Addition. _+H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) ∅ +H p = p p +H ∅ = p (p₁ *x+ c₁) +H (p₂ *x+ c₂) = (p₁ +H p₂) *x+HN (c₁ +N c₂) _+N_ : ∀ {n} → Normal n → Normal n → Normal n con c₁ +N con c₂ = con (c₁ C.+ c₂) poly p₁ +N poly p₂ = poly (p₁ +H p₂) -- Multiplication. _*x+H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) p₁ *x+H (p₂ *x+ c) = (p₁ +H p₂) *x+HN c ∅ *x+H ∅ = ∅ (p₁ *x+ c) *x+H ∅ = (p₁ *x+ c) *x+ 0N mutual _*NH_ : ∀ {n} → Normal n → HNF (suc n) → HNF (suc n) c *NH ∅ = ∅ c *NH (p *x+ c′) with c ≟N 0N ... | yes c≈0 = ∅ ... | no c≉0 = (c *NH p) *x+ (c *N c′) _*HN_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) ∅ *HN c = ∅ (p *x+ c′) *HN c with c ≟N 0N ... | yes c≈0 = ∅ ... | no c≉0 = (p *HN c) *x+ (c′ *N c) _*H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) ∅ *H _ = ∅ (_ *x+ _) *H ∅ = ∅ (p₁ *x+ c₁) *H (p₂ *x+ c₂) = ((p₁ *H p₂) *x+H (p₁ *HN c₂ +H c₁ *NH p₂)) *x+HN (c₁ *N c₂) _*N_ : ∀ {n} → Normal n → Normal n → Normal n con c₁ *N con c₂ = con (c₁ C.* c₂) poly p₁ *N poly p₂ = poly (p₁ *H p₂) -- Exponentiation. _^N_ : ∀ {n} → Normal n → ℕ → Normal n p ^N zero = 1N p ^N suc n = p *N (p ^N n) mutual -- Negation. -H_ : ∀ {n} → HNF (suc n) → HNF (suc n) -H p = (-N 1N) *NH p -N_ : ∀ {n} → Normal n → Normal n -N con c = con (C.- c) -N poly p = poly (-H p) ------------------------------------------------------------------------ -- Normalisation normalise-con : ∀ {n} → C.Carrier → Normal n normalise-con {zero} c = con c normalise-con {suc n} c = poly (∅ *x+HN normalise-con c) normalise-var : ∀ {n} → Fin n → Normal n normalise-var zero = poly ((∅ *x+ 1N) *x+ 0N) normalise-var (suc i) = poly (∅ *x+HN normalise-var i) normalise : ∀ {n} → Polynomial n → Normal n normalise (op [+] t₁ t₂) = normalise t₁ +N normalise t₂ normalise (op [*] t₁ t₂) = normalise t₁ *N normalise t₂ normalise (con c) = normalise-con c normalise (var i) = normalise-var i normalise (t :^ k) = normalise t ^N k normalise (:- t) = -N normalise t -- Evaluation after normalisation. ⟦_⟧↓ : ∀ {n} → Polynomial n → Vec Carrier n → Carrier ⟦ p ⟧↓ ρ = ⟦ normalise p ⟧N ρ ------------------------------------------------------------------------ -- Homomorphism lemmas 0N-homo : ∀ {n} ρ → ⟦ 0N {n} ⟧N ρ ≈ 0# 0N-homo [] = 0-homo 0N-homo (x ∷ ρ) = refl -- If c is equal to 0N, then c is semantically equal to 0#. 0≈⟦0⟧ : ∀ {n} {c : Normal n} → c ≈N 0N → ∀ ρ → 0# ≈ ⟦ c ⟧N ρ 0≈⟦0⟧ {c = c} c≈0 ρ = sym (begin ⟦ c ⟧N ρ ≈⟨ ⟦ c≈0 ⟧N-cong ρ ⟩ ⟦ 0N ⟧N ρ ≈⟨ 0N-homo ρ ⟩ 0# ∎) 1N-homo : ∀ {n} ρ → ⟦ 1N {n} ⟧N ρ ≈ 1# 1N-homo [] = 1-homo 1N-homo (x ∷ ρ) = begin 0# * x + ⟦ 1N ⟧N ρ ≈⟨ refl ⟨ +-cong ⟩ 1N-homo ρ ⟩ 0# * x + 1# ≈⟨ lemma₆ _ _ ⟩ 1# ∎ -- _*x+HN_ is equal to _*x+_. *x+HN≈*x+ : ∀ {n} (p : HNF (suc n)) (c : Normal n) → ∀ ρ → ⟦ p *x+HN c ⟧H ρ ≈ ⟦ p *x+ c ⟧H ρ *x+HN≈*x+ (p *x+ c′) c ρ = refl *x+HN≈*x+ ∅ c (x ∷ ρ) with c ≟N 0N ... | yes c≈0 = begin 0# ≈⟨ 0≈⟦0⟧ c≈0 ρ ⟩ ⟦ c ⟧N ρ ≈⟨ sym $ lemma₆ _ _ ⟩ 0# * x + ⟦ c ⟧N ρ ∎ ... | no c≉0 = refl ∅*x+HN-homo : ∀ {n} (c : Normal n) x ρ → ⟦ ∅ *x+HN c ⟧H (x ∷ ρ) ≈ ⟦ c ⟧N ρ ∅*x+HN-homo c x ρ with c ≟N 0N ... | yes c≈0 = 0≈⟦0⟧ c≈0 ρ ... | no c≉0 = lemma₆ _ _ mutual +H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) → ∀ ρ → ⟦ p₁ +H p₂ ⟧H ρ ≈ ⟦ p₁ ⟧H ρ + ⟦ p₂ ⟧H ρ +H-homo ∅ p₂ ρ = sym (proj₁ +-identity _) +H-homo (p₁ *x+ x₁) ∅ ρ = sym (proj₂ +-identity _) +H-homo (p₁ *x+ c₁) (p₂ *x+ c₂) (x ∷ ρ) = begin ⟦ (p₁ +H p₂) *x+HN (c₁ +N c₂) ⟧H (x ∷ ρ) ≈⟨ *x+HN≈*x+ (p₁ +H p₂) (c₁ +N c₂) (x ∷ ρ) ⟩ ⟦ p₁ +H p₂ ⟧H (x ∷ ρ) * x + ⟦ c₁ +N c₂ ⟧N ρ ≈⟨ (+H-homo p₁ p₂ (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ +N-homo c₁ c₂ ρ ⟩ (⟦ p₁ ⟧H (x ∷ ρ) + ⟦ p₂ ⟧H (x ∷ ρ)) * x + (⟦ c₁ ⟧N ρ + ⟦ c₂ ⟧N ρ) ≈⟨ lemma₁ _ _ _ _ _ ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * x + ⟦ c₁ ⟧N ρ) + (⟦ p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ) ∎ +N-homo : ∀ {n} (p₁ p₂ : Normal n) → ∀ ρ → ⟦ p₁ +N p₂ ⟧N ρ ≈ ⟦ p₁ ⟧N ρ + ⟦ p₂ ⟧N ρ +N-homo (con c₁) (con c₂) _ = +-homo _ _ +N-homo (poly p₁) (poly p₂) ρ = +H-homo p₁ p₂ ρ *x+H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) x ρ → ⟦ p₁ *x+H p₂ ⟧H (x ∷ ρ) ≈ ⟦ p₁ ⟧H (x ∷ ρ) * x + ⟦ p₂ ⟧H (x ∷ ρ) *x+H-homo ∅ ∅ _ _ = sym $ lemma₆ _ _ *x+H-homo (p *x+ c) ∅ x ρ = begin ⟦ p *x+ c ⟧H (x ∷ ρ) * x + ⟦ 0N ⟧N ρ ≈⟨ refl ⟨ +-cong ⟩ 0N-homo ρ ⟩ ⟦ p *x+ c ⟧H (x ∷ ρ) * x + 0# ∎ *x+H-homo p₁ (p₂ *x+ c₂) x ρ = begin ⟦ (p₁ +H p₂) *x+HN c₂ ⟧H (x ∷ ρ) ≈⟨ *x+HN≈*x+ (p₁ +H p₂) c₂ (x ∷ ρ) ⟩ ⟦ p₁ +H p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ ≈⟨ (+H-homo p₁ p₂ (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₁ ⟧H (x ∷ ρ) + ⟦ p₂ ⟧H (x ∷ ρ)) * x + ⟦ c₂ ⟧N ρ ≈⟨ lemma₀ _ _ _ _ ⟩ ⟦ p₁ ⟧H (x ∷ ρ) * x + (⟦ p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ) ∎ mutual *NH-homo : ∀ {n} (c : Normal n) (p : HNF (suc n)) x ρ → ⟦ c *NH p ⟧H (x ∷ ρ) ≈ ⟦ c ⟧N ρ * ⟦ p ⟧H (x ∷ ρ) *NH-homo c ∅ x ρ = sym (proj₂ zero* _) *NH-homo c (p *x+ c′) x ρ with c ≟N 0N ... | yes c≈0 = begin 0# ≈⟨ sym (proj₁ zero* _) ⟩ 0# * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ≈⟨ 0≈⟦0⟧ c≈0 ρ ⟨ *-cong ⟩ refl ⟩ ⟦ c ⟧N ρ * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ∎ ... | no c≉0 = begin ⟦ c *NH p ⟧H (x ∷ ρ) * x + ⟦ c *N c′ ⟧N ρ ≈⟨ (*NH-homo c p x ρ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c c′ ρ ⟩ (⟦ c ⟧N ρ * ⟦ p ⟧H (x ∷ ρ)) * x + (⟦ c ⟧N ρ * ⟦ c′ ⟧N ρ) ≈⟨ lemma₃ _ _ _ _ ⟩ ⟦ c ⟧N ρ * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ∎ *HN-homo : ∀ {n} (p : HNF (suc n)) (c : Normal n) x ρ → ⟦ p *HN c ⟧H (x ∷ ρ) ≈ ⟦ p ⟧H (x ∷ ρ) * ⟦ c ⟧N ρ *HN-homo ∅ c x ρ = sym (proj₁ zero* _) *HN-homo (p *x+ c′) c x ρ with c ≟N 0N ... | yes c≈0 = begin 0# ≈⟨ sym (proj₂ zero* _) ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * 0# ≈⟨ refl ⟨ *-cong ⟩ 0≈⟦0⟧ c≈0 ρ ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * ⟦ c ⟧N ρ ∎ ... | no c≉0 = begin ⟦ p *HN c ⟧H (x ∷ ρ) * x + ⟦ c′ *N c ⟧N ρ ≈⟨ (*HN-homo p c x ρ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c′ c ρ ⟩ (⟦ p ⟧H (x ∷ ρ) * ⟦ c ⟧N ρ) * x + (⟦ c′ ⟧N ρ * ⟦ c ⟧N ρ) ≈⟨ lemma₂ _ _ _ _ ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * ⟦ c ⟧N ρ ∎ *H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) → ∀ ρ → ⟦ p₁ *H p₂ ⟧H ρ ≈ ⟦ p₁ ⟧H ρ * ⟦ p₂ ⟧H ρ *H-homo ∅ p₂ ρ = sym $ proj₁ zero* _ *H-homo (p₁ *x+ c₁) ∅ ρ = sym $ proj₂ zero* _ *H-homo (p₁ *x+ c₁) (p₂ *x+ c₂) (x ∷ ρ) = begin ⟦ ((p₁ *H p₂) *x+H ((p₁ *HN c₂) +H (c₁ *NH p₂))) *x+HN (c₁ *N c₂) ⟧H (x ∷ ρ) ≈⟨ *x+HN≈*x+ ((p₁ *H p₂) *x+H ((p₁ *HN c₂) +H (c₁ *NH p₂))) (c₁ *N c₂) (x ∷ ρ) ⟩ ⟦ (p₁ *H p₂) *x+H ((p₁ *HN c₂) +H (c₁ *NH p₂)) ⟧H (x ∷ ρ) * x + ⟦ c₁ *N c₂ ⟧N ρ ≈⟨ (*x+H-homo (p₁ *H p₂) ((p₁ *HN c₂) +H (c₁ *NH p₂)) x ρ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c₁ c₂ ρ ⟩ (⟦ p₁ *H p₂ ⟧H (x ∷ ρ) * x + ⟦ (p₁ *HN c₂) +H (c₁ *NH p₂) ⟧H (x ∷ ρ)) * x + ⟦ c₁ ⟧N ρ * ⟦ c₂ ⟧N ρ ≈⟨ (((*H-homo p₁ p₂ (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ (+H-homo (p₁ *HN c₂) (c₁ *NH p₂) (x ∷ ρ))) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * ⟦ p₂ ⟧H (x ∷ ρ) * x + (⟦ p₁ *HN c₂ ⟧H (x ∷ ρ) + ⟦ c₁ *NH p₂ ⟧H (x ∷ ρ))) * x + ⟦ c₁ ⟧N ρ * ⟦ c₂ ⟧N ρ ≈⟨ ((refl ⟨ +-cong ⟩ (*HN-homo p₁ c₂ x ρ ⟨ +-cong ⟩ *NH-homo c₁ p₂ x ρ)) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * ⟦ p₂ ⟧H (x ∷ ρ) * x + (⟦ p₁ ⟧H (x ∷ ρ) * ⟦ c₂ ⟧N ρ + ⟦ c₁ ⟧N ρ * ⟦ p₂ ⟧H (x ∷ ρ))) * x + (⟦ c₁ ⟧N ρ * ⟦ c₂ ⟧N ρ) ≈⟨ lemma₄ _ _ _ _ _ ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * x + ⟦ c₁ ⟧N ρ) * (⟦ p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ) ∎ *N-homo : ∀ {n} (p₁ p₂ : Normal n) → ∀ ρ → ⟦ p₁ *N p₂ ⟧N ρ ≈ ⟦ p₁ ⟧N ρ * ⟦ p₂ ⟧N ρ *N-homo (con c₁) (con c₂) _ = *-homo _ _ *N-homo (poly p₁) (poly p₂) ρ = *H-homo p₁ p₂ ρ ^N-homo : ∀ {n} (p : Normal n) (k : ℕ) → ∀ ρ → ⟦ p ^N k ⟧N ρ ≈ ⟦ p ⟧N ρ ^ k ^N-homo p zero ρ = 1N-homo ρ ^N-homo p (suc k) ρ = begin ⟦ p *N (p ^N k) ⟧N ρ ≈⟨ *N-homo p (p ^N k) ρ ⟩ ⟦ p ⟧N ρ * ⟦ p ^N k ⟧N ρ ≈⟨ refl ⟨ *-cong ⟩ ^N-homo p k ρ ⟩ ⟦ p ⟧N ρ * (⟦ p ⟧N ρ ^ k) ∎ mutual -H‿-homo : ∀ {n} (p : HNF (suc n)) → ∀ ρ → ⟦ -H p ⟧H ρ ≈ - ⟦ p ⟧H ρ -H‿-homo p (x ∷ ρ) = begin ⟦ (-N 1N) *NH p ⟧H (x ∷ ρ) ≈⟨ *NH-homo (-N 1N) p x ρ ⟩ ⟦ -N 1N ⟧N ρ * ⟦ p ⟧H (x ∷ ρ) ≈⟨ trans (-N‿-homo 1N ρ) (-‿cong (1N-homo ρ)) ⟨ *-cong ⟩ refl ⟩ - 1# * ⟦ p ⟧H (x ∷ ρ) ≈⟨ lemma₇ _ ⟩ - ⟦ p ⟧H (x ∷ ρ) ∎ -N‿-homo : ∀ {n} (p : Normal n) → ∀ ρ → ⟦ -N p ⟧N ρ ≈ - ⟦ p ⟧N ρ -N‿-homo (con c) _ = -‿homo _ -N‿-homo (poly p) ρ = -H‿-homo p ρ ------------------------------------------------------------------------ -- Correctness correct-con : ∀ {n} (c : C.Carrier) (ρ : Vec Carrier n) → ⟦ normalise-con c ⟧N ρ ≈ ⟦ c ⟧′ correct-con c [] = refl correct-con c (x ∷ ρ) = begin ⟦ ∅ *x+HN normalise-con c ⟧H (x ∷ ρ) ≈⟨ ∅*x+HN-homo (normalise-con c) x ρ ⟩ ⟦ normalise-con c ⟧N ρ ≈⟨ correct-con c ρ ⟩ ⟦ c ⟧′ ∎ correct-var : ∀ {n} (i : Fin n) → ∀ ρ → ⟦ normalise-var i ⟧N ρ ≈ lookup i ρ correct-var () [] correct-var (suc i) (x ∷ ρ) = begin ⟦ ∅ *x+HN normalise-var i ⟧H (x ∷ ρ) ≈⟨ ∅*x+HN-homo (normalise-var i) x ρ ⟩ ⟦ normalise-var i ⟧N ρ ≈⟨ correct-var i ρ ⟩ lookup i ρ ∎ correct-var zero (x ∷ ρ) = begin (0# * x + ⟦ 1N ⟧N ρ) * x + ⟦ 0N ⟧N ρ ≈⟨ ((refl ⟨ +-cong ⟩ 1N-homo ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ 0N-homo ρ ⟩ (0# * x + 1#) * x + 0# ≈⟨ lemma₅ _ ⟩ x ∎ correct : ∀ {n} (p : Polynomial n) → ∀ ρ → ⟦ p ⟧↓ ρ ≈ ⟦ p ⟧ ρ correct (op [+] p₁ p₂) ρ = begin ⟦ normalise p₁ +N normalise p₂ ⟧N ρ ≈⟨ +N-homo (normalise p₁) (normalise p₂) ρ ⟩ ⟦ p₁ ⟧↓ ρ + ⟦ p₂ ⟧↓ ρ ≈⟨ correct p₁ ρ ⟨ +-cong ⟩ correct p₂ ρ ⟩ ⟦ p₁ ⟧ ρ + ⟦ p₂ ⟧ ρ ∎ correct (op [*] p₁ p₂) ρ = begin ⟦ normalise p₁ *N normalise p₂ ⟧N ρ ≈⟨ *N-homo (normalise p₁) (normalise p₂) ρ ⟩ ⟦ p₁ ⟧↓ ρ * ⟦ p₂ ⟧↓ ρ ≈⟨ correct p₁ ρ ⟨ *-cong ⟩ correct p₂ ρ ⟩ ⟦ p₁ ⟧ ρ * ⟦ p₂ ⟧ ρ ∎ correct (con c) ρ = correct-con c ρ correct (var i) ρ = correct-var i ρ correct (p :^ k) ρ = begin ⟦ normalise p ^N k ⟧N ρ ≈⟨ ^N-homo (normalise p) k ρ ⟩ ⟦ p ⟧↓ ρ ^ k ≈⟨ correct p ρ ⟨ ^-cong ⟩ PropEq.refl {x = k} ⟩ ⟦ p ⟧ ρ ^ k ∎ correct (:- p) ρ = begin ⟦ -N normalise p ⟧N ρ ≈⟨ -N‿-homo (normalise p) ρ ⟩ - ⟦ p ⟧↓ ρ ≈⟨ -‿cong (correct p ρ) ⟩ - ⟦ p ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactics" open Reflection setoid var ⟦_⟧ ⟦_⟧↓ correct public using (prove; solve) renaming (_⊜_ to _:=_) -- For examples of how solve and _:=_ can be used to -- semi-automatically prove ring equalities, see, for instance, -- Data.Digit or Data.Nat.DivMod. agda-stdlib-0.14/src/Algebra/RingSolver/000077500000000000000000000000001315545220200200265ustar00rootroot00000000000000agda-stdlib-0.14/src/Algebra/RingSolver/AlmostCommutativeRing.agda000066400000000000000000000114501315545220200251420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Commutative semirings with some additional structure ("almost" -- commutative rings), used by the ring solver ------------------------------------------------------------------------ module Algebra.RingSolver.AlmostCommutativeRing where open import Relation.Binary open import Algebra open import Algebra.Structures open import Algebra.FunctionProperties import Algebra.Morphism as Morphism open import Function open import Level ------------------------------------------------------------------------ -- Definitions record IsAlmostCommutativeRing {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) (_+_ _*_ : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# -‿cong : -_ Preserves _≈_ ⟶ _≈_ -‿*-distribˡ : ∀ x y → ((- x) * y) ≈ (- (x * y)) -‿+-comm : ∀ x y → ((- x) + (- y)) ≈ (- (x + y)) open IsCommutativeSemiring isCommutativeSemiring public record AlmostCommutativeRing c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier isAlmostCommutativeRing : IsAlmostCommutativeRing _≈_ _+_ _*_ -_ 0# 1# open IsAlmostCommutativeRing isAlmostCommutativeRing public commutativeSemiring : CommutativeSemiring _ _ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open CommutativeSemiring commutativeSemiring public using ( setoid ; +-semigroup; +-monoid; +-commutativeMonoid ; *-semigroup; *-monoid; *-commutativeMonoid ; semiring ) rawRing : RawRing _ rawRing = record { _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0# ; 1# = 1# } ------------------------------------------------------------------------ -- Homomorphisms record _-Raw-AlmostCommutative⟶_ {r₁ r₂ r₃} (From : RawRing r₁) (To : AlmostCommutativeRing r₂ r₃) : Set (r₁ ⊔ r₂ ⊔ r₃) where private module F = RawRing From module T = AlmostCommutativeRing To open Morphism.Definitions F.Carrier T.Carrier T._≈_ field ⟦_⟧ : Morphism +-homo : Homomorphic₂ ⟦_⟧ F._+_ T._+_ *-homo : Homomorphic₂ ⟦_⟧ F._*_ T._*_ -‿homo : Homomorphic₁ ⟦_⟧ F.-_ T.-_ 0-homo : Homomorphic₀ ⟦_⟧ F.0# T.0# 1-homo : Homomorphic₀ ⟦_⟧ F.1# T.1# -raw-almostCommutative⟶ : ∀ {r₁ r₂} (R : AlmostCommutativeRing r₁ r₂) → AlmostCommutativeRing.rawRing R -Raw-AlmostCommutative⟶ R -raw-almostCommutative⟶ R = record { ⟦_⟧ = id ; +-homo = λ _ _ → refl ; *-homo = λ _ _ → refl ; -‿homo = λ _ → refl ; 0-homo = refl ; 1-homo = refl } where open AlmostCommutativeRing R -- A homomorphism induces a notion of equivalence on the raw ring. Induced-equivalence : ∀ {c₁ c₂ ℓ} {Coeff : RawRing c₁} {R : AlmostCommutativeRing c₂ ℓ} → Coeff -Raw-AlmostCommutative⟶ R → Rel (RawRing.Carrier Coeff) ℓ Induced-equivalence {R = R} morphism a b = ⟦ a ⟧ ≈ ⟦ b ⟧ where open AlmostCommutativeRing R open _-Raw-AlmostCommutative⟶_ morphism ------------------------------------------------------------------------ -- Conversions -- Commutative rings are almost commutative rings. fromCommutativeRing : ∀ {r₁ r₂} → CommutativeRing r₁ r₂ → AlmostCommutativeRing _ _ fromCommutativeRing CR = record { isAlmostCommutativeRing = record { isCommutativeSemiring = isCommutativeSemiring ; -‿cong = -‿cong ; -‿*-distribˡ = -‿*-distribˡ ; -‿+-comm = ⁻¹-∙-comm } } where open CommutativeRing CR import Algebra.Properties.Ring as R; open R ring import Algebra.Properties.AbelianGroup as AG; open AG +-abelianGroup -- Commutative semirings can be viewed as almost commutative rings by -- using identity as the "almost negation". fromCommutativeSemiring : ∀ {r₁ r₂} → CommutativeSemiring r₁ r₂ → AlmostCommutativeRing _ _ fromCommutativeSemiring CS = record { -_ = id ; isAlmostCommutativeRing = record { isCommutativeSemiring = isCommutativeSemiring ; -‿cong = id ; -‿*-distribˡ = λ _ _ → refl ; -‿+-comm = λ _ _ → refl } } where open CommutativeSemiring CS agda-stdlib-0.14/src/Algebra/RingSolver/Lemmas.agda000066400000000000000000000113641315545220200220670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some boring lemmas used by the ring solver ------------------------------------------------------------------------ -- Note that these proofs use all "almost commutative ring" properties. open import Algebra open import Algebra.RingSolver.AlmostCommutativeRing module Algebra.RingSolver.Lemmas {r₁ r₂ r₃} (coeff : RawRing r₁) (r : AlmostCommutativeRing r₂ r₃) (morphism : coeff -Raw-AlmostCommutative⟶ r) where private module C = RawRing coeff open AlmostCommutativeRing r open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Data.Product lemma₀ : ∀ a b c x → (a + b) * x + c ≈ a * x + (b * x + c) lemma₀ a b c x = begin (a + b) * x + c ≈⟨ proj₂ distrib _ _ _ ⟨ +-cong ⟩ refl ⟩ (a * x + b * x) + c ≈⟨ +-assoc _ _ _ ⟩ a * x + (b * x + c) ∎ lemma₁ : ∀ a b c d x → (a + b) * x + (c + d) ≈ (a * x + c) + (b * x + d) lemma₁ a b c d x = begin (a + b) * x + (c + d) ≈⟨ lemma₀ _ _ _ _ ⟩ a * x + (b * x + (c + d)) ≈⟨ refl ⟨ +-cong ⟩ sym (+-assoc _ _ _) ⟩ a * x + ((b * x + c) + d) ≈⟨ refl ⟨ +-cong ⟩ (+-comm _ _ ⟨ +-cong ⟩ refl) ⟩ a * x + ((c + b * x) + d) ≈⟨ refl ⟨ +-cong ⟩ +-assoc _ _ _ ⟩ a * x + (c + (b * x + d)) ≈⟨ sym $ +-assoc _ _ _ ⟩ (a * x + c) + (b * x + d) ∎ lemma₂ : ∀ a b c x → a * c * x + b * c ≈ (a * x + b) * c lemma₂ a b c x = begin a * c * x + b * c ≈⟨ lem ⟨ +-cong ⟩ refl ⟩ a * x * c + b * c ≈⟨ sym $ proj₂ distrib _ _ _ ⟩ (a * x + b) * c ∎ where lem = begin a * c * x ≈⟨ *-assoc _ _ _ ⟩ a * (c * x) ≈⟨ refl ⟨ *-cong ⟩ *-comm _ _ ⟩ a * (x * c) ≈⟨ sym $ *-assoc _ _ _ ⟩ a * x * c ∎ lemma₃ : ∀ a b c x → a * b * x + a * c ≈ a * (b * x + c) lemma₃ a b c x = begin a * b * x + a * c ≈⟨ *-assoc _ _ _ ⟨ +-cong ⟩ refl ⟩ a * (b * x) + a * c ≈⟨ sym $ proj₁ distrib _ _ _ ⟩ a * (b * x + c) ∎ lemma₄ : ∀ a b c d x → (a * c * x + (a * d + b * c)) * x + b * d ≈ (a * x + b) * (c * x + d) lemma₄ a b c d x = begin (a * c * x + (a * d + b * c)) * x + b * d ≈⟨ proj₂ distrib _ _ _ ⟨ +-cong ⟩ refl ⟩ (a * c * x * x + (a * d + b * c) * x) + b * d ≈⟨ refl ⟨ +-cong ⟩ ((refl ⟨ +-cong ⟩ refl) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (a * c * x * x + (a * d + b * c) * x) + b * d ≈⟨ +-assoc _ _ _ ⟩ a * c * x * x + ((a * d + b * c) * x + b * d) ≈⟨ lem₁ ⟨ +-cong ⟩ (lem₂ ⟨ +-cong ⟩ refl) ⟩ a * x * (c * x) + (a * x * d + b * (c * x) + b * d) ≈⟨ refl ⟨ +-cong ⟩ +-assoc _ _ _ ⟩ a * x * (c * x) + (a * x * d + (b * (c * x) + b * d)) ≈⟨ sym $ +-assoc _ _ _ ⟩ a * x * (c * x) + a * x * d + (b * (c * x) + b * d) ≈⟨ sym $ proj₁ distrib _ _ _ ⟨ +-cong ⟩ proj₁ distrib _ _ _ ⟩ a * x * (c * x + d) + b * (c * x + d) ≈⟨ sym $ proj₂ distrib _ _ _ ⟩ (a * x + b) * (c * x + d) ∎ where lem₁′ = begin a * c * x ≈⟨ *-assoc _ _ _ ⟩ a * (c * x) ≈⟨ refl ⟨ *-cong ⟩ *-comm _ _ ⟩ a * (x * c) ≈⟨ sym $ *-assoc _ _ _ ⟩ a * x * c ∎ lem₁ = begin a * c * x * x ≈⟨ lem₁′ ⟨ *-cong ⟩ refl ⟩ a * x * c * x ≈⟨ *-assoc _ _ _ ⟩ a * x * (c * x) ∎ lem₂ = begin (a * d + b * c) * x ≈⟨ proj₂ distrib _ _ _ ⟩ a * d * x + b * c * x ≈⟨ *-assoc _ _ _ ⟨ +-cong ⟩ *-assoc _ _ _ ⟩ a * (d * x) + b * (c * x) ≈⟨ (refl ⟨ *-cong ⟩ *-comm _ _) ⟨ +-cong ⟩ refl ⟩ a * (x * d) + b * (c * x) ≈⟨ sym $ *-assoc _ _ _ ⟨ +-cong ⟩ refl ⟩ a * x * d + b * (c * x) ∎ lemma₅ : ∀ x → (0# * x + 1#) * x + 0# ≈ x lemma₅ x = begin (0# * x + 1#) * x + 0# ≈⟨ ((zeroˡ _ ⟨ +-cong ⟩ refl) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (0# + 1#) * x + 0# ≈⟨ (proj₁ +-identity _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ 1# * x + 0# ≈⟨ proj₂ +-identity _ ⟩ 1# * x ≈⟨ proj₁ *-identity _ ⟩ x ∎ lemma₆ : ∀ a x → 0# * x + a ≈ a lemma₆ a x = begin 0# * x + a ≈⟨ zeroˡ _ ⟨ +-cong ⟩ refl ⟩ 0# + a ≈⟨ proj₁ +-identity _ ⟩ a ∎ lemma₇ : ∀ x → - 1# * x ≈ - x lemma₇ x = begin - 1# * x ≈⟨ -‿*-distribˡ _ _ ⟩ - (1# * x) ≈⟨ -‿cong (proj₁ *-identity _) ⟩ - x ∎ agda-stdlib-0.14/src/Algebra/RingSolver/Natural-coefficients.agda000066400000000000000000000045001315545220200247100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver, using the natural numbers as the -- coefficient "ring" ------------------------------------------------------------------------ open import Algebra import Algebra.Operations open import Relation.Nullary module Algebra.RingSolver.Natural-coefficients {r₁ r₂} (R : CommutativeSemiring r₁ r₂) (dec : let open CommutativeSemiring R open Algebra.Operations semiring in ∀ m n → Dec (m × 1# ≈ n × 1#)) where import Algebra.RingSolver open import Algebra.RingSolver.AlmostCommutativeRing open import Data.Nat.Base as ℕ open import Data.Product using (module Σ) open import Function import Relation.Binary.EqReasoning import Relation.Nullary.Decidable as Dec open CommutativeSemiring R open Algebra.Operations semiring open Relation.Binary.EqReasoning setoid private -- The coefficient "ring". ℕ-ring : RawRing _ ℕ-ring = record { Carrier = ℕ ; _+_ = ℕ._+_ ; _*_ = ℕ._*_ ; -_ = id ; 0# = 0 ; 1# = 1 } -- There is a homomorphism from ℕ to R. -- -- Note that _×′_ is used rather than _×_. If _×_ were used, then -- Function.Related.TypeIsomorphisms.test would fail to type-check. homomorphism : ℕ-ring -Raw-AlmostCommutative⟶ fromCommutativeSemiring R homomorphism = record { ⟦_⟧ = λ n → n ×′ 1# ; +-homo = ×′-homo-+ 1# ; *-homo = ×′1-homo-* ; -‿homo = λ _ → refl ; 0-homo = refl ; 1-homo = refl } -- Equality of certain expressions can be decided. dec′ : ∀ m n → Dec (m ×′ 1# ≈ n ×′ 1#) dec′ m n = Dec.map′ to from (dec m n) where to : m × 1# ≈ n × 1# → m ×′ 1# ≈ n ×′ 1# to m≈n = begin m ×′ 1# ≈⟨ sym $ ×≈×′ m 1# ⟩ m × 1# ≈⟨ m≈n ⟩ n × 1# ≈⟨ ×≈×′ n 1# ⟩ n ×′ 1# ∎ from : m ×′ 1# ≈ n ×′ 1# → m × 1# ≈ n × 1# from m≈n = begin m × 1# ≈⟨ ×≈×′ m 1# ⟩ m ×′ 1# ≈⟨ m≈n ⟩ n ×′ 1# ≈⟨ sym $ ×≈×′ n 1# ⟩ n × 1# ∎ -- The instantiation. open Algebra.RingSolver _ _ homomorphism dec′ public agda-stdlib-0.14/src/Algebra/RingSolver/Simple.agda000066400000000000000000000012041315545220200220720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver with two copies of the same ring with -- decidable equality ------------------------------------------------------------------------ open import Algebra.RingSolver.AlmostCommutativeRing open import Relation.Binary module Algebra.RingSolver.Simple {r₁ r₂} (R : AlmostCommutativeRing r₁ r₂) (_≟_ : Decidable (AlmostCommutativeRing._≈_ R)) where open AlmostCommutativeRing R import Algebra.RingSolver as RS open RS rawRing R (-raw-almostCommutative⟶ R) _≟_ public agda-stdlib-0.14/src/Algebra/Structures.agda000066400000000000000000000347301315545220200207440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some algebraic structures (not packed up with sets, operations, -- etc.) ------------------------------------------------------------------------ open import Relation.Binary module Algebra.Structures where import Algebra.FunctionProperties as FunctionProperties open import Data.Product open import Function open import Level using (_⊔_) import Relation.Binary.EqReasoning as EqR open FunctionProperties using (Op₁; Op₂) ------------------------------------------------------------------------ -- One binary operation record IsSemigroup {a ℓ} {A : Set a} (≈ : Rel A ℓ) (∙ : Op₂ A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isEquivalence : IsEquivalence ≈ assoc : Associative ∙ ∙-cong : ∙ Preserves₂ ≈ ⟶ ≈ ⟶ ≈ open IsEquivalence isEquivalence public record IsMonoid {a ℓ} {A : Set a} (≈ : Rel A ℓ) (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isSemigroup : IsSemigroup ≈ ∙ identity : Identity ε ∙ open IsSemigroup isSemigroup public record IsCommutativeMonoid {a ℓ} {A : Set a} (≈ : Rel A ℓ) (_∙_ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isSemigroup : IsSemigroup ≈ _∙_ identityˡ : LeftIdentity ε _∙_ comm : Commutative _∙_ open IsSemigroup isSemigroup public identity : Identity ε _∙_ identity = (identityˡ , identityʳ) where open EqR (record { isEquivalence = isEquivalence }) identityʳ : RightIdentity ε _∙_ identityʳ = λ x → begin (x ∙ ε) ≈⟨ comm x ε ⟩ (ε ∙ x) ≈⟨ identityˡ x ⟩ x ∎ isMonoid : IsMonoid ≈ _∙_ ε isMonoid = record { isSemigroup = isSemigroup ; identity = identity } record IsIdempotentCommutativeMonoid {a ℓ} {A : Set a} (≈ : Rel A ℓ) (_∙_ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isCommutativeMonoid : IsCommutativeMonoid ≈ _∙_ ε idem : Idempotent _∙_ open IsCommutativeMonoid isCommutativeMonoid public record IsGroup {a ℓ} {A : Set a} (≈ : Rel A ℓ) (_∙_ : Op₂ A) (ε : A) (_⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ infixl 7 _-_ field isMonoid : IsMonoid ≈ _∙_ ε inverse : Inverse ε _⁻¹ _∙_ ⁻¹-cong : _⁻¹ Preserves ≈ ⟶ ≈ open IsMonoid isMonoid public _-_ : FunctionProperties.Op₂ A x - y = x ∙ (y ⁻¹) record IsAbelianGroup {a ℓ} {A : Set a} (≈ : Rel A ℓ) (∙ : Op₂ A) (ε : A) (⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isGroup : IsGroup ≈ ∙ ε ⁻¹ comm : Commutative ∙ open IsGroup isGroup public isCommutativeMonoid : IsCommutativeMonoid ≈ ∙ ε isCommutativeMonoid = record { isSemigroup = isSemigroup ; identityˡ = proj₁ identity ; comm = comm } ------------------------------------------------------------------------ -- Two binary operations record IsNearSemiring {a ℓ} {A : Set a} (≈ : Rel A ℓ) (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field +-isMonoid : IsMonoid ≈ + 0# *-isSemigroup : IsSemigroup ≈ * distribʳ : * DistributesOverʳ + zeroˡ : LeftZero 0# * open IsMonoid +-isMonoid public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ) open IsSemigroup *-isSemigroup public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ) record IsSemiringWithoutOne {a ℓ} {A : Set a} (≈ : Rel A ℓ) (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field +-isCommutativeMonoid : IsCommutativeMonoid ≈ + 0# *-isSemigroup : IsSemigroup ≈ * distrib : * DistributesOver + zero : Zero 0# * open IsCommutativeMonoid +-isCommutativeMonoid public hiding (identityˡ) renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ; isMonoid to +-isMonoid ; comm to +-comm ) open IsSemigroup *-isSemigroup public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ) isNearSemiring : IsNearSemiring ≈ + * 0# isNearSemiring = record { +-isMonoid = +-isMonoid ; *-isSemigroup = *-isSemigroup ; distribʳ = proj₂ distrib ; zeroˡ = proj₁ zero } record IsSemiringWithoutAnnihilatingZero {a ℓ} {A : Set a} (≈ : Rel A ℓ) (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field -- Note that these structures do have an additive unit, but this -- unit does not necessarily annihilate multiplication. +-isCommutativeMonoid : IsCommutativeMonoid ≈ + 0# *-isMonoid : IsMonoid ≈ * 1# distrib : * DistributesOver + open IsCommutativeMonoid +-isCommutativeMonoid public hiding (identityˡ) renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ; isMonoid to +-isMonoid ; comm to +-comm ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; isSemigroup to *-isSemigroup ; identity to *-identity ) record IsSemiring {a ℓ} {A : Set a} (≈ : Rel A ℓ) (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero ≈ + * 0# 1# zero : Zero 0# * open IsSemiringWithoutAnnihilatingZero isSemiringWithoutAnnihilatingZero public isSemiringWithoutOne : IsSemiringWithoutOne ≈ + * 0# isSemiringWithoutOne = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isSemigroup = *-isSemigroup ; distrib = distrib ; zero = zero } open IsSemiringWithoutOne isSemiringWithoutOne public using (isNearSemiring) record IsCommutativeSemiringWithoutOne {a ℓ} {A : Set a} (≈ : Rel A ℓ) (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isSemiringWithoutOne : IsSemiringWithoutOne ≈ + * 0# *-comm : Commutative * open IsSemiringWithoutOne isSemiringWithoutOne public record IsCommutativeSemiring {a ℓ} {A : Set a} (≈ : Rel A ℓ) (_+_ _*_ : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field +-isCommutativeMonoid : IsCommutativeMonoid ≈ _+_ 0# *-isCommutativeMonoid : IsCommutativeMonoid ≈ _*_ 1# distribʳ : _*_ DistributesOverʳ _+_ zeroˡ : LeftZero 0# _*_ private module +-CM = IsCommutativeMonoid +-isCommutativeMonoid open module *-CM = IsCommutativeMonoid *-isCommutativeMonoid public using () renaming (comm to *-comm) open EqR (record { isEquivalence = +-CM.isEquivalence }) distrib : _*_ DistributesOver _+_ distrib = (distribˡ , distribʳ) where distribˡ : _*_ DistributesOverˡ _+_ distribˡ x y z = begin (x * (y + z)) ≈⟨ *-comm x (y + z) ⟩ ((y + z) * x) ≈⟨ distribʳ x y z ⟩ ((y * x) + (z * x)) ≈⟨ *-comm y x ⟨ +-CM.∙-cong ⟩ *-comm z x ⟩ ((x * y) + (x * z)) ∎ zero : Zero 0# _*_ zero = (zeroˡ , zeroʳ) where zeroʳ : RightZero 0# _*_ zeroʳ x = begin (x * 0#) ≈⟨ *-comm x 0# ⟩ (0# * x) ≈⟨ zeroˡ x ⟩ 0# ∎ isSemiring : IsSemiring ≈ _+_ _*_ 0# 1# isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-CM.isMonoid ; distrib = distrib } ; zero = zero } open IsSemiring isSemiring public hiding (distrib; zero; +-isCommutativeMonoid) isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne ≈ _+_ _*_ 0# isCommutativeSemiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne ; *-comm = *-CM.comm } record IsRing {a ℓ} {A : Set a} (≈ : Rel A ℓ) (_+_ _*_ : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field +-isAbelianGroup : IsAbelianGroup ≈ _+_ 0# -_ *-isMonoid : IsMonoid ≈ _*_ 1# distrib : _*_ DistributesOver _+_ open IsAbelianGroup +-isAbelianGroup public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ; isMonoid to +-isMonoid ; inverse to -‿inverse ; ⁻¹-cong to -‿cong ; isGroup to +-isGroup ; comm to +-comm ; isCommutativeMonoid to +-isCommutativeMonoid ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; isSemigroup to *-isSemigroup ; identity to *-identity ) zero : Zero 0# _*_ zero = (zeroˡ , zeroʳ) where open EqR (record { isEquivalence = isEquivalence }) zeroˡ : LeftZero 0# _*_ zeroˡ x = begin (0# * x) ≈⟨ sym $ proj₂ +-identity _ ⟩ ((0# * x) + 0#) ≈⟨ refl ⟨ +-cong ⟩ sym (proj₂ -‿inverse _) ⟩ ((0# * x) + ((0# * x) + (- (0# * x)))) ≈⟨ sym $ +-assoc _ _ _ ⟩ (((0# * x) + (0# * x)) + (- (0# * x))) ≈⟨ sym (proj₂ distrib _ _ _) ⟨ +-cong ⟩ refl ⟩ (((0# + 0#) * x) + (- (0# * x))) ≈⟨ (proj₂ +-identity _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ ((0# * x) + (- (0# * x))) ≈⟨ proj₂ -‿inverse _ ⟩ 0# ∎ zeroʳ : RightZero 0# _*_ zeroʳ x = begin (x * 0#) ≈⟨ sym $ proj₂ +-identity _ ⟩ ((x * 0#) + 0#) ≈⟨ refl ⟨ +-cong ⟩ sym (proj₂ -‿inverse _) ⟩ ((x * 0#) + ((x * 0#) + (- (x * 0#)))) ≈⟨ sym $ +-assoc _ _ _ ⟩ (((x * 0#) + (x * 0#)) + (- (x * 0#))) ≈⟨ sym (proj₁ distrib _ _ _) ⟨ +-cong ⟩ refl ⟩ ((x * (0# + 0#)) + (- (x * 0#))) ≈⟨ (refl ⟨ *-cong ⟩ proj₂ +-identity _) ⟨ +-cong ⟩ refl ⟩ ((x * 0#) + (- (x * 0#))) ≈⟨ proj₂ -‿inverse _ ⟩ 0# ∎ isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero ≈ _+_ _*_ 0# 1# isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-isMonoid ; distrib = distrib } isSemiring : IsSemiring ≈ _+_ _*_ 0# 1# isSemiring = record { isSemiringWithoutAnnihilatingZero = isSemiringWithoutAnnihilatingZero ; zero = zero } open IsSemiring isSemiring public using (isNearSemiring; isSemiringWithoutOne) record IsCommutativeRing {a ℓ} {A : Set a} (≈ : Rel A ℓ) (+ * : Op₂ A) (- : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isRing : IsRing ≈ + * - 0# 1# *-comm : Commutative * open IsRing isRing public isCommutativeSemiring : IsCommutativeSemiring ≈ + * 0# 1# isCommutativeSemiring = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isCommutativeMonoid = record { isSemigroup = *-isSemigroup ; identityˡ = proj₁ *-identity ; comm = *-comm } ; distribʳ = proj₂ distrib ; zeroˡ = proj₁ zero } open IsCommutativeSemiring isCommutativeSemiring public using ( *-isCommutativeMonoid ; isCommutativeSemiringWithoutOne ) record IsLattice {a ℓ} {A : Set a} (≈ : Rel A ℓ) (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isEquivalence : IsEquivalence ≈ ∨-comm : Commutative ∨ ∨-assoc : Associative ∨ ∨-cong : ∨ Preserves₂ ≈ ⟶ ≈ ⟶ ≈ ∧-comm : Commutative ∧ ∧-assoc : Associative ∧ ∧-cong : ∧ Preserves₂ ≈ ⟶ ≈ ⟶ ≈ absorptive : Absorptive ∨ ∧ open IsEquivalence isEquivalence public record IsDistributiveLattice {a ℓ} {A : Set a} (≈ : Rel A ℓ) (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isLattice : IsLattice ≈ ∨ ∧ ∨-∧-distribʳ : ∨ DistributesOverʳ ∧ open IsLattice isLattice public record IsBooleanAlgebra {a ℓ} {A : Set a} (≈ : Rel A ℓ) (∨ ∧ : Op₂ A) (¬ : Op₁ A) (⊤ ⊥ : A) : Set (a ⊔ ℓ) where open FunctionProperties ≈ field isDistributiveLattice : IsDistributiveLattice ≈ ∨ ∧ ∨-complementʳ : RightInverse ⊤ ¬ ∨ ∧-complementʳ : RightInverse ⊥ ¬ ∧ ¬-cong : ¬ Preserves ≈ ⟶ ≈ open IsDistributiveLattice isDistributiveLattice public agda-stdlib-0.14/src/Category/000077500000000000000000000000001315545220200161545ustar00rootroot00000000000000agda-stdlib-0.14/src/Category/Applicative.agda000066400000000000000000000011721315545220200212340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. module Category.Applicative where open import Data.Unit open import Category.Applicative.Indexed RawApplicative : ∀ {f} → (Set f → Set f) → Set _ RawApplicative F = RawIApplicative {I = ⊤} (λ _ _ → F) module RawApplicative {f} {F : Set f → Set f} (app : RawApplicative F) where open RawIApplicative app public agda-stdlib-0.14/src/Category/Applicative/000077500000000000000000000000001315545220200204155ustar00rootroot00000000000000agda-stdlib-0.14/src/Category/Applicative/Indexed.agda000066400000000000000000000047021315545220200226160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. module Category.Applicative.Indexed where open import Category.Functor using (RawFunctor) open import Data.Product open import Function open import Level open import Relation.Binary.PropositionalEquality as P using (_≡_) IFun : ∀ {i} → Set i → (ℓ : Level) → Set _ IFun I ℓ = I → I → Set ℓ → Set ℓ record RawIApplicative {i f} {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field pure : ∀ {i A} → A → F i i A _⊛_ : ∀ {i j k A B} → F i j (A → B) → F j k A → F i k B rawFunctor : ∀ {i j} → RawFunctor (F i j) rawFunctor = record { _<$>_ = λ g x → pure g ⊛ x } private open module RF {i j : I} = RawFunctor (rawFunctor {i = i} {j = j}) public _<⊛_ : ∀ {i j k A B} → F i j A → F j k B → F i k A x <⊛ y = const <$> x ⊛ y _⊛>_ : ∀ {i j k A B} → F i j A → F j k B → F i k B x ⊛> y = flip const <$> x ⊛ y _⊗_ : ∀ {i j k A B} → F i j A → F j k B → F i k (A × B) x ⊗ y = (_,_) <$> x ⊛ y zipWith : ∀ {i j k A B C} → (A → B → C) → F i j A → F j k B → F i k C zipWith f x y = f <$> x ⊛ y -- Applicative functor morphisms, specialised to propositional -- equality. record Morphism {i f} {I : Set i} {F₁ F₂ : IFun I f} (A₁ : RawIApplicative F₁) (A₂ : RawIApplicative F₂) : Set (i ⊔ suc f) where module A₁ = RawIApplicative A₁ module A₂ = RawIApplicative A₂ field op : ∀ {i j X} → F₁ i j X → F₂ i j X op-pure : ∀ {i X} (x : X) → op (A₁.pure {i = i} x) ≡ A₂.pure x op-⊛ : ∀ {i j k X Y} (f : F₁ i j (X → Y)) (x : F₁ j k X) → op (f A₁.⊛ x) ≡ (op f A₂.⊛ op x) op-<$> : ∀ {i j X Y} (f : X → Y) (x : F₁ i j X) → op (f A₁.<$> x) ≡ (f A₂.<$> op x) op-<$> f x = begin op (A₁._⊛_ (A₁.pure f) x) ≡⟨ op-⊛ _ _ ⟩ A₂._⊛_ (op (A₁.pure f)) (op x) ≡⟨ P.cong₂ A₂._⊛_ (op-pure _) P.refl ⟩ A₂._⊛_ (A₂.pure f) (op x) ∎ where open P.≡-Reasoning agda-stdlib-0.14/src/Category/Applicative/Predicate.agda000066400000000000000000000026161315545220200231400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. module Category.Applicative.Predicate where open import Category.Functor.Predicate open import Data.Product open import Function open import Level open import Relation.Unary open import Relation.Unary.PredicateTransformer using (Pt) ------------------------------------------------------------------------ record RawPApplicative {i ℓ} {I : Set i} (F : Pt I ℓ) : Set (i ⊔ suc ℓ) where infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field pure : ∀ {P} → P ⊆ F P _⊛_ : ∀ {P Q} → F (P ⇒ Q) ⊆ F P ⇒ F Q rawPFunctor : RawPFunctor F rawPFunctor = record { _<$>_ = λ g x → pure g ⊛ x } private open module RF = RawPFunctor rawPFunctor public _<⊛_ : ∀ {P Q} → F P ⊆ const (∀ {j} → F Q j) ⇒ F P x <⊛ y = const <$> x ⊛ y _⊛>_ : ∀ {P Q} → const (∀ {i} → F P i) ⊆ F Q ⇒ F Q x ⊛> y = flip const <$> x ⊛ y _⊗_ : ∀ {P Q} → F P ⊆ F Q ⇒ F (P ∩ Q) x ⊗ y = (_,_) <$> x ⊛ y zipWith : ∀ {P Q R} → (P ⊆ Q ⇒ R) → F P ⊆ F Q ⇒ F R zipWith f x y = f <$> x ⊛ y agda-stdlib-0.14/src/Category/Functor.agda000066400000000000000000000020351315545220200204120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. module Category.Functor where open import Function open import Level open import Relation.Binary.PropositionalEquality record RawFunctor {ℓ} (F : Set ℓ → Set ℓ) : Set (suc ℓ) where infixl 4 _<$>_ _<$_ field _<$>_ : ∀ {A B} → (A → B) → F A → F B _<$_ : ∀ {A B} → A → F B → F A x <$ y = const x <$> y -- A functor morphism from F₁ to F₂ is an operation op such that -- op (F₁ f x) ≡ F₂ f (op x) record Morphism {ℓ} {F₁ F₂ : Set ℓ → Set ℓ} (fun₁ : RawFunctor F₁) (fun₂ : RawFunctor F₂) : Set (suc ℓ) where open RawFunctor field op : ∀{X} → F₁ X → F₂ X op-<$> : ∀{X Y} (f : X → Y) (x : F₁ X) → op (fun₁ ._<$>_ f x) ≡ fun₂ ._<$>_ f (op x) agda-stdlib-0.14/src/Category/Functor/000077500000000000000000000000001315545220200175745ustar00rootroot00000000000000agda-stdlib-0.14/src/Category/Functor/Identity.agda000066400000000000000000000006641315545220200222110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The identity functor ------------------------------------------------------------------------ module Category.Functor.Identity where open import Category.Functor Identity : ∀ {f} → Set f → Set f Identity A = A IdentityFunctor : ∀ {f} → RawFunctor (Identity {f}) IdentityFunctor = record { _<$>_ = λ x → x } agda-stdlib-0.14/src/Category/Functor/Predicate.agda000066400000000000000000000014331315545220200223130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. module Category.Functor.Predicate where open import Function open import Level open import Relation.Unary open import Relation.Unary.PredicateTransformer using (PT) record RawPFunctor {i j ℓ₁ ℓ₂} {I : Set i} {J : Set j} (F : PT I J ℓ₁ ℓ₂) : Set (i ⊔ j ⊔ suc ℓ₁ ⊔ suc ℓ₂) where infixl 4 _<$>_ _<$_ field _<$>_ : ∀ {P Q} → P ⊆ Q → F P ⊆ F Q _<$_ : ∀ {P Q} → (∀ {i} → P i) → F Q ⊆ F P x <$ y = const x <$> y agda-stdlib-0.14/src/Category/Monad.agda000066400000000000000000000020321315545220200200250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. module Category.Monad where open import Function open import Category.Monad.Indexed open import Data.Unit RawMonad : ∀ {f} → (Set f → Set f) → Set _ RawMonad M = RawIMonad {I = ⊤} (λ _ _ → M) RawMonadZero : ∀ {f} → (Set f → Set f) → Set _ RawMonadZero M = RawIMonadZero {I = ⊤} (λ _ _ → M) RawMonadPlus : ∀ {f} → (Set f → Set f) → Set _ RawMonadPlus M = RawIMonadPlus {I = ⊤} (λ _ _ → M) module RawMonad {f} {M : Set f → Set f} (Mon : RawMonad M) where open RawIMonad Mon public module RawMonadZero {f} {M : Set f → Set f} (Mon : RawMonadZero M) where open RawIMonadZero Mon public module RawMonadPlus {f} {M : Set f → Set f} (Mon : RawMonadPlus M) where open RawIMonadPlus Mon public agda-stdlib-0.14/src/Category/Monad/000077500000000000000000000000001315545220200172125ustar00rootroot00000000000000agda-stdlib-0.14/src/Category/Monad/Continuation.agda000066400000000000000000000041771315545220200225130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A delimited continuation monad ------------------------------------------------------------------------ module Category.Monad.Continuation where open import Category.Applicative open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Identity open import Category.Monad.Indexed open import Function open import Level ------------------------------------------------------------------------ -- Delimited continuation monads DContT : ∀ {i f} {I : Set i} → (I → Set f) → (Set f → Set f) → IFun I f DContT K M r₂ r₁ a = (a → M (K r₁)) → M (K r₂) DCont : ∀ {i f} {I : Set i} → (I → Set f) → IFun I f DCont K = DContT K Identity DContTIMonad : ∀ {i f} {I : Set i} (K : I → Set f) {M} → RawMonad M → RawIMonad (DContT K M) DContTIMonad K Mon = record { return = λ a k → k a ; _>>=_ = λ c f k → c (flip f k) } where open RawMonad Mon DContIMonad : ∀ {i f} {I : Set i} (K : I → Set f) → RawIMonad (DCont K) DContIMonad K = DContTIMonad K IdentityMonad ------------------------------------------------------------------------ -- Delimited continuation operations record RawIMonadDCont {i f} {I : Set i} (K : I → Set f) (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M reset : ∀ {r₁ r₂ r₃} → M r₁ r₂ (K r₂) → M r₃ r₃ (K r₁) shift : ∀ {a r₁ r₂ r₃ r₄} → ((a → M r₁ r₁ (K r₂)) → M r₃ r₄ (K r₄)) → M r₃ r₂ a open RawIMonad monad public DContTIMonadDCont : ∀ {i f} {I : Set i} (K : I → Set f) {M} → RawMonad M → RawIMonadDCont K (DContT K M) DContTIMonadDCont K Mon = record { monad = DContTIMonad K Mon ; reset = λ e k → e return >>= k ; shift = λ e k → e (λ a k' → (k a) >>= k') return } where open RawIMonad Mon DContIMonadDCont : ∀ {i f} {I : Set i} (K : I → Set f) → RawIMonadDCont K (DCont K) DContIMonadDCont K = DContTIMonadDCont K IdentityMonad agda-stdlib-0.14/src/Category/Monad/Identity.agda000066400000000000000000000007051315545220200216230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The identity monad ------------------------------------------------------------------------ module Category.Monad.Identity where open import Category.Monad Identity : ∀ {f} → Set f → Set f Identity A = A IdentityMonad : ∀ {f} → RawMonad (Identity {f}) IdentityMonad = record { return = λ x → x ; _>>=_ = λ x f → f x } agda-stdlib-0.14/src/Category/Monad/Indexed.agda000066400000000000000000000035061315545220200214140ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. module Category.Monad.Indexed where open import Category.Applicative.Indexed open import Function open import Level record RawIMonad {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where infixl 1 _>>=_ _>>_ _>=>_ infixr 1 _=<<_ _<=<_ field return : ∀ {i A} → A → M i i A _>>=_ : ∀ {i j k A B} → M i j A → (A → M j k B) → M i k B _>>_ : ∀ {i j k A B} → M i j A → M j k B → M i k B m₁ >> m₂ = m₁ >>= λ _ → m₂ _=<<_ : ∀ {i j k A B} → (A → M j k B) → M i j A → M i k B f =<< c = c >>= f _>=>_ : ∀ {i j k a} {A : Set a} {B C} → (A → M i j B) → (B → M j k C) → (A → M i k C) f >=> g = _=<<_ g ∘ f _<=<_ : ∀ {i j k B C a} {A : Set a} → (B → M j k C) → (A → M i j B) → (A → M i k C) g <=< f = f >=> g join : ∀ {i j k A} → M i j (M j k A) → M i k A join m = m >>= id rawIApplicative : RawIApplicative M rawIApplicative = record { pure = return ; _⊛_ = λ f x → f >>= λ f' → x >>= λ x' → return (f' x') } open RawIApplicative rawIApplicative public record RawIMonadZero {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M ∅ : ∀ {i j A} → M i j A open RawIMonad monad public record RawIMonadPlus {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where infixr 3 _∣_ field monadZero : RawIMonadZero M _∣_ : ∀ {i j A} → M i j A → M i j A → M i j A open RawIMonadZero monadZero public agda-stdlib-0.14/src/Category/Monad/Partiality.agda000066400000000000000000001057341315545220200221640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The partiality monad ------------------------------------------------------------------------ module Category.Monad.Partiality where open import Coinduction open import Category.Monad open import Data.Bool.Base using (Bool; false; true) open import Data.Nat using (ℕ; zero; suc; _+_) open import Data.Product as Prod hiding (map) open import Data.Sum hiding (map) open import Function open import Function.Equivalence using (_⇔_; equivalence) open import Level using (_⊔_) open import Relation.Binary as B hiding (Rel) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary open import Relation.Nullary.Decidable hiding (map) open import Relation.Nullary.Negation ------------------------------------------------------------------------ -- The partiality monad data _⊥ {a} (A : Set a) : Set a where now : (x : A) → A ⊥ later : (x : ∞ (A ⊥)) → A ⊥ monad : ∀ {f} → RawMonad {f = f} _⊥ monad = record { return = now ; _>>=_ = _>>=_ } where _>>=_ : ∀ {A B} → A ⊥ → (A → B ⊥) → B ⊥ now x >>= f = f x later x >>= f = later (♯ (♭ x >>= f)) private module M {f} = RawMonad (monad {f}) -- Non-termination. never : ∀ {a} {A : Set a} → A ⊥ never = later (♯ never) -- run x for n steps peels off at most n "later" constructors from x. run_for_steps : ∀ {a} {A : Set a} → A ⊥ → ℕ → A ⊥ run now x for n steps = now x run later x for zero steps = later x run later x for suc n steps = run ♭ x for n steps -- Is the computation done? isNow : ∀ {a} {A : Set a} → A ⊥ → Bool isNow (now x) = true isNow (later x) = false ------------------------------------------------------------------------ -- Kinds -- The partiality monad comes with two forms of equality (weak and -- strong) and one ordering. Strong equality is stronger than the -- ordering, which is stronger than weak equality. -- The three relations are defined using a single data type, indexed -- by a "kind". data OtherKind : Set where geq weak : OtherKind data Kind : Set where strong : Kind other : (k : OtherKind) → Kind -- Kind equality is decidable. infix 4 _≟-Kind_ _≟-Kind_ : Decidable (_≡_ {A = Kind}) _≟-Kind_ strong strong = yes P.refl _≟-Kind_ strong (other k) = no λ() _≟-Kind_ (other k) strong = no λ() _≟-Kind_ (other geq) (other geq) = yes P.refl _≟-Kind_ (other geq) (other weak) = no λ() _≟-Kind_ (other weak) (other geq) = no λ() _≟-Kind_ (other weak) (other weak) = yes P.refl -- A predicate which is satisfied only for equalities. Note that, for -- concrete inputs, this predicate evaluates to ⊤ or ⊥. Equality : Kind → Set Equality k = False (k ≟-Kind other geq) ------------------------------------------------------------------------ -- Equality/ordering module Equality {a ℓ} {A : Set a} -- The "return type". (_∼_ : A → A → Set ℓ) where -- The three relations. data Rel : Kind → A ⊥ → A ⊥ → Set (a ⊔ ℓ) where now : ∀ {k x y} (x∼y : x ∼ y) → Rel k (now x) (now y) later : ∀ {k x y} (x∼y : ∞ (Rel k (♭ x) (♭ y))) → Rel k (later x) (later y) laterʳ : ∀ {x y} (x≈y : Rel (other weak) x (♭ y) ) → Rel (other weak) x (later y) laterˡ : ∀ {k x y} (x∼y : Rel (other k) (♭ x) y ) → Rel (other k) (later x) y infix 4 _≅_ _≳_ _≲_ _≈_ _≅_ : A ⊥ → A ⊥ → Set _ _≅_ = Rel strong _≳_ : A ⊥ → A ⊥ → Set _ _≳_ = Rel (other geq) _≲_ : A ⊥ → A ⊥ → Set _ _≲_ = flip _≳_ _≈_ : A ⊥ → A ⊥ → Set _ _≈_ = Rel (other weak) -- x ⇓ y means that x terminates with y. infix 4 _⇓[_]_ _⇓_ _⇓[_]_ : A ⊥ → Kind → A → Set _ x ⇓[ k ] y = Rel k x (now y) _⇓_ : A ⊥ → A → Set _ x ⇓ y = x ⇓[ other weak ] y -- x ⇓ means that x terminates. infix 4 _⇓ _⇓ : A ⊥ → Set _ x ⇓ = ∃ λ v → x ⇓ v -- x ⇑ means that x does not terminate. infix 4 _⇑[_] _⇑ _⇑[_] : A ⊥ → Kind → Set _ x ⇑[ k ] = Rel k x never _⇑ : A ⊥ → Set _ x ⇑ = x ⇑[ other weak ] ------------------------------------------------------------------------ -- Lemmas relating the three relations module _ {a ℓ} {A : Set a} {_∼_ : A → A → Set ℓ} where open Equality _∼_ using (Rel; _≅_; _≳_; _≲_; _≈_; _⇓[_]_; _⇑[_]) open Equality.Rel -- All relations include strong equality. ≅⇒ : ∀ {k} {x y : A ⊥} → x ≅ y → Rel k x y ≅⇒ (now x∼y) = now x∼y ≅⇒ (later x≅y) = later (♯ ≅⇒ (♭ x≅y)) -- The weak equality includes the ordering. ≳⇒ : ∀ {k} {x y : A ⊥} → x ≳ y → Rel (other k) x y ≳⇒ (now x∼y) = now x∼y ≳⇒ (later x≳y) = later (♯ ≳⇒ (♭ x≳y)) ≳⇒ (laterˡ x≳y) = laterˡ (≳⇒ x≳y ) -- Weak equality includes the other relations. ⇒≈ : ∀ {k} {x y : A ⊥} → Rel k x y → x ≈ y ⇒≈ {strong} = ≅⇒ ⇒≈ {other geq} = ≳⇒ ⇒≈ {other weak} = id -- The relations agree for non-terminating computations. never⇒never : ∀ {k₁ k₂} {x : A ⊥} → Rel k₁ x never → Rel k₂ x never never⇒never (later x∼never) = later (♯ never⇒never (♭ x∼never)) never⇒never (laterʳ x≈never) = never⇒never x≈never never⇒never (laterˡ x∼never) = later (♯ never⇒never x∼never) -- The "other" relations agree when the right-hand side is a value. now⇒now : ∀ {k₁ k₂} {x} {y : A} → Rel (other k₁) x (now y) → Rel (other k₂) x (now y) now⇒now (now x∼y) = now x∼y now⇒now (laterˡ x∼now) = laterˡ (now⇒now x∼now) ------------------------------------------------------------------------ -- Later can be dropped laterʳ⁻¹ : ∀ {k} {x : A ⊥} {y} → Rel (other k) x (later y) → Rel (other k) x (♭ y) laterʳ⁻¹ (later x∼y) = laterˡ (♭ x∼y) laterʳ⁻¹ (laterʳ x≈y) = x≈y laterʳ⁻¹ (laterˡ x∼ly) = laterˡ (laterʳ⁻¹ x∼ly) laterˡ⁻¹ : ∀ {x} {y : A ⊥} → later x ≈ y → ♭ x ≈ y laterˡ⁻¹ (later x≈y) = laterʳ (♭ x≈y) laterˡ⁻¹ (laterʳ lx≈y) = laterʳ (laterˡ⁻¹ lx≈y) laterˡ⁻¹ (laterˡ x≈y) = x≈y later⁻¹ : ∀ {k} {x y : ∞ (A ⊥)} → Rel k (later x) (later y) → Rel k (♭ x) (♭ y) later⁻¹ (later x∼y) = ♭ x∼y later⁻¹ (laterʳ lx≈y) = laterˡ⁻¹ lx≈y later⁻¹ (laterˡ x∼ly) = laterʳ⁻¹ x∼ly ------------------------------------------------------------------------ -- The relations are equivalences or partial orders, given suitable -- assumptions about the underlying relation module Equivalence where -- Reflexivity. refl : Reflexive _∼_ → ∀ {k} → Reflexive (Rel k) refl refl-∼ {x = now v} = now refl-∼ refl refl-∼ {x = later x} = later (♯ refl refl-∼) -- Symmetry. sym : Symmetric _∼_ → ∀ {k} → Equality k → Symmetric (Rel k) sym sym-∼ eq (now x∼y) = now (sym-∼ x∼y) sym sym-∼ eq (later x∼y) = later (♯ sym sym-∼ eq (♭ x∼y)) sym sym-∼ eq (laterʳ x≈y) = laterˡ (sym sym-∼ eq x≈y ) sym sym-∼ eq (laterˡ {weak} x≈y) = laterʳ (sym sym-∼ eq x≈y ) sym sym-∼ () (laterˡ {geq} x≳y) -- Transitivity. private module Trans (trans-∼ : Transitive _∼_) where now-trans : ∀ {k x y} {v : A} → Rel k x y → Rel k y (now v) → Rel k x (now v) now-trans (now x∼y) (now y∼z) = now (trans-∼ x∼y y∼z) now-trans (laterˡ x∼y) y∼z = laterˡ (now-trans x∼y y∼z) now-trans x∼ly (laterˡ y∼z) = now-trans (laterʳ⁻¹ x∼ly) y∼z mutual later-trans : ∀ {k} {x y : A ⊥} {z} → Rel k x y → Rel k y (later z) → Rel k x (later z) later-trans (later x∼y) ly∼lz = later (♯ trans (♭ x∼y) (later⁻¹ ly∼lz)) later-trans (laterˡ x∼y) y∼lz = later (♯ trans x∼y (laterʳ⁻¹ y∼lz)) later-trans (laterʳ x≈y) ly≈lz = later-trans x≈y (laterˡ⁻¹ ly≈lz) later-trans x≈y (laterʳ y≈z) = laterʳ ( trans x≈y y≈z ) trans : ∀ {k} {x y z : A ⊥} → Rel k x y → Rel k y z → Rel k x z trans {z = now v} x∼y y∼v = now-trans x∼y y∼v trans {z = later z} x∼y y∼lz = later-trans x∼y y∼lz open Trans public using (trans) -- All the relations are preorders. preorder : IsPreorder _≡_ _∼_ → Kind → Preorder _ _ _ preorder pre k = record { Carrier = A ⊥ ; _≈_ = _≡_ ; _∼_ = Rel k ; isPreorder = record { isEquivalence = P.isEquivalence ; reflexive = refl′ ; trans = Equivalence.trans (IsPreorder.trans pre) } } where refl′ : ∀ {k} {x y : A ⊥} → x ≡ y → Rel k x y refl′ P.refl = Equivalence.refl (IsPreorder.refl pre) private preorder′ : IsEquivalence _∼_ → Kind → Preorder _ _ _ preorder′ equiv = preorder (Setoid.isPreorder (record { isEquivalence = equiv })) -- The two equalities are equivalence relations. setoid : IsEquivalence _∼_ → (k : Kind) {eq : Equality k} → Setoid _ _ setoid equiv k {eq} = record { Carrier = A ⊥ ; _≈_ = Rel k ; isEquivalence = record { refl = Pre.refl ; sym = Equivalence.sym (IsEquivalence.sym equiv) eq ; trans = Pre.trans } } where module Pre = Preorder (preorder′ equiv k) -- The order is a partial order, with strong equality as the -- underlying equality. ≳-poset : IsEquivalence _∼_ → Poset _ _ _ ≳-poset equiv = record { Carrier = A ⊥ ; _≈_ = _≅_ ; _≤_ = _≳_ ; isPartialOrder = record { antisym = antisym ; isPreorder = record { isEquivalence = S.isEquivalence ; reflexive = ≅⇒ ; trans = Pre.trans } } } where module S = Setoid (setoid equiv strong) module Pre = Preorder (preorder′ equiv (other geq)) antisym : {x y : A ⊥} → x ≳ y → x ≲ y → x ≅ y antisym (now x∼y) (now _) = now x∼y antisym (later x≳y) (later x≲y) = later (♯ antisym (♭ x≳y) (♭ x≲y)) antisym (later x≳y) (laterˡ x≲ly) = later (♯ antisym (♭ x≳y) (laterʳ⁻¹ x≲ly)) antisym (laterˡ x≳ly) (later x≲y) = later (♯ antisym (laterʳ⁻¹ x≳ly) (♭ x≲y)) antisym (laterˡ x≳ly) (laterˡ x≲ly) = later (♯ antisym (laterʳ⁻¹ x≳ly) (laterʳ⁻¹ x≲ly)) -- Equational reasoning. module Reasoning (isEquivalence : IsEquivalence _∼_) where private module Pre {k} = Preorder (preorder′ isEquivalence k) module S {k eq} = Setoid (setoid isEquivalence k {eq}) infix 3 _∎ infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≈⟨_⟩_ _≡⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≡ y → Rel k y z → Rel k x z _ ≡⟨ P.refl ⟩ y∼z = y∼z _≅⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≅ y → Rel k y z → Rel k x z _ ≅⟨ x≅y ⟩ y∼z = Pre.trans (≅⇒ x≅y) y∼z _≳⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≳ y → Rel (other k) y z → Rel (other k) x z _ ≳⟨ x≳y ⟩ y∼z = Pre.trans (≳⇒ x≳y) y∼z _≈⟨_⟩_ : ∀ x {y z : A ⊥} → x ≈ y → y ≈ z → x ≈ z _ ≈⟨ x≈y ⟩ y≈z = Pre.trans x≈y y≈z sym : ∀ {k} {eq : Equality k} {x y : A ⊥} → Rel k x y → Rel k y x sym {eq = eq} = S.sym {eq = eq} _∎ : ∀ {k} (x : A ⊥) → Rel k x x x ∎ = Pre.refl ------------------------------------------------------------------------ -- Lemmas related to now and never -- Now is not never. now≉never : ∀ {k} {x : A} → ¬ Rel k (now x) never now≉never (laterʳ hyp) = now≉never hyp -- A partial value is either now or never (classically, when the -- underlying relation is reflexive). now-or-never : Reflexive _∼_ → ∀ {k} (x : A ⊥) → ¬ ¬ ((∃ λ y → x ⇓[ other k ] y) ⊎ x ⇑[ other k ]) now-or-never refl x = helper <$> excluded-middle where open RawMonad ¬¬-Monad not-now-is-never : (x : A ⊥) → (∄ λ y → x ≳ now y) → x ≳ never not-now-is-never (now x) hyp with hyp (, now refl) ... | () not-now-is-never (later x) hyp = later (♯ not-now-is-never (♭ x) (hyp ∘ Prod.map id laterˡ)) helper : Dec (∃ λ y → x ≳ now y) → _ helper (yes ≳now) = inj₁ $ Prod.map id ≳⇒ ≳now helper (no ≵now) = inj₂ $ ≳⇒ $ not-now-is-never x ≵now ------------------------------------------------------------------------ -- Map-like results -- Map. map : ∀ {_∼′_ : A → A → Set a} {k} → _∼′_ ⇒ _∼_ → Equality.Rel _∼′_ k ⇒ Equality.Rel _∼_ k map ∼′⇒∼ (now x∼y) = now (∼′⇒∼ x∼y) map ∼′⇒∼ (later x∼y) = later (♯ map ∼′⇒∼ (♭ x∼y)) map ∼′⇒∼ (laterʳ x≈y) = laterʳ (map ∼′⇒∼ x≈y) map ∼′⇒∼ (laterˡ x∼y) = laterˡ (map ∼′⇒∼ x∼y) -- If a statement can be proved using propositional equality as the -- underlying relation, then it can also be proved for any other -- reflexive underlying relation. ≡⇒ : Reflexive _∼_ → ∀ {k x y} → Equality.Rel _≡_ k x y → Rel k x y ≡⇒ refl-∼ = map (flip (P.subst (_∼_ _)) refl-∼) ------------------------------------------------------------------------ -- Steps -- The number of later constructors (steps) in the terminating -- computation x. steps : ∀ {k} {x : A ⊥} {y} → x ⇓[ k ] y → ℕ steps (now _) = zero steps .{x = later x} (laterˡ {x = x} x⇓) = suc (steps {x = ♭ x} x⇓) module Steps {trans-∼ : Transitive _∼_} where left-identity : ∀ {k x y} {z : A} (x≅y : x ≅ y) (y⇓z : y ⇓[ k ] z) → steps (Equivalence.trans trans-∼ (≅⇒ x≅y) y⇓z) ≡ steps y⇓z left-identity (now _) (now _) = P.refl left-identity (later x≅y) (laterˡ y⇓z) = P.cong suc $ left-identity (♭ x≅y) y⇓z right-identity : ∀ {k x} {y z : A} (x⇓y : x ⇓[ k ] y) (y≈z : now y ⇓[ k ] z) → steps (Equivalence.trans trans-∼ x⇓y y≈z) ≡ steps x⇓y right-identity (now x∼y) (now y∼z) = P.refl right-identity (laterˡ x∼y) (now y∼z) = P.cong suc $ right-identity x∼y (now y∼z) ------------------------------------------------------------------------ -- Laws related to bind -- Never is a left and right "zero" of bind. left-zero : {B : Set a} (f : B → A ⊥) → let open M in (never >>= f) ≅ never left-zero f = later (♯ left-zero f) right-zero : ∀ {B} (x : B ⊥) → let open M in (x >>= λ _ → never) ≅ never right-zero (later x) = later (♯ right-zero (♭ x)) right-zero (now x) = never≅never where never≅never : never ≅ never never≅never = later (♯ never≅never) -- Now is a left and right identity of bind (for a reflexive -- underlying relation). left-identity : Reflexive _∼_ → ∀ {B} (x : B) (f : B → A ⊥) → let open M in (now x >>= f) ≅ f x left-identity refl-∼ x f = Equivalence.refl refl-∼ right-identity : Reflexive _∼_ → (x : A ⊥) → let open M in (x >>= now) ≅ x right-identity refl (now x) = now refl right-identity refl (later x) = later (♯ right-identity refl (♭ x)) -- Bind is associative (for a reflexive underlying relation). associative : Reflexive _∼_ → ∀ {B C} (x : C ⊥) (f : C → B ⊥) (g : B → A ⊥) → let open M in (x >>= f >>= g) ≅ (x >>= λ y → f y >>= g) associative refl-∼ (now x) f g = Equivalence.refl refl-∼ associative refl-∼ (later x) f g = later (♯ associative refl-∼ (♭ x) f g) module _ {s ℓ} {A B : Set s} {_∼A_ : A → A → Set ℓ} {_∼B_ : B → B → Set ℓ} where open Equality private open module EqA = Equality _∼A_ using () renaming (_⇓[_]_ to _⇓[_]A_; _⇑[_] to _⇑[_]A) open module EqB = Equality _∼B_ using () renaming (_⇓[_]_ to _⇓[_]B_; _⇑[_] to _⇑[_]B) -- Bind preserves all the relations. _>>=-cong_ : ∀ {k} {x₁ x₂ : A ⊥} {f₁ f₂ : A → B ⊥} → let open M in Rel _∼A_ k x₁ x₂ → (∀ {x₁ x₂} → x₁ ∼A x₂ → Rel _∼B_ k (f₁ x₁) (f₂ x₂)) → Rel _∼B_ k (x₁ >>= f₁) (x₂ >>= f₂) now x₁∼x₂ >>=-cong f₁∼f₂ = f₁∼f₂ x₁∼x₂ later x₁∼x₂ >>=-cong f₁∼f₂ = later (♯ (♭ x₁∼x₂ >>=-cong f₁∼f₂)) laterʳ x₁≈x₂ >>=-cong f₁≈f₂ = laterʳ (x₁≈x₂ >>=-cong f₁≈f₂) laterˡ x₁∼x₂ >>=-cong f₁∼f₂ = laterˡ (x₁∼x₂ >>=-cong f₁∼f₂) -- Inversion lemmas for bind. >>=-inversion-⇓ : Reflexive _∼A_ → ∀ {k} x {f : A → B ⊥} {y} → let open M in (x>>=f⇓ : (x >>= f) ⇓[ k ]B y) → ∃ λ z → ∃₂ λ (x⇓ : x ⇓[ k ]A z) (fz⇓ : f z ⇓[ k ]B y) → steps x⇓ + steps fz⇓ ≡ steps x>>=f⇓ >>=-inversion-⇓ refl (now x) fx⇓ = (x , now refl , fx⇓ , P.refl) >>=-inversion-⇓ refl (later x) (laterˡ x>>=f⇓) = Prod.map id (Prod.map laterˡ (Prod.map id (P.cong suc))) $ >>=-inversion-⇓ refl (♭ x) x>>=f⇓ >>=-inversion-⇑ : IsEquivalence _∼A_ → ∀ {k} x {f : A → B ⊥} → let open M in Rel _∼B_ (other k) (x >>= f) never → ¬ ¬ (x ⇑[ other k ]A ⊎ ∃ λ y → x ⇓[ other k ]A y × f y ⇑[ other k ]B) >>=-inversion-⇑ eqA {k} x {f} ∼never = helper <$> now-or-never IsEqA.refl x where open RawMonad ¬¬-Monad using (_<$>_) open M using (_>>=_) open Reasoning eqA module IsEqA = IsEquivalence eqA k≳ = other geq is-never : ∀ {x y} → x ⇓[ k≳ ]A y → (x >>= f) ⇑[ k≳ ]B → ∃ λ z → (y ∼A z) × f z ⇑[ k≳ ]B is-never (now x∼y) = λ fx⇑ → (_ , IsEqA.sym x∼y , fx⇑) is-never (laterˡ ≳now) = is-never ≳now ∘ later⁻¹ helper : (∃ λ y → x ⇓[ k≳ ]A y) ⊎ x ⇑[ k≳ ]A → x ⇑[ other k ]A ⊎ ∃ λ y → x ⇓[ other k ]A y × f y ⇑[ other k ]B helper (inj₂ ≳never) = inj₁ (≳⇒ ≳never) helper (inj₁ (y , ≳now)) with is-never ≳now (never⇒never ∼never) ... | (z , y∼z , fz⇑) = inj₂ (z , ≳⇒ (x ≳⟨ ≳now ⟩ now y ≅⟨ now y∼z ⟩ now z ∎) , ≳⇒ fz⇑) module _ {ℓ} {A B : Set ℓ} {_∼_ : B → B → Set ℓ} where open Equality -- A variant of _>>=-cong_. _≡->>=-cong_ : ∀ {k} {x₁ x₂ : A ⊥} {f₁ f₂ : A → B ⊥} → let open M in Rel _≡_ k x₁ x₂ → (∀ x → Rel _∼_ k (f₁ x) (f₂ x)) → Rel _∼_ k (x₁ >>= f₁) (x₂ >>= f₂) _≡->>=-cong_ {k} {f₁ = f₁} {f₂} x₁≈x₂ f₁≈f₂ = x₁≈x₂ >>=-cong λ {x} x≡x′ → P.subst (λ y → Rel _∼_ k (f₁ x) (f₂ y)) x≡x′ (f₁≈f₂ x) ------------------------------------------------------------------------ -- Productivity checker workaround -- The monad can be awkward to use, due to the limitations of guarded -- coinduction. The following code provides a (limited) workaround. module Workaround {a} where infixl 1 _>>=_ data _⊥P : Set a → Set (Level.suc a) where now : ∀ {A} (x : A) → A ⊥P later : ∀ {A} (x : ∞ (A ⊥P)) → A ⊥P _>>=_ : ∀ {A B} (x : A ⊥P) (f : A → B ⊥P) → B ⊥P private data _⊥W : Set a → Set (Level.suc a) where now : ∀ {A} (x : A) → A ⊥W later : ∀ {A} (x : A ⊥P) → A ⊥W mutual _>>=W_ : ∀ {A B} → A ⊥W → (A → B ⊥P) → B ⊥W now x >>=W f = whnf (f x) later x >>=W f = later (x >>= f) whnf : ∀ {A} → A ⊥P → A ⊥W whnf (now x) = now x whnf (later x) = later (♭ x) whnf (x >>= f) = whnf x >>=W f mutual private ⟦_⟧W : ∀ {A} → A ⊥W → A ⊥ ⟦ now x ⟧W = now x ⟦ later x ⟧W = later (♯ ⟦ x ⟧P) ⟦_⟧P : ∀ {A} → A ⊥P → A ⊥ ⟦ x ⟧P = ⟦ whnf x ⟧W -- The definitions above make sense. ⟦_⟧P is homomorphic with -- respect to now, later and _>>=_. module Correct where private open module Eq {A : Set a} = Equality {A = A} _≡_ open module R {A : Set a} = Reasoning (P.isEquivalence {A = A}) now-hom : ∀ {A} (x : A) → ⟦ now x ⟧P ≅ now x now-hom x = now x ∎ later-hom : ∀ {A} (x : ∞ (A ⊥P)) → ⟦ later x ⟧P ≅ later (♯ ⟦ ♭ x ⟧P) later-hom x = later (♯ (⟦ ♭ x ⟧P ∎)) mutual private >>=-homW : ∀ {A B} (x : B ⊥W) (f : B → A ⊥P) → ⟦ x >>=W f ⟧W ≅ M._>>=_ ⟦ x ⟧W (λ y → ⟦ f y ⟧P) >>=-homW (now x) f = ⟦ f x ⟧P ∎ >>=-homW (later x) f = later (♯ >>=-hom x f) >>=-hom : ∀ {A B} (x : B ⊥P) (f : B → A ⊥P) → ⟦ x >>= f ⟧P ≅ M._>>=_ ⟦ x ⟧P (λ y → ⟦ f y ⟧P) >>=-hom x f = >>=-homW (whnf x) f ------------------------------------------------------------------------ -- An alternative, but equivalent, formulation of equality/ordering module AlternativeEquality {a ℓ} where private El : Setoid a ℓ → Set _ El = Setoid.Carrier Eq : ∀ S → B.Rel (El S) _ Eq = Setoid._≈_ open Equality using (Rel) open Equality.Rel infix 4 _∣_≅P_ _∣_≳P_ _∣_≈P_ infix 3 _∎ infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≳⟨_⟩≅_ _≳⟨_⟩≈_ _≈⟨_⟩≅_ _≈⟨_⟩≲_ infixl 1 _>>=_ mutual -- Proof "programs". _∣_≅P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≅P_ = flip RelP strong _∣_≳P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≳P_ = flip RelP (other geq) _∣_≈P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≈P_ = flip RelP (other weak) data RelP S : Kind → B.Rel (El S ⊥) (Level.suc (a ⊔ ℓ)) where -- Congruences. now : ∀ {k x y} (xRy : x ⟨ Eq S ⟩ y) → RelP S k (now x) (now y) later : ∀ {k x y} (x∼y : ∞ (RelP S k (♭ x) (♭ y))) → RelP S k (later x) (later y) _>>=_ : ∀ {S′ : Setoid a ℓ} {k} {x₁ x₂} {f₁ f₂ : El S′ → El S ⊥} → let open M in (x₁∼x₂ : RelP S′ k x₁ x₂) (f₁∼f₂ : ∀ {x y} → x ⟨ Eq S′ ⟩ y → RelP S k (f₁ x) (f₂ y)) → RelP S k (x₁ >>= f₁) (x₂ >>= f₂) -- Ordering/weak equality. laterʳ : ∀ {x y} (x≈y : RelP S (other weak) x (♭ y)) → RelP S (other weak) x (later y) laterˡ : ∀ {k x y} (x∼y : RelP S (other k) (♭ x) y) → RelP S (other k) (later x) y -- Equational reasoning. Note that including full transitivity -- for weak equality would make _∣_≈P_ trivial; a similar -- problem applies to _∣_≳P_ (A ∣ never ≳P now x would be -- provable). Instead the definition of RelP includes limited -- notions of transitivity, similar to weak bisimulation up-to -- various things. _∎ : ∀ {k} x → RelP S k x x sym : ∀ {k x y} {eq : Equality k} (x∼y : RelP S k x y) → RelP S k y x _≡⟨_⟩_ : ∀ {k} x {y z} (x≡y : x ≡ y) (y∼z : RelP S k y z) → RelP S k x z _≅⟨_⟩_ : ∀ {k} x {y z} (x≅y : S ∣ x ≅P y) (y∼z : RelP S k y z) → RelP S k x z _≳⟨_⟩_ : let open Equality (Eq S) in ∀ x {y z} (x≳y : x ≳ y) (y≳z : S ∣ y ≳P z) → S ∣ x ≳P z _≳⟨_⟩≅_ : ∀ x {y z} (x≳y : S ∣ x ≳P y) (y≅z : S ∣ y ≅P z) → S ∣ x ≳P z _≳⟨_⟩≈_ : ∀ x {y z} (x≳y : S ∣ x ≳P y) (y≈z : S ∣ y ≈P z) → S ∣ x ≈P z _≈⟨_⟩≅_ : ∀ x {y z} (x≈y : S ∣ x ≈P y) (y≅z : S ∣ y ≅P z) → S ∣ x ≈P z _≈⟨_⟩≲_ : ∀ x {y z} (x≈y : S ∣ x ≈P y) (y≲z : S ∣ z ≳P y) → S ∣ x ≈P z -- If any of the following transitivity-like rules were added to -- RelP, then RelP and Rel would no longer be equivalent: -- -- x ≳P y → y ≳P z → x ≳P z -- x ≳P y → y ≳ z → x ≳P z -- x ≲P y → y ≈P z → x ≈P z -- x ≈P y → y ≳P z → x ≈P z -- x ≲ y → y ≈P z → x ≈P z -- x ≈P y → y ≳ z → x ≈P z -- x ≈P y → y ≈P z → x ≈P z -- x ≈P y → y ≈ z → x ≈P z -- x ≈ y → y ≈P z → x ≈P z -- -- The reason is that any of these rules would make it possible -- to derive that never and now x are related. -- RelP is complete with respect to Rel. complete : ∀ {S k} {x y : El S ⊥} → Equality.Rel (Eq S) k x y → RelP S k x y complete (now xRy) = now xRy complete (later x∼y) = later (♯ complete (♭ x∼y)) complete (laterʳ x≈y) = laterʳ (complete x≈y) complete (laterˡ x∼y) = laterˡ (complete x∼y) -- RelP is sound with respect to Rel. private -- Proof WHNFs. data RelW S : Kind → B.Rel (El S ⊥) (Level.suc (a ⊔ ℓ)) where now : ∀ {k x y} (xRy : x ⟨ Eq S ⟩ y) → RelW S k (now x) (now y) later : ∀ {k x y} (x∼y : RelP S k (♭ x) (♭ y)) → RelW S k (later x) (later y) laterʳ : ∀ {x y} (x≈y : RelW S (other weak) x (♭ y)) → RelW S (other weak) x (later y) laterˡ : ∀ {k x y} (x∼y : RelW S (other k) (♭ x) y) → RelW S (other k) (later x) y -- WHNFs can be turned into programs. program : ∀ {S k x y} → RelW S k x y → RelP S k x y program (now xRy) = now xRy program (later x∼y) = later (♯ x∼y) program (laterˡ x∼y) = laterˡ (program x∼y) program (laterʳ x≈y) = laterʳ (program x≈y) -- Lemmas for WHNFs. _>>=W_ : ∀ {A B k x₁ x₂} {f₁ f₂ : El A → El B ⊥} → RelW A k x₁ x₂ → (∀ {x y} → x ⟨ Eq A ⟩ y → RelW B k (f₁ x) (f₂ y)) → RelW B k (M._>>=_ x₁ f₁) (M._>>=_ x₂ f₂) now xRy >>=W f₁∼f₂ = f₁∼f₂ xRy later x∼y >>=W f₁∼f₂ = later (x∼y >>= program ∘ f₁∼f₂) laterʳ x≈y >>=W f₁≈f₂ = laterʳ (x≈y >>=W f₁≈f₂) laterˡ x∼y >>=W f₁∼f₂ = laterˡ (x∼y >>=W f₁∼f₂) reflW : ∀ {S k} x → RelW S k x x reflW {S} (now x) = now (Setoid.refl S) reflW (later x) = later (♭ x ∎) symW : ∀ {S k x y} → Equality k → RelW S k x y → RelW S k y x symW {S} eq (now xRy) = now (Setoid.sym S xRy) symW eq (later x≈y) = later (sym {eq = eq} x≈y) symW eq (laterʳ x≈y) = laterˡ (symW eq x≈y) symW eq (laterˡ {weak} x≈y) = laterʳ (symW eq x≈y) symW () (laterˡ {geq} x≈y) trans≅W : ∀ {S x y z} → RelW S strong x y → RelW S strong y z → RelW S strong x z trans≅W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≅W (later x≅y) (later y≅z) = later (_ ≅⟨ x≅y ⟩ y≅z) trans≳-W : ∀ {S x y z} → let open Equality (Eq S) in x ≳ y → RelW S (other geq) y z → RelW S (other geq) x z trans≳-W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≳-W (later x≳y) (later y≳z) = later (_ ≳⟨ ♭ x≳y ⟩ y≳z) trans≳-W (later x≳y) (laterˡ y≳z) = laterˡ (trans≳-W (♭ x≳y) y≳z) trans≳-W (laterˡ x≳y) y≳z = laterˡ (trans≳-W x≳y y≳z) -- Strong equality programs can be turned into WHNFs. whnf≅ : ∀ {S x y} → S ∣ x ≅P y → RelW S strong x y whnf≅ (now xRy) = now xRy whnf≅ (later x≅y) = later (♭ x≅y) whnf≅ (x₁≅x₂ >>= f₁≅f₂) = whnf≅ x₁≅x₂ >>=W λ xRy → whnf≅ (f₁≅f₂ xRy) whnf≅ (x ∎) = reflW x whnf≅ (sym x≅y) = symW _ (whnf≅ x≅y) whnf≅ (x ≡⟨ P.refl ⟩ y≅z) = whnf≅ y≅z whnf≅ (x ≅⟨ x≅y ⟩ y≅z) = trans≅W (whnf≅ x≅y) (whnf≅ y≅z) -- More transitivity lemmas. _⟨_⟩≅_ : ∀ {S k} x {y z} → RelP S k x y → S ∣ y ≅P z → RelP S k x z _⟨_⟩≅_ {k = strong} x x≅y y≅z = x ≅⟨ x≅y ⟩ y≅z _⟨_⟩≅_ {k = other geq} x x≳y y≅z = x ≳⟨ x≳y ⟩≅ y≅z _⟨_⟩≅_ {k = other weak} x x≈y y≅z = x ≈⟨ x≈y ⟩≅ y≅z trans∼≅W : ∀ {S k x y z} → RelW S k x y → RelW S strong y z → RelW S k x z trans∼≅W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans∼≅W (later x∼y) (later y≅z) = later (_ ⟨ x∼y ⟩≅ y≅z) trans∼≅W (laterʳ x≈y) (later y≅z) = laterʳ (trans∼≅W x≈y (whnf≅ y≅z)) trans∼≅W (laterˡ x∼y) y≅z = laterˡ (trans∼≅W x∼y y≅z) trans≅∼W : ∀ {S k x y z} → RelW S strong x y → RelW S k y z → RelW S k x z trans≅∼W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≅∼W (later x≅y) (later y∼z) = later (_ ≅⟨ x≅y ⟩ y∼z) trans≅∼W (later x≅y) (laterˡ y∼z) = laterˡ (trans≅∼W (whnf≅ x≅y) y∼z) trans≅∼W x≅y (laterʳ ly≈z) = laterʳ (trans≅∼W x≅y ly≈z) -- Order programs can be turned into WHNFs. whnf≳ : ∀ {S x y} → S ∣ x ≳P y → RelW S (other geq) x y whnf≳ (now xRy) = now xRy whnf≳ (later x∼y) = later (♭ x∼y) whnf≳ (laterˡ x≲y) = laterˡ (whnf≳ x≲y) whnf≳ (x₁∼x₂ >>= f₁∼f₂) = whnf≳ x₁∼x₂ >>=W λ xRy → whnf≳ (f₁∼f₂ xRy) whnf≳ (x ∎) = reflW x whnf≳ (sym {eq = ()} x≅y) whnf≳ (x ≡⟨ P.refl ⟩ y≳z) = whnf≳ y≳z whnf≳ (x ≅⟨ x≅y ⟩ y≳z) = trans≅∼W (whnf≅ x≅y) (whnf≳ y≳z) whnf≳ (x ≳⟨ x≳y ⟩ y≳z) = trans≳-W x≳y (whnf≳ y≳z) whnf≳ (x ≳⟨ x≳y ⟩≅ y≅z) = trans∼≅W (whnf≳ x≳y) (whnf≅ y≅z) -- Another transitivity lemma. trans≳≈W : ∀ {S x y z} → RelW S (other geq) x y → RelW S (other weak) y z → RelW S (other weak) x z trans≳≈W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≳≈W (later x≳y) (later y≈z) = later (_ ≳⟨ x≳y ⟩≈ y≈z) trans≳≈W (laterˡ x≳y) y≈z = laterˡ (trans≳≈W x≳y y≈z) trans≳≈W x≳y (laterʳ y≈z) = laterʳ (trans≳≈W x≳y y≈z) trans≳≈W (later x≳y) (laterˡ y≈z) = laterˡ (trans≳≈W (whnf≳ x≳y) y≈z) -- All programs can be turned into WHNFs. whnf : ∀ {S k x y} → RelP S k x y → RelW S k x y whnf (now xRy) = now xRy whnf (later x∼y) = later (♭ x∼y) whnf (laterʳ x≈y) = laterʳ (whnf x≈y) whnf (laterˡ x∼y) = laterˡ (whnf x∼y) whnf (x₁∼x₂ >>= f₁∼f₂) = whnf x₁∼x₂ >>=W λ xRy → whnf (f₁∼f₂ xRy) whnf (x ∎) = reflW x whnf (sym {eq = eq} x≈y) = symW eq (whnf x≈y) whnf (x ≡⟨ P.refl ⟩ y∼z) = whnf y∼z whnf (x ≅⟨ x≅y ⟩ y∼z) = trans≅∼W (whnf x≅y) (whnf y∼z) whnf (x ≳⟨ x≳y ⟩ y≳z) = trans≳-W x≳y (whnf y≳z) whnf (x ≳⟨ x≳y ⟩≅ y≅z) = trans∼≅W (whnf x≳y) (whnf y≅z) whnf (x ≳⟨ x≳y ⟩≈ y≈z) = trans≳≈W (whnf x≳y) (whnf y≈z) whnf (x ≈⟨ x≈y ⟩≅ y≅z) = trans∼≅W (whnf x≈y) (whnf y≅z) whnf (x ≈⟨ x≈y ⟩≲ y≲z) = symW _ (trans≳≈W (whnf y≲z) (symW _ (whnf x≈y))) mutual -- Soundness. private soundW : ∀ {S k x y} → RelW S k x y → Rel (Eq S) k x y soundW (now xRy) = now xRy soundW (later x∼y) = later (♯ sound x∼y) soundW (laterʳ x≈y) = laterʳ (soundW x≈y) soundW (laterˡ x∼y) = laterˡ (soundW x∼y) sound : ∀ {S k x y} → RelP S k x y → Rel (Eq S) k x y sound x∼y = soundW (whnf x∼y) -- RelP and Rel are equivalent (when the underlying relation is an -- equivalence). correct : ∀ {S k x y} → RelP S k x y ⇔ Rel (Eq S) k x y correct = equivalence sound complete ------------------------------------------------------------------------ -- Another lemma -- Bind is "idempotent". idempotent : ∀ {ℓ} {A : Set ℓ} (B : Setoid ℓ ℓ) → let open M; open Setoid B using (_≈_; Carrier); open Equality _≈_ in (x : A ⊥) (f : A → A → Carrier ⊥) → (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳ (x >>= λ y′ → f y′ y′) idempotent {A = A} B x f = sound (idem x) where open AlternativeEquality hiding (_>>=_) open M open Equality.Rel using (laterˡ) open Equivalence using (refl) idem : (x : A ⊥) → B ∣ (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳P (x >>= λ y′ → f y′ y′) idem (now x) = f x x ∎ idem (later x) = later (♯ ( (♭ x >>= λ y′ → later x >>= λ y″ → f y′ y″) ≳⟨ (refl P.refl {x = ♭ x} ≡->>=-cong λ _ → laterˡ (refl (Setoid.refl B))) ⟩ (♭ x >>= λ y′ → ♭ x >>= λ y″ → f y′ y″) ≳⟨ idem (♭ x) ⟩≅ (♭ x >>= λ y′ → f y′ y′) ∎)) ------------------------------------------------------------------------ -- Example private module Example where open Data.Nat open Workaround -- McCarthy's f91: f91′ : ℕ → ℕ ⊥P f91′ n with n ≤? 100 ... | yes _ = later (♯ (f91′ (11 + n) >>= f91′)) ... | no _ = now (n ∸ 10) f91 : ℕ → ℕ ⊥ f91 n = ⟦ f91′ n ⟧P agda-stdlib-0.14/src/Category/Monad/Partiality/000077500000000000000000000000001315545220200213345ustar00rootroot00000000000000agda-stdlib-0.14/src/Category/Monad/Partiality/All.agda000066400000000000000000000144451315545220200226720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An All predicate for the partiality monad ------------------------------------------------------------------------ module Category.Monad.Partiality.All where open import Category.Monad open import Category.Monad.Partiality as Partiality using (_⊥; ⇒≈) open import Coinduction open import Function open import Level open import Relation.Binary using (_Respects_; IsEquivalence) open import Relation.Binary.PropositionalEquality as P using (_≡_) open Partiality._⊥ open Partiality.Equality using (Rel) open Partiality.Equality.Rel private open module E {a} {A : Set a} = Partiality.Equality (_≡_ {A = A}) using (_≅_; _≳_) open module M {f} = RawMonad (Partiality.monad {f = f}) using (_>>=_) ------------------------------------------------------------------------ -- All, along with some lemmas -- All P x means that if x terminates with the value v, then P v -- holds. data All {a p} {A : Set a} (P : A → Set p) : A ⊥ → Set (a ⊔ p) where now : ∀ {v} (p : P v) → All P (now v) later : ∀ {x} (p : ∞ (All P (♭ x))) → All P (later x) -- Bind preserves All in the following way: _>>=-cong_ : ∀ {ℓ p q} {A B : Set ℓ} {P : A → Set p} {Q : B → Set q} {x : A ⊥} {f : A → B ⊥} → All P x → (∀ {x} → P x → All Q (f x)) → All Q (x >>= f) now p >>=-cong f = f p later p >>=-cong f = later (♯ (♭ p >>=-cong f)) -- All respects all the relations, given that the predicate respects -- the underlying relation. respects : ∀ {k a p ℓ} {A : Set a} {P : A → Set p} {_∼_ : A → A → Set ℓ} → P Respects _∼_ → All P Respects Rel _∼_ k respects resp (now x∼y) (now p) = now (resp x∼y p) respects resp (later x∼y) (later p) = later (♯ respects resp (♭ x∼y) (♭ p)) respects resp (laterˡ x∼y) (later p) = respects resp x∼y (♭ p) respects resp (laterʳ x≈y) p = later (♯ respects resp x≈y p) respects-flip : ∀ {k a p ℓ} {A : Set a} {P : A → Set p} {_∼_ : A → A → Set ℓ} → P Respects flip _∼_ → All P Respects flip (Rel _∼_ k) respects-flip resp (now x∼y) (now p) = now (resp x∼y p) respects-flip resp (later x∼y) (later p) = later (♯ respects-flip resp (♭ x∼y) (♭ p)) respects-flip resp (laterˡ x∼y) p = later (♯ respects-flip resp x∼y p) respects-flip resp (laterʳ x≈y) (later p) = respects-flip resp x≈y (♭ p) -- "Equational" reasoning. module Reasoning {a p ℓ} {A : Set a} {P : A → Set p} {_∼_ : A → A → Set ℓ} (resp : P Respects flip _∼_) where infix 3 finally infixr 2 _≡⟨_⟩_ _∼⟨_⟩_ _≡⟨_⟩_ : ∀ x {y} → x ≡ y → All P y → All P x _ ≡⟨ P.refl ⟩ p = p _∼⟨_⟩_ : ∀ {k} x {y} → Rel _∼_ k x y → All P y → All P x _ ∼⟨ x∼y ⟩ p = respects-flip resp (⇒≈ x∼y) p -- A cosmetic combinator. finally : (x : A ⊥) → All P x → All P x finally _ p = p syntax finally x p = x ⟨ p ⟩ -- "Equational" reasoning with _∼_ instantiated to propositional -- equality. module Reasoning-≡ {a p} {A : Set a} {P : A → Set p} = Reasoning {P = P} {_∼_ = _≡_} (P.subst P ∘ P.sym) ------------------------------------------------------------------------ -- An alternative, but equivalent, formulation of All module Alternative {a p : Level} where infix 3 _⟨_⟩P infixr 2 _≅⟨_⟩P_ _≳⟨_⟩P_ -- All "programs". data AllP {A : Set a} (P : A → Set p) : A ⊥ → Set (suc (a ⊔ p)) where now : ∀ {x} (p : P x) → AllP P (now x) later : ∀ {x} (p : ∞ (AllP P (♭ x))) → AllP P (later x) _>>=-congP_ : ∀ {B : Set a} {Q : B → Set p} {x f} (p-x : AllP Q x) (p-f : ∀ {v} → Q v → AllP P (f v)) → AllP P (x >>= f) _≅⟨_⟩P_ : ∀ x {y} (x≅y : x ≅ y) (p : AllP P y) → AllP P x _≳⟨_⟩P_ : ∀ x {y} (x≳y : x ≳ y) (p : AllP P y) → AllP P x _⟨_⟩P : ∀ x (p : AllP P x) → AllP P x private -- WHNFs. data AllW {A} (P : A → Set p) : A ⊥ → Set (suc (a ⊔ p)) where now : ∀ {x} (p : P x) → AllW P (now x) later : ∀ {x} (p : AllP P (♭ x)) → AllW P (later x) -- A function which turns WHNFs into programs. program : ∀ {A} {P : A → Set p} {x} → AllW P x → AllP P x program (now p) = now p program (later p) = later (♯ p) -- Functions which turn programs into WHNFs. trans-≅ : ∀ {A} {P : A → Set p} {x y : A ⊥} → x ≅ y → AllW P y → AllW P x trans-≅ (now P.refl) (now p) = now p trans-≅ (later x≅y) (later p) = later (_ ≅⟨ ♭ x≅y ⟩P p) trans-≳ : ∀ {A} {P : A → Set p} {x y : A ⊥} → x ≳ y → AllW P y → AllW P x trans-≳ (now P.refl) (now p) = now p trans-≳ (later x≳y) (later p) = later (_ ≳⟨ ♭ x≳y ⟩P p) trans-≳ (laterˡ x≳y) p = later (_ ≳⟨ x≳y ⟩P program p) mutual _>>=-congW_ : ∀ {A B} {P : A → Set p} {Q : B → Set p} {x f} → AllW P x → (∀ {v} → P v → AllP Q (f v)) → AllW Q (x >>= f) now p >>=-congW p-f = whnf (p-f p) later p >>=-congW p-f = later (p >>=-congP p-f) whnf : ∀ {A} {P : A → Set p} {x} → AllP P x → AllW P x whnf (now p) = now p whnf (later p) = later (♭ p) whnf (p-x >>=-congP p-f) = whnf p-x >>=-congW p-f whnf (_ ≅⟨ x≅y ⟩P p) = trans-≅ x≅y (whnf p) whnf (_ ≳⟨ x≳y ⟩P p) = trans-≳ x≳y (whnf p) whnf (_ ⟨ p ⟩P) = whnf p -- AllP P is sound and complete with respect to All P. sound : ∀ {A} {P : A → Set p} {x} → AllP P x → All P x sound = λ p → soundW (whnf p) where soundW : ∀ {A} {P : A → Set p} {x} → AllW P x → All P x soundW (now p) = now p soundW (later p) = later (♯ sound p) complete : ∀ {A} {P : A → Set p} {x} → All P x → AllP P x complete (now p) = now p complete (later p) = later (♯ complete (♭ p)) agda-stdlib-0.14/src/Category/Monad/Predicate.agda000066400000000000000000000035461315545220200217400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. module Category.Monad.Predicate where open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Indexed open import Data.Unit open import Data.Product open import Function open import Level open import Relation.Binary.PropositionalEquality open import Relation.Unary open import Relation.Unary.PredicateTransformer using (Pt) ------------------------------------------------------------------------ record RawPMonad {i ℓ} {I : Set i} (M : Pt I (i ⊔ ℓ)) : Set (suc i ⊔ suc ℓ) where infixl 1 _?>=_ _?>_ _>?>_ infixr 1 _==_ : ∀ {P Q} → M P ⊆ const (P ⊆ M Q) ⇒ M Q m ?>= f = f ==′_ : ∀ {P Q} → M P ⊆ const (∀ j → {_ : P j} → j ∈ M Q) ⇒ M Q m ?>=′ f = m ?>= λ {j} p → f j {p} _?>_ : ∀ {P Q} → M P ⊆ const (∀ {j} → j ∈ M Q) ⇒ M Q m₁ ?> m₂ = m₁ ?>= λ _ → m₂ join? : ∀ {P} → M (M P) ⊆ M P join? m = m ?>= id _>?>_ : {P Q R : _} → P ⊆ M Q → Q ⊆ M R → P ⊆ M R f >?> g = _=?> g -- ``Angelic'' operations (the player knows the state). rawIMonad : RawIMonad (λ i j A → i ∈ M (const A ∩ ｛ j ｝)) rawIMonad = record { return = λ x → return? (x , refl) ; _>>=_ = λ m k → m ?>= λ { {._} (x , refl) → k x } } open RawIMonad rawIMonad public agda-stdlib-0.14/src/Category/Monad/State.agda000066400000000000000000000077651315545220200211270ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The state monad ------------------------------------------------------------------------ module Category.Monad.State where open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Identity open import Category.Monad.Indexed open import Data.Product open import Data.Unit open import Function open import Level ------------------------------------------------------------------------ -- Indexed state monads IStateT : ∀ {i f} {I : Set i} → (I → Set f) → (Set f → Set f) → IFun I f IStateT S M i j A = S i → M (A × S j) StateTIMonad : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonad M → RawIMonad (IStateT S M) StateTIMonad S Mon = record { return = λ x s → return (x , s) ; _>>=_ = λ m f s → m s >>= uncurry f } where open RawMonad Mon StateTIMonadZero : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonadZero M → RawIMonadZero (IStateT S M) StateTIMonadZero S Mon = record { monad = StateTIMonad S (RawMonadZero.monad Mon) ; ∅ = const ∅ } where open RawMonadZero Mon StateTIMonadPlus : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonadPlus M → RawIMonadPlus (IStateT S M) StateTIMonadPlus S Mon = record { monadZero = StateTIMonadZero S (RawIMonadPlus.monadZero Mon) ; _∣_ = λ m₁ m₂ s → m₁ s ∣ m₂ s } where open RawMonadPlus Mon ------------------------------------------------------------------------ -- State monad operations record RawIMonadState {i f} {I : Set i} (S : I → Set f) (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M get : ∀ {i} → M i i (S i) put : ∀ {i j} → S j → M i j (Lift ⊤) open RawIMonad monad public modify : ∀ {i j} → (S i → S j) → M i j (Lift ⊤) modify f = get >>= put ∘ f StateTIMonadState : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonad M → RawIMonadState S (IStateT S M) StateTIMonadState S Mon = record { monad = StateTIMonad S Mon ; get = λ s → return (s , s) ; put = λ s _ → return (_ , s) } where open RawIMonad Mon ------------------------------------------------------------------------ -- Ordinary state monads RawMonadState : ∀ {f} → Set f → (Set f → Set f) → Set _ RawMonadState S M = RawIMonadState {I = ⊤} (λ _ → S) (λ _ _ → M) module RawMonadState {f} {S : Set f} {M : Set f → Set f} (Mon : RawMonadState S M) where open RawIMonadState Mon public StateT : ∀ {f} → Set f → (Set f → Set f) → Set f → Set f StateT S M = IStateT {I = ⊤} (λ _ → S) M _ _ StateTMonad : ∀ {f} (S : Set f) {M} → RawMonad M → RawMonad (StateT S M) StateTMonad S = StateTIMonad (λ _ → S) StateTMonadZero : ∀ {f} (S : Set f) {M} → RawMonadZero M → RawMonadZero (StateT S M) StateTMonadZero S = StateTIMonadZero (λ _ → S) StateTMonadPlus : ∀ {f} (S : Set f) {M} → RawMonadPlus M → RawMonadPlus (StateT S M) StateTMonadPlus S = StateTIMonadPlus (λ _ → S) StateTMonadState : ∀ {f} (S : Set f) {M} → RawMonad M → RawMonadState S (StateT S M) StateTMonadState S = StateTIMonadState (λ _ → S) State : ∀ {f} → Set f → Set f → Set f State S = StateT S Identity StateMonad : ∀ {f} (S : Set f) → RawMonad (State S) StateMonad S = StateTMonad S IdentityMonad StateMonadState : ∀ {f} (S : Set f) → RawMonadState S (State S) StateMonadState S = StateTMonadState S IdentityMonad LiftMonadState : ∀ {f S₁} (S₂ : Set f) {M} → RawMonadState S₁ M → RawMonadState S₁ (StateT S₂ M) LiftMonadState S₂ Mon = record { monad = StateTIMonad (λ _ → S₂) monad ; get = λ s → get >>= λ x → return (x , s) ; put = λ s′ s → put s′ >> return (_ , s) } where open RawIMonadState Mon agda-stdlib-0.14/src/Coinduction.agda000066400000000000000000000024241315545220200174750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic types related to coinduction ------------------------------------------------------------------------ module Coinduction where open import Agda.Builtin.Coinduction public ------------------------------------------------------------------------ -- Rec, a type which is analogous to the Rec type constructor used in -- ΠΣ (see Altenkirch, Danielsson, Löh and Oury. ΠΣ: Dependent Types -- without the Sugar. FLOPS 2010, LNCS 6009.) data Rec {a} (A : ∞ (Set a)) : Set a where fold : (x : ♭ A) → Rec A unfold : ∀ {a} {A : ∞ (Set a)} → Rec A → ♭ A unfold (fold x) = x {- -- If --guardedness-preserving-type-constructors is enabled one can -- define types like ℕ by recursion: open import Data.Sum open import Data.Unit ℕ : Set ℕ = ⊤ ⊎ Rec (♯ ℕ) zero : ℕ zero = inj₁ _ suc : ℕ → ℕ suc n = inj₂ (fold n) ℕ-rec : (P : ℕ → Set) → P zero → (∀ n → P n → P (suc n)) → ∀ n → P n ℕ-rec P z s (inj₁ _) = z ℕ-rec P z s (inj₂ (fold n)) = s n (ℕ-rec P z s n) -- This feature is very experimental, though: it may lead to -- inconsistencies. -} agda-stdlib-0.14/src/Data/000077500000000000000000000000001315545220200152505ustar00rootroot00000000000000agda-stdlib-0.14/src/Data/AVL.agda000066400000000000000000000375521315545220200165240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- AVL trees ------------------------------------------------------------------------ -- AVL trees are balanced binary search trees. -- The search tree invariant is specified using the technique -- described by Conor McBride in his talk "Pivotal pragmatism". open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) module Data.AVL {k v ℓ} {Key : Set k} (Value : Key → Set v) {_<_ : Rel Key ℓ} (isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_) where open import Data.Bool.Base using (Bool) import Data.DifferenceList as DiffList open import Data.Empty open import Data.List.Base as List using (List) open import Data.Maybe.Base hiding (map) open import Data.Nat.Base hiding (_<_; _⊔_; compare) open import Data.Product hiding (map) open import Data.Unit open import Function open import Level using (_⊔_; Lift; lift) open IsStrictTotalOrder isStrictTotalOrder ------------------------------------------------------------------------ -- Extended keys module Extended-key where -- The key type extended with a new minimum and maximum. data Key⁺ : Set k where ⊥⁺ ⊤⁺ : Key⁺ [_] : (k : Key) → Key⁺ -- An extended strict ordering relation. infix 4 _<⁺_ _<⁺_ : Key⁺ → Key⁺ → Set ℓ ⊥⁺ <⁺ [ _ ] = Lift ⊤ ⊥⁺ <⁺ ⊤⁺ = Lift ⊤ [ x ] <⁺ [ y ] = x < y [ _ ] <⁺ ⊤⁺ = Lift ⊤ _ <⁺ _ = Lift ⊥ -- A pair of ordering constraints. infix 4 _<_<_ _<_<_ : Key⁺ → Key → Key⁺ → Set ℓ l < x < u = l <⁺ [ x ] × [ x ] <⁺ u -- _<⁺_ is transitive. trans⁺ : ∀ l {m u} → l <⁺ m → m <⁺ u → l <⁺ u trans⁺ [ l ] {m = [ m ]} {u = [ u ]} l _ _ k′ _ _ _ = joinʳ⁻ _ p lp (delete k pu) bal ... | tri≈ _ _ _ = join lp pu bal -- Looks up a key. Logarithmic in the size of the tree (assuming -- constant-time comparisons). lookup : ∀ {l u h} → (k : Key) → Tree l u h → Maybe (Value k) lookup k (leaf _) = nothing lookup k (node (k′ , v) lk′ k′u _) with compare k k′ ... | tri< _ _ _ = lookup k lk′ ... | tri> _ _ _ = lookup k k′u ... | tri≈ _ eq _ rewrite eq = just v -- Maps a function over all values in the tree. map : (∀ {k} → Value k → Value k) → ∀ {l u h} → Tree l u h → Tree l u h map f (leaf l