pax_global_header00006660000000000000000000000064135055355560014526gustar00rootroot0000000000000052 comment=dffb8023a63e7e66a90a8664752245971a915e66 agda-stdlib-1.1/000077500000000000000000000000001350553555600135425ustar00rootroot00000000000000agda-stdlib-1.1/.boring000066400000000000000000000001221350553555600150160ustar00rootroot00000000000000\.l?agda\.el$ \.agdai$ (^|/)MAlonzo($|/) ^dist($|/) ^html($|/) ^Everything\.agda$ agda-stdlib-1.1/.gitattributes000066400000000000000000000000271350553555600164340ustar00rootroot00000000000000.travis.yml merge=ours agda-stdlib-1.1/.gitignore000066400000000000000000000003371350553555600155350ustar00rootroot00000000000000# Keep this file in alphabetic order please! *~ .*.swp *.agdai *.agda.el .DS_Store *.lagda.el *.hi *.o *.tix *.vim dist Everything.agda EverythingSafe.agda EverythingSafeGuardedness.agda EverythingSafeSizedTypes.agda html agda-stdlib-1.1/.mailmap000066400000000000000000000020611350553555600151620ustar00rootroot00000000000000# 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-1.1/.travis.yml000066400000000000000000000064261350553555600156630ustar00rootroot00000000000000language: c branches: only: - master - experimental dist: xenial cache: directories: - $HOME/.cabsnap matrix: include: - env: TEST=MAIN GHC_VER=8.4.4 BUILD=CABAL CABAL_VER=2.2 addons: apt: packages: - cabal-install-2.2 - ghc-8.4.4 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: - cabal update - sed -i 's/^jobs:/-- jobs:/' $HOME/.cabal/config # checking whether .ghc is still valid - cabal install alex happy - 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/installplan.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 - cabal install Agda # 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/; # installing fix-agda-whitespace - git clone https://github.com/agda/agda --depth=1 - cd agda/src/fix-agda-whitespace - cabal install fix-agda-whitespace.cabal - cd - - yes | rm -R agda/ # generating Everything.agda - cabal install lib.cabal - runghc GenerateEverything.hs # setting up travis-specific scripts and files - cp travis/* . before_script: - export RTS_OPTIONS="+RTS -M2.5G -H2.5G -A128M -RTS" script: # generating index.agda - ./index.sh # detecting whitespace violations - make check-whitespace # expose the value of RTS_OPTIONS - echo $RTS_OPTIONS # checking safe modules build with --safe - agda $RTS_OPTIONS -i . -i src/ --safe EverythingSafeGuardedness.agda - agda $RTS_OPTIONS -i . -i src/ --safe EverythingSafeSizedTypes.agda # detecting basic compilation errors - agda $RTS_OPTIONS -i . -i src/ -c --no-main Everything.agda # building the docs - agda $RTS_OPTIONS -i . -i src/ --html safe.agda - agda $RTS_OPTIONS -i . -i src/ --html index.agda # moving everything to the doc directory - 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 checkout HEAD -- v0.16/ v0.17/ v1.0/ experimental/ - git add -f \*.html - git commit -m "Automatic HTML update via Travis" - if [ "$TRAVIS_PULL_REQUEST" = "false" ] && [ "$TRAVIS_BRANCH" = "master" ]; then git push -q upstream HEAD:gh-pages &>/dev/null; fi notifications: email: false agda-stdlib-1.1/AllNonAsciiChars.hs000066400000000000000000000020721350553555600172140ustar00rootroot00000000000000-- | 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-1.1/CHANGELOG.md000066400000000000000000001070771350553555600153670ustar00rootroot00000000000000Version 1.1 =========== The library has been tested using Agda version 2.6.0.1. Changes since 1.0.1: Highlights ---------- * Large increases in performance for `Nat`, `Integer` and `Rational` datatypes, particularly in compiled code. * Generic n-ary programming (`projₙ`, `congₙ`, `substₙ` etc.) * General argmin/argmax/min/max over `List`. * New `Trie` datatype Bug-fixes --------- #### `_<_` in `Data.Integer` * The definition of `_<_` in `Data.Integer` often resulted in unsolved metas when Agda had to infer the first argument. This was because it was previously implemented in terms of `suc` -> `_+_` -> `_⊖_`. * To fix this problem the implementation has therefore changed to: ```agda data _<_ : ℤ → ℤ → Set where -<+ : ∀ {m n} → -[1+ m ] < + n -<- : ∀ {m n} → (n-< : (p ⊖_) Preserves ℕ._>_ ⟶ _<_ ⊖-monoˡ-< : (_⊖ p) Preserves ℕ._<_ ⟶ _<_ *-distrib-+ : _*_ DistributesOver _+_ *-monoˡ-<-pos : (+[1+ n ] *_) Preserves _<_ ⟶ _<_ *-monoʳ-<-pos : (_* +[1+ n ]) Preserves _<_ ⟶ _<_ *-cancelˡ-<-non-neg : + m * n < + m * o → n < o *-cancelʳ-<-non-neg : m * + o < n * + o → m < n ``` * Added new proofs to `Data.List.Properties`: ```agda foldr-forcesᵇ : (P (f x y) → P x × P y) → P (foldr f e xs) → All P xs foldr-preservesᵇ : (P x → P y → P (f x y)) → P e → All P xs → P (foldr f e xs) foldr-preservesʳ : (P y → P (f x y)) → P e → P (foldr f e xs) foldr-preservesᵒ : (P x ⊎ P y → P (f x y)) → P e ⊎ Any P xs → P (foldr f e xs) ``` * Added a new proof in `Data.List.Relation.Binary.Permutation.Propositional.Properties`: ```agda shifts : xs ++ ys ++ zs ↭ ys ++ xs ++ zs ``` * Added new proofs to `Data.List.Relation.Binary.Pointwise`: ```agda ++-cancelˡ : Pointwise _∼_ (xs ++ ys) (xs ++ zs) → Pointwise _∼_ ys zs ++-cancelʳ : Pointwise _∼_ (ys ++ xs) (zs ++ xs) → Pointwise _∼_ ys zs ``` * Added new proof to `Data.List.Relation.Binary.Sublist.Heterogeneous.Properties`: ```agda concat⁺ : Sublist (Sublist R) ass bss → Sublist R (concat ass) (concat bss) ``` * Added new proof to `Data.List.Membership.Setoid.Properties`: ```agda unique⇒irrelevant : Irrelevant _≈_ → Unique xs → Irrelevant (_∈ xs) ``` * Added new proofs to `Data.List.Relation.Binary.Sublist.Propositional.Properties`: ```agda All-resp-⊆ : (All P) Respects (flip _⊆_) Any-resp-⊆ : (Any P) Respects _⊆_ ``` * Added new operations to `Data.List.Relation.Unary.All`: ```agda lookupAny : All P xs → (i : Any Q xs) → (P ∩ Q) (lookup i) lookupWith : ∀[ P ⇒ Q ⇒ R ] → All P xs → (i : Any Q xs) → R (lookup i) uncons : All P (x ∷ xs) → P x × All P xs reduce : (f : ∀ {x} → P x → B) → ∀ {xs} → All P xs → List B construct : (f : B → ∃ P) (xs : List B) → ∃ (All P) fromList : (xs : List (∃ P)) → All P (List.map proj₁ xs) toList : All P xs → List (∃ P) self : All (const A) xs ``` * Added new proofs to `Data.List.Relation.Unary.All.Properties`: ```agda All-swap : All (λ xs → All (xs ~_) ys) xss → All (λ y → All (_~ y) xss) ys applyDownFrom⁺₁ : (∀ {i} → i < n → P (f i)) → All P (applyDownFrom f n) applyDownFrom⁺₂ : (∀ i → P (f i)) → All P (applyDownFrom f n) ``` * Added new proofs to `Data.List.Relation.Unary.Any.Properties`: ```agda Any-Σ⁺ʳ : (∃ λ x → Any (_~ x) xs) → Any (∃ ∘ _~_) xs Any-Σ⁻ʳ : Any (∃ ∘ _~_) xs → ∃ λ x → Any (_~ x) xs gmap : P ⋐ Q ∘ f → Any P ⋐ Any Q ∘ map f ``` * Added new functions to `Data.Maybe.Base`: ```agda ap : Maybe (A → B) → Maybe A → Maybe B _>>=_ : Maybe A → (A → Maybe B) → Maybe B ``` * Added new proofs to `Data.Nat.Divisibility`: ```agda ∣m∸n∣n⇒∣m : n ≤ m → i ∣ m ∸ n → i ∣ n → i ∣ m ∣n∣m%n⇒∣m : d ∣ n → d ∣ (m % n) → d ∣ m *-monoˡ-∣ : i ∣ j → i * k ∣ j * k %-presˡ-∣ : d ∣ m → d ∣ n → d ∣ (m % n) m/n∣m : n ∣ m → m / n ∣ m m*n∣o⇒m∣o/n : m * n ∣ o → m ∣ o / n m*n∣o⇒n∣o/m : m * n ∣ o → n ∣ o / m m∣n/o⇒m*o∣n : o ∣ n → m ∣ n / o → m * o ∣ n m∣n/o⇒o*m∣n : o ∣ n → m ∣ n / o → o * m ∣ n m/n∣o⇒m∣o*n : n ∣ m → m / n ∣ o → m ∣ o * n m∣n*o⇒m/n∣o : n ∣ m → m ∣ o * n → m / n ∣ o ``` * Added new operator and proofs to `Data.Nat.DivMod`: ```agda _/_ = _div_ m%n≤m : m % n ≤ m m≤n⇒m%n≡m : m ≤ n → m % n ≡ m %-remove-+ˡ : d ∣ m → (m + n) % d ≡ n % d %-remove-+ʳ : d ∣ n → (m + n) % d ≡ m % d %-pred-≡0 : suc m % n ≡ 0 → m % n ≡ n ∸ 1 m<[1+n%d]⇒m≤[n%d] : m < suc n % d → m ≤ n % d [1+m%d]≤1+n⇒[m%d]≤n : 0 < suc m % d → suc m % d ≤ suc n → m % d ≤ n 0/n≡0 : 0 / n ≡ 0 n/1≡n : n / 1 ≡ n n/n≡1 : n / n ≡ 1 m*n/n≡m : m * n / n ≡ m m/n*n≡m : n ∣ m → m / n * n ≡ m m*[n/m]≡n : m ∣ n → m * (n / m) ≡ n m/n*n≤m : m / n * n ≤ m m/n-connex : Connex _≥_ _>_ <-≤-connex : Connex _<_ _≤_ >-≥-connex : Connex _>_ _≥_ 1+n≢0 : suc n ≢ 0 <ᵇ⇒< : T (m <ᵇ n) → m < n <⇒<ᵇ : m < n → T (m <ᵇ n) n≢0⇒n>0 : n ≢ 0 → n > 0 m≤m*n : 0 < n → m ≤ m * n m_ : Rel ℚ 0ℓ _≰_ : Rel ℚ 0ℓ _≱_ : Rel ℚ 0ℓ _≮_ : Rel ℚ 0ℓ _≯_ : Rel ℚ 0ℓ ``` * Added new proofs and modules to `Data.Rational.Properties`: ```agda ≡-setoid : Setoid 0ℓ 0ℓ ≡-decSetoid : DecSetoid 0ℓ 0ℓ drop-*<* : p < q → (↥ p ℤ.* ↧ q) ℤ.< (↥ q ℤ.* ↧ p) <⇒≤ : _<_ ⇒ _≤_ <-irrefl : Irreflexive _≡_ _<_ <-asym : Asymmetric _<_ <-≤-trans : Trans _<_ _≤_ _<_ ≤-<-trans : Trans _≤_ _<_ _<_ <-trans : Transitive _<_ _>=_ : TC A → (A → TC B) → TC B _>>_ : TC A → TC B → TC B assocˡ : Associativity assocʳ : Associativity non-assoc : Associativity unrelated : Precedence related : Int → Precedence fixity : Associativity → Precedence → Fixity getFixity : Name → Fixity vArg ty = arg (arg-info visible relevant) ty hArg ty = arg (arg-info hidden relevant) ty iArg ty = arg (arg-info instance′ relevant) ty vLam s t = lam visible (abs s t) hLam s t = lam hidden (abs s t) iLam s t = lam instance′ (abs s t) Π[_∶_]_ s a ty = pi a (abs s ty) vΠ[_∶_]_ s a ty = Π[ s ∶ (vArg a) ] ty hΠ[_∶_]_ s a ty = Π[ s ∶ (hArg a) ] ty iΠ[_∶_]_ s a ty = Π[ s ∶ (iArg a) ] ty ``` * Added new definition to `Setoid` in `Relation.Binary`: ```agda x ≉ y = ¬ (x ≈ y) ``` * Added new definitions in `Relation.Binary.Core`: ```agda Universal _∼_ = ∀ x y → x ∼ y Recomputable _~_ = ∀ {x y} → .(x ~ y) → x ~ y ``` * Added new proof to `Relation.Binary.Consequences`: ```agda dec⟶recomputable : Decidable R → Recomputable R flip-Connex : Connex P Q → Connex Q P ``` * Added new proofs to `Relation.Binary.Construct.Add.(Infimum/Supremum/Extrema).NonStrict`: ```agda ≤±-reflexive-≡ : (_≡_ ⇒ _≤_) → (_≡_ ⇒ _≤±_) ≤±-antisym-≡ : Antisymmetric _≡_ _≤_ → Antisymmetric _≡_ _≤±_ ≤±-isPreorder-≡ : IsPreorder _≡_ _≤_ → IsPreorder _≡_ _≤±_ ≤±-isPartialOrder-≡ : IsPartialOrder _≡_ _≤_ → IsPartialOrder _≡_ _≤±_ ≤±-isDecPartialOrder-≡ : IsDecPartialOrder _≡_ _≤_ → IsDecPartialOrder _≡_ _≤±_ ≤±-isTotalOrder-≡ : IsTotalOrder _≡_ _≤_ → IsTotalOrder _≡_ _≤±_ ≤±-isDecTotalOrder-≡ : IsDecTotalOrder _≡_ _≤_ → IsDecTotalOrder _≡_ _≤±_ ``` * Added new proofs to `Relation.Binary.Construct.Add.(Infimum/Supremum/Extrema).Strict`: ```agda <±-respˡ-≡ : _<±_ Respectsˡ _≡_ <±-respʳ-≡ : _<±_ Respectsʳ _≡_ <±-resp-≡ : _<±_ Respects₂ _≡_ <±-cmp-≡ : Trichotomous _≡_ _<_ → Trichotomous _≡_ _<±_ <±-irrefl-≡ : Irreflexive _≡_ _<_ → Irreflexive _≡_ _<±_ <±-isStrictPartialOrder-≡ : IsStrictPartialOrder _≡_ _<_ → IsStrictPartialOrder _≡_ _<±_ <±-isDecStrictPartialOrder-≡ : IsDecStrictPartialOrder _≡_ _<_ → IsDecStrictPartialOrder _≡_ _<±_ <±-isStrictTotalOrder-≡ : IsStrictTotalOrder _≡_ _<_ → IsStrictTotalOrder _≡_ _<±_ ``` * In `Relation.Binary.HeterogeneousEquality` the relation `_≅_` has been generalised so that the types of the two equal elements need not be at the same universe level. * Added new proof to `Relation.Binary.PropositionalEquality.Core`: ```agda ≢-sym : Symmetric _≢_ ``` * Added new proofs to `Relation.Nullary.Construct.Add.Point`: ```agda ≡-dec : Decidable {A = A} _≡_ → Decidable {A = Pointed A} _≡_ []-injective : [ x ] ≡ [ y ] → x ≡ y ``` * Added new type and syntax to `Relation.Unary`: ```agda Recomputable P = ∀ {x} → .(P x) → P x syntax Satisfiable P = ∃⟨ P ⟩ ``` * Added new proof to `Relation.Unary.Consequences`: ```agda dec⟶recomputable : Decidable R → Recomputable R ``` * Added new aliases for `IdempotentCommutativeMonoid` in `Algebra`: ```agda BoundedLattice = IdempotentCommutativeMonoid IsBoundedLattice = IsIdempotentCommutativeMonoid ``` * Added new functions to `Function`: ```agda _$- : ((x : A) → B x) → ({x : A} → B x) λ- : ({x : A} → B x) → ((x : A) → B x) ``` * Added new definition and proof to `Axiom.Extensionality.Propositional`: ```agda ExtensionalityImplicit = (∀ {x} → f {x} ≡ g {x}) → (λ {x} → f {x}) ≡ (λ {x} → g {x}) implicit-extensionality : Extensionality a b → ExtensionalityImplicit a b ``` * Added new definition in `Relation.Nullary`: ```agda Irrelevant P = ∀ (p₁ p₂ : P) → p₁ ≡ p₂ ``` * Added new proofs to `Relation.Nullary.Decidable.Core`: ```agda dec-yes : (p? : Dec P) → P → ∃ λ p′ → p? ≡ yes p′ dec-no : (p? : Dec P) → ¬ P → ∃ λ ¬p′ → p? ≡ no ¬p′ dec-yes-irr : (p? : Dec P) → Irrelevant P → (p : P) → p? ≡ yes p ``` agda-stdlib-1.1/CHANGELOG/000077500000000000000000000000001350553555600150315ustar00rootroot00000000000000agda-stdlib-1.1/CHANGELOG/v0.01.md000066400000000000000000000003331350553555600161160ustar00rootroot00000000000000Version 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-1.1/CHANGELOG/v0.02.md000066400000000000000000000005201350553555600161150ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.03.md000066400000000000000000000003311350553555600161160ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.04.md000066400000000000000000000003311350553555600161170ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.05.md000066400000000000000000000003321350553555600161210ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.06.md000066400000000000000000000003311350553555600161210ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.07.md000066400000000000000000000003311350553555600161220ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.08.1.md000066400000000000000000000007701350553555600162710ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.08.md000066400000000000000000000003311350553555600161230ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.09.md000066400000000000000000000016301350553555600161270ustar00rootroot00000000000000Version 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`. agda-stdlib-1.1/CHANGELOG/v0.10.md000066400000000000000000000107421350553555600161230ustar00rootroot00000000000000Version 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`. agda-stdlib-1.1/CHANGELOG/v0.11.md000066400000000000000000000011271350553555600161210ustar00rootroot00000000000000Version 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[_⊕_]`. agda-stdlib-1.1/CHANGELOG/v0.12.md000066400000000000000000000002201350553555600161130ustar00rootroot00000000000000Version 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. agda-stdlib-1.1/CHANGELOG/v0.13.md000066400000000000000000000034241350553555600161250ustar00rootroot00000000000000Version 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 ``` agda-stdlib-1.1/CHANGELOG/v0.14.md000066400000000000000000000774461350553555600161450ustar00rootroot00000000000000Version 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 ``` agda-stdlib-1.1/CHANGELOG/v0.15.md000066400000000000000000000734561350553555600161430ustar00rootroot00000000000000Version 0.15 ============ The library has been tested using Agda version 2.5.3. Non-backwards compatible changes -------------------------------- #### Upgrade and overhaul of organisation of relations over data * Relations over data have been moved from the `Relation` subtree to the `Data` subtree. This increases the usability of the library by: 1. keeping all the definitions concerning a given datatype in the same directory 2. providing a location to reason about how operations on the data affect the relations (e.g. how `Pointwise` is affected by `map`) 3. increasing the discoverability of the relations. There is anecdotal evidence that many users were not aware of the existence of the relations in the old location. In general the files have been moved from `Relation.Binary.X` to `Data.X.Relation`. The full list of moves is as follows: ``` `Relation.Binary.List.Pointwise` ↦ `Data.List.Relation.Pointwise` `Relation.Binary.List.StrictLex` ↦ `Data.List.Relation.Lex.Strict` `Relation.Binary.List.NonStrictLex` ↦ `Data.List.Relation.Lex.NonStrict` `Relation.Binary.Sum` ↦ `Data.Sum.Relation.Pointwise` ↘ `Data.Sum.Relation.LeftOrder` `Relation.Binary.Sigma.Pointwise` ↦ `Data.Product.Relation.Pointwise.Dependent' `Relation.Binary.Product.Pointwise` ↦ `Data.Product.Relation.Pointwise.NonDependent` `Relation.Binary.Product.StrictLex` ↦ `Data.Product.Relation.Lex.Strict` `Relation.Binary.Product.NonStrictLex` ↦ `Data.Product.Relation.Lex.NonStrict` `Relation.Binary.Vec.Pointwise` ↦ `Data.Vec.Relation.Pointwise.Inductive` ↘ `Data.Vec.Relation.Pointwise.Extensional` ``` The old files in `Relation.Binary.X` still exist for backwards compatability reasons and re-export the contents of files' new location in `Data.X.Relation` but may be removed in some future release. * The contents of `Relation.Binary.Sum` has been split into two modules `Data.Sum.Relation.Pointwise` and `Data.Sum.Relation.LeftOrder` * The contents of `Relation.Binary.Vec.Pointwise` has been split into two modules `Data.Vec.Relation.Pointwise.Inductive` and `Data.Vec.Relation.Pointwise.Extensional`. The inductive form of `Pointwise` has been generalised so that technically it can apply to two vectors with different lengths (although in practice the lengths must turn out to be equal). This allows a much wider range of proofs such as the fact that `[]` is a right identity for `_++_` which previously did not type check using the old definition. In order to ensure compatability with the `--without-K` option, the universe level of `Inductive.Pointwise` has been increased from `ℓ` to `a ⊔ b ⊔ ℓ`. * `Data.Vec.Equality` has been almost entirely reworked into four separate modules inside `Data.Vec.Relation.Equality` (namely `Setoid`, `DecSetoid`, `Propositional` and `DecPropositional`). All four of them now use `Data.Vec.Relation.Pointwise.Inductive` as a base. The proofs from the submodule `UsingVecEquality` in `Data.Vec.Properties` have been moved to these four new modules. * The datatype `All₂` has been removed from `Data.Vec.All`, along with associated proofs as it duplicates existing functionality in `Data.Vec.Relation.Pointwise.Inductive`. Unfortunately it is not possible to maintain backwards compatability due to dependency cycles. * Added new modules `Data.List.Relation.Equality.(Setoid/DecSetoid/Propositional/DecPropositional)`. #### Upgrade of `Data.AVL` * `Data.AVL.Key` and `Data.AVL.Height` have been split out of `Data.AVL` therefore ensuring they are independent on the type of `Value` the tree contains. * `Indexed` has been put into its own core module `Data.AVL.Indexed`, following the example of `Category.Monad.Indexed` and `Data.Container.Indexed`. * These changes allow `map` to have a polymorphic type and so it is now possible to change the type of values contained in a tree when mapping over it. #### Upgrade of `Algebra.Morphism` * Previously `Algebra.Morphism` only provides an example of a `Ring` homomorphism which packs the homomorphism and the proofs that it behaves the right way. Instead we have adopted and `Algebra.Structures`-like approach with proof-only records parametrised by the homomorphism and the structures it acts on. This make it possible to define the proof requirement for e.g. a ring in terms of the proof requirements for its additive abelian group and multiplicative monoid. #### Upgrade of `filter` and `partition` in `Data.List` * The functions `filter` and `partition` in `Data.List.Base` now use decidable predicates instead of boolean-valued functions. The boolean versions discarded type information, and hence were difficult to use and prove properties about. The proofs have been updated and renamed accordingly. The old boolean versions still exist as `boolFilter` and `boolPartition` for backwards compatibility reasons, but are deprecated and may be removed in some future release. The old versions can be implemented via the new versions by passing the decidability proof `λ v → f v ≟ true` with `_≟_` from `Data.Bool`. #### Overhaul of categorical interpretations of List and Vec * New modules `Data.List.Categorical` and `Data.Vec.Categorical` have been added for the categorical interpretations of `List` and `Vec`. The following have been moved to `Data.List.Categorical`: - The module `Monad` from `Data.List.Properties` (renamed to `MonadProperties`) - The module `Applicative` from `Data.List.Properties` - `monad`, `monadZero`, `monadPlus` and monadic operators from `Data.List` The following has been moved to `Data.Vec.Categorical`: - `applicative` and `functor` from `Data.Vec` - `lookup-morphism` and `lookup-functor-morphism` from `Data.Vec.Properties` #### Other * Removed support for GHC 7.8.4. * Renamed `Data.Container.FreeMonad.do` and `Data.Container.Indexed.FreeMonad.do` to `inn` as Agda 2.5.4 now supports proper 'do' notation. * Changed the fixity of `⋃` and `⋂` in `Relation.Unary` to make space for `_⊢_`. * Changed `_|_` from `Data.Nat.Divisibility` from data to a record. Consequently, the two parameters are no longer implicit arguments of the constructor (but such values can be destructed using a let-binding rather than a with-clause). * Names in `Data.Nat.Divisibility` now use the `divides` symbol (typed \\|) consistently. Previously a mixture of \\| and | was used. * Moved the proof `eq?` from `Data.Nat` to `Data.Nat.Properties` * The proofs that were called `+-monoˡ-<` and `+-monoʳ-<` in `Data.Nat.Properties` have been renamed `+-mono-<-≤` and `+-mono-≤-<` respectively. The original names are now used for proofs of left and right monotonicity of `_+_`. * Moved the proof `monoid` from `Data.List` to `++-monoid` in `Data.List.Properties`. * Names in Data.Nat.Divisibility now use the `divides` symbol (typed \\|) consistently. Previously a mixture of \\| and | was used. * Starting from Agda 2.5.4 the GHC backend compiles `Coinduction.∞` in a different way, and for this reason the GHC backend pragmas for `Data.Colist.Colist` and `Data.Stream.Stream` have been modified. Deprecated features ------------------- The following renaming has occurred as part of a drive to improve consistency across the library. The old names still exist and therefore all existing code should still work, however they have been deprecated and use of the new names is encouraged. Although not anticipated any time soon, they may eventually be removed in some future release of the library. * In `Data.Bool.Properties`: ```agda ∧-∨-distˡ ↦ ∧-distribˡ-∨ ∧-∨-distʳ ↦ ∧-distribʳ-∨ distrib-∧-∨ ↦ ∧-distrib-∨ ∨-∧-distˡ ↦ ∨-distribˡ-∧ ∨-∧-distʳ ↦ ∨-distribʳ-∧ ∨-∧-distrib ↦ ∨-distrib-∧ ∨-∧-abs ↦ ∨-abs-∧ ∧-∨-abs ↦ ∧-abs-∨ not-∧-inverseˡ ↦ ∧-inverseˡ not-∧-inverseʳ ↦ ∧-inverseʳ not-∧-inverse ↦ ∧-inverse not-∨-inverseˡ ↦ ∨-inverseˡ not-∨-inverseʳ ↦ ∨-inverseʳ not-∨-inverse ↦ ∨-inverse isCommutativeSemiring-∨-∧ ↦ ∨-∧-isCommutativeSemiring commutativeSemiring-∨-∧ ↦ ∨-∧-commutativeSemiring isCommutativeSemiring-∧-∨ ↦ ∧-∨-isCommutativeSemiring commutativeSemiring-∧-∨ ↦ ∧-∨-commutativeSemiring isBooleanAlgebra ↦ ∨-∧-isBooleanAlgebra booleanAlgebra ↦ ∨-∧-booleanAlgebra commutativeRing-xor-∧ ↦ xor-∧-commutativeRing proof-irrelevance ↦ T-irrelevance ``` * In `Data.Fin.Properties`: ```agda cmp ↦ <-cmp strictTotalOrder ↦ <-strictTotalOrder ``` * In `Data.Integer.Properties`: ```agda inverseˡ ↦ +-inverseˡ inverseʳ ↦ +-inverseʳ distribʳ ↦ *-distribʳ-+ isCommutativeSemiring ↦ +-*-isCommutativeSemiring commutativeRing ↦ +-*-commutativeRing *-+-right-mono ↦ *-monoʳ-≤-pos cancel-*-+-right-≤ ↦ *-cancelʳ-≤-pos cancel-*-right ↦ *-cancelʳ-≡ doubleNeg ↦ neg-involutive -‿involutive ↦ neg-involutive +-⊖-left-cancel ↦ +-cancelˡ-⊖ ``` * In `Data.List.Base`: ```agda gfilter ↦ mapMaybe ``` * In `Data.List.Properties`: ```agda right-identity-unique ↦ ++-identityʳ-unique left-identity-unique ↦ ++-identityˡ-unique ``` * In `Data.List.Relation.Pointwise`: ```agda Rel ↦ Pointwise Rel≡⇒≡ ↦ Pointwise-≡⇒≡ ≡⇒Rel≡ ↦ ≡⇒Pointwise-≡ Rel↔≡ ↦ Pointwise-≡↔≡ ``` * In `Data.Nat.Properties`: ```agda ¬i+1+j≤i ↦ i+1+j≰i ≤-steps ↦ ≤-stepsˡ ``` * In all modules in the `Data.(Product/Sum).Relation` folders, all proofs with names using infix notation have been deprecated in favour of identical non-infix names, e.g. ``` _×-isPreorder_ ↦ ×-isPreorder ``` * In `Data.Product.Relation.Lex.(Non)Strict`: ```agda ×-≈-respects₂ ↦ ×-respects₂ ``` * In `Data.Product.Relation.Pointwise.Dependent`: ```agda Rel ↦ Pointwise Rel↔≡ ↦ Pointwise-≡↔≡ ``` * In `Data.Product.Relation.Pointwise.NonDependent`: ```agda _×-Rel_ ↦ Pointwise Rel↔≡ ↦ Pointwise-≡↔≡ _×-≈-respects₂_ ↦ ×-respects₂ ``` * In `Data.Sign.Properties`: ```agda opposite-not-equal ↦ s≢opposite[s] opposite-cong ↦ opposite-injective cancel-*-left ↦ *-cancelˡ-≡ cancel-*-right ↦ *-cancelʳ-≡ *-cancellative ↦ *-cancel-≡ ``` * In `Data.Vec.Properties`: ```agda proof-irrelevance-[]= ↦ []=-irrelevance ``` * In `Data.Vec.Relation.Pointwise.Inductive`: ```agda Pointwise-≡ ↦ Pointwise-≡↔≡ ``` * In `Data.Vec.Relation.Pointwise.Extensional`: ```agda Pointwise-≡ ↦ Pointwise-≡↔≡ ``` * In `Induction.Nat`: ```agda rec-builder ↦ recBuilder cRec-builder ↦ cRecBuilder <′-rec-builder ↦ <′-recBuilder <-rec-builder ↦ <-recBuilder ≺-rec-builder ↦ ≺-recBuilder <′-well-founded ↦ <′-wellFounded <′-well-founded′ ↦ <′-wellFounded′ <-well-founded ↦ <-wellFounded ≺-well-founded ↦ ≺-wellFounded ``` * In `Induction.WellFounded`: ```agda Well-founded ↦ WellFounded Some.wfRec-builder ↦ Some.wfRecBuilder All.wfRec-builder ↦ All.wfRecBuilder Subrelation.well-founded ↦ Subrelation.wellFounded InverseImage.well-founded ↦ InverseImage.wellFounded TransitiveClosure.downwards-closed ↦ TransitiveClosure.downwardsClosed TransitiveClosure.well-founded ↦ TransitiveClosure.wellFounded Lexicographic.well-founded ↦ Lexicographic.wellFounded ``` * In `Relation.Binary.PropositionalEquality`: ```agda proof-irrelevance ↦ ≡-irrelevance ``` Removed features ---------------- #### Deprecated in version 0.10 * Modules `Deprecated-inspect` and `Deprecated-inspect-on-steroids` in `Relation.Binary.PropositionalEquality`. * Module `Deprecated-inspect-on-steroids` in `Relation.Binary.HeterogeneousEquality`. Backwards compatible changes ---------------------------- * Added support for GHC 8.2.2. * New module `Data.Word` for new builtin type `Agda.Builtin.Word.Word64`. * New modules `Data.Table`, `Data.Table.Base`, `Data.Table.Relation.Equality` and `Data.Table.Properties`. A `Table` is a fixed-length collection of objects similar to a `Vec` from `Data.Vec`, but implemented as a function `Fin n → A`. This prioritises ease of lookup as opposed to `Vec` which prioritises the ease of adding and removing elements. * The contents of the following modules are now more polymorphic with respect to levels: ```agda Data.Covec Data.List.Relation.Lex.Strict Data.List.Relation.Lex.NonStrict Data.Vec.Properties Data.Vec.Relation.Pointwise.Inductive Data.Vec.Relation.Pointwise.Extensional ``` * Added new proof to `asymmetric : Asymmetric _<_` to the `IsStrictPartialOrder` record. * Added new proofs to `Data.AVL`: ```agda leaf-injective : leaf p ≡ leaf q → p ≡ q node-injective-key : node k₁ lk₁ ku₁ bal₁ ≡ node k₂ lk₂ ku₂ bal₂ → k₁ ≡ k₂ node-injectiveˡ : node k lk₁ ku₁ bal₁ ≡ node k lk₂ ku₂ bal₂ → lk₁ ≡ lk₂ node-injectiveʳ : node k lk₁ ku₁ bal₁ ≡ node k lk₂ ku₂ bal₂ → ku₁ ≡ ku₂ node-injective-bal : node k lk₁ ku₁ bal₁ ≡ node k lk₂ ku₂ bal₂ → bal₁ ≡ bal₂ ``` * Added new proofs to `Data.Bin`: ```agda less-injective : (b₁ < b₂ ∋ less lt₁) ≡ less lt₂ → lt₁ ≡ lt₂ ``` * Added new proofs to `Data.Bool.Properties`: ```agda ∨-identityˡ : LeftIdentity false _∨_ ∨-identityʳ : RightIdentity false _∨_ ∨-identity : Identity false _∨_ ∨-zeroˡ : LeftZero true _∨_ ∨-zeroʳ : RightZero true _∨_ ∨-zero : Zero true _∨_ ∨-idem : Idempotent _∨_ ∨-sel : Selective _∨_ ∨-isSemigroup : IsSemigroup _≡_ _∨_ ∨-isCommutativeMonoid : IsCommutativeMonoid _≡_ _∨_ false ∧-identityˡ : LeftIdentity true _∧_ ∧-identityʳ : RightIdentity true _∧_ ∧-identity : Identity true _∧_ ∧-zeroˡ : LeftZero false _∧_ ∧-zeroʳ : RightZero false _∧_ ∧-zero : Zero false _∧_ ∧-idem : Idempotent _∧_ ∧-sel : Selective _∧_ ∧-isSemigroup : IsSemigroup _≡_ _∧_ ∧-isCommutativeMonoid : IsCommutativeMonoid _≡_ _∧_ true ∨-∧-isLattice : IsLattice _≡_ _∨_ _∧_ ∨-∧-isDistributiveLattice : IsDistributiveLattice _≡_ _∨_ _∧_ ``` * Added missing bindings to functions on `Data.Char.Base`: ```agda isLower : Char → Bool isDigit : Char → Bool isAlpha : Char → Bool isSpace : Char → Bool isAscii : Char → Bool isLatin1 : Char → Bool isPrint : Char → Bool isHexDigit : Char → Bool toNat : Char → ℕ fromNat : ℕ → Char ``` * Added new proofs to `Data.Cofin`: ```agda suc-injective : (Cofin (suc m) ∋ suc p) ≡ suc q → p ≡ q ``` * Added new proofs to `Data.Colist`: ```agda ∷-injectiveˡ : (Colist A ∋ x ∷ xs) ≡ y ∷ ys → x ≡ y ∷-injectiveʳ : (Colist A ∋ x ∷ xs) ≡ y ∷ ys → xs ≡ ys here-injective : (Any P (x ∷ xs) ∋ here p) ≡ here q → p ≡ q there-injective : (Any P (x ∷ xs) ∋ there p) ≡ there q → p ≡ q ∷-injectiveˡ : (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → px ≡ qx ∷-injectiveʳ : (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → pxs ≡ qxs ∷-injective : (Finite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ∷-injective : (Infinite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ``` * Added new operations and proofs to `Data.Conat`: ```agda pred : Coℕ → Coℕ suc-injective : (Coℕ ∋ suc m) ≡ suc n → m ≡ n fromℕ-injective : fromℕ m ≡ fromℕ n → m ≡ n suc-injective : (suc m ≈ suc n ∋ suc p) ≡ suc q → p ≡ q ``` * Added new proofs to `Data.Covec`: ```agda ∷-injectiveˡ : (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → a ≡ b ∷-injectiveʳ : (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → as ≡ bs ``` * Added new proofs to `Data.Fin.Properties`: ```agda ≤-isDecTotalOrder : ∀ {n} → IsDecTotalOrder _≡_ (_≤_ {n}) ≤-irrelevance : ∀ {n} → IrrelevantRel (_≤_ {n}) <-asym : ∀ {n} → Asymmetric (_<_ {n}) <-irrefl : ∀ {n} → Irreflexive _≡_ (_<_ {n}) <-irrelevance : ∀ {n} → IrrelevantRel (_<_ {n}) ``` * Added new proofs to `Data.Integer.Properties`: ```agda +-cancelˡ-⊖ : (a + b) ⊖ (a + c) ≡ b ⊖ c neg-minus-pos : -[1+ m ] - (+ n) ≡ -[1+ (m + n) ] [+m]-[+n]≡m⊖n : (+ m) - (+ n) ≡ m ⊖ n ∣m-n∣≡∣n-m∣ : ∣ m - n ∣ ≡ ∣ n - m ∣ +-minus-telescope : (m - n) + (n - o) ≡ m - o pos-distrib-* : ∀ x y → (+ x) * (+ y) ≡ + (x * y) ≤-irrelevance : IrrelevantRel _≤_ <-irrelevance : IrrelevantRel _<_ ``` * Added new combinators to `Data.List.Base`: ```agda lookup : (xs : List A) → Fin (length xs) → A unzipWith : (A → B × C) → List A → List B × List C unzip : List (A × B) → List A × List B ``` * Added new proofs to `Data.List.Properties`: ```agda ∷-injectiveˡ : x ∷ xs ≡ y List.∷ ys → x ≡ y ∷-injectiveʳ : x ∷ xs ≡ y List.∷ ys → xs ≡ ys ∷ʳ-injectiveˡ : xs ∷ʳ x ≡ ys ∷ʳ y → xs ≡ ys ∷ʳ-injectiveʳ : xs ∷ʳ x ≡ ys ∷ʳ y → x ≡ y ++-assoc : Associative {A = List A} _≡_ _++_ ++-identityˡ : LeftIdentity _≡_ [] _++_ ++-identityʳ : RightIdentity _≡_ [] _++_ ++-identity : Identity _≡_ [] _++_ ++-isSemigroup : IsSemigroup {A = List A} _≡_ _++_ ++-isMonoid : IsMonoid {A = List A} _≡_ _++_ [] ++-semigroup : ∀ {a} (A : Set a) → Semigroup _ _ ++-monoid : ∀ {a} (A : Set a) → Monoid _ _ filter-none : All P xs → dfilter P? xs ≡ xs filter-some : Any (∁ P) xs → length (filter P? xs) < length xs filter-notAll : Any P xs → 0 < length (filter P? xs) filter-all : All (∁ P) xs → dfilter P? xs ≡ [] filter-complete : length (filter P? xs) ≡ length xs → filter P? xs ≡ xs tabulate-cong : f ≗ g → tabulate f ≡ tabulate g tabulate-lookup : tabulate (lookup xs) ≡ xs zipWith-identityˡ : ∀ xs → zipWith f [] xs ≡ [] zipWith-identityʳ : ∀ xs → zipWith f xs [] ≡ [] zipWith-comm : (∀ x y → f x y ≡ f y x) → zipWith f xs ys ≡ zipWith f ys xs zipWith-unzipWith : uncurry′ g ∘ f ≗ id → uncurry′ (zipWith g) ∘ (unzipWith f) ≗ id zipWith-map : zipWith f (map g xs) (map h ys) ≡ zipWith (λ x y → f (g x) (h y)) xs ys map-zipWith : map g (zipWith f xs ys) ≡ zipWith (λ x y → g (f x y)) xs ys length-zipWith : length (zipWith f xs ys) ≡ length xs ⊓ length ys length-unzipWith₁ : length (proj₁ (unzipWith f xys)) ≡ length xys length-unzipWith₂ : length (proj₂ (unzipWith f xys)) ≡ length xys ``` * Added new proofs to `Data.List.All.Properties`: ```agda All-irrelevance : IrrelevantPred P → IrrelevantPred (All P) filter⁺₁ : All P (filter P? xs) filter⁺₂ : All Q xs → All Q (filter P? xs) mapMaybe⁺ : All (Maybe.All P) (map f xs) → All P (mapMaybe f xs) zipWith⁺ : Pointwise (λ x y → P (f x y)) xs ys → All P (zipWith f xs ys) ``` * Added new proofs to `Data.List.Any.Properties`: ```agda mapMaybe⁺ : Any (Maybe.Any P) (map f xs) → Any P (mapMaybe f xs) ``` * Added new proofs to `Data.List.Relation.Lex.NonStrict`: ```agda <-antisymmetric : Symmetric _≈_ → Antisymmetric _≈_ _≼_ → Antisymmetric _≋_ _<_ <-transitive : IsPartialOrder _≈_ _≼_ → Transitive _<_ <-resp₂ : IsEquivalence _≈_ → _≼_ Respects₂ _≈_ → _<_ Respects₂ _≋_ ≤-antisymmetric : Symmetric _≈_ → Antisymmetric _≈_ _≼_ → Antisymmetric _≋_ _≤_ ≤-transitive : IsPartialOrder _≈_ _≼_ → Transitive _≤_ ≤-resp₂ : IsEquivalence _≈_ → _≼_ Respects₂ _≈_ → _≤_ Respects₂ _≋_ ``` * Added new proofs to `Data.List.Relation.Pointwise`: ```agda tabulate⁺ : (∀ i → f i ∼ g i) → Pointwise _∼_ (tabulate f) (tabulate g) tabulate⁻ : Pointwise _∼_ (tabulate f) (tabulate g) → (∀ i → f i ∼ g i) ++⁺ : Pointwise _∼_ ws xs → Pointwise _∼_ ys zs → Pointwise _∼_ (ws ++ ys) (xs ++ zs) concat⁺ : Pointwise (Pointwise _∼_) xss yss → Pointwise _∼_ (concat xss) (concat yss) ``` * Added new proofs to `Data.List.Relation.Lex.Strict`: ```agda <-antisymmetric : Symmetric _≈_ → Irreflexive _≈_ _≺_ → Asymmetric _≺_ → Antisymmetric _≋_ _<_ <-transitive : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → Transitive _≺_ → Transitive _<_ <-respects₂ : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → _<_ Respects₂ _≋_ ≤-antisymmetric : Symmetric _≈_ → Irreflexive _≈_ _≺_ → Asymmetric _≺_ → Antisymmetric _≋_ _≤_ ≤-transitive : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → Transitive _≺_ → Transitive _≤_ ≤-respects₂ : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → _≤_ Respects₂ _≋_ ``` * Added new proofs to `Data.Maybe.Base`: ```agda just-injective : (Maybe A ∋ just a) ≡ just b → a ≡ b ``` * Added new proofs to `Data.Nat.Divisibility`: ```agda m|m*n : m ∣ m * n ∣m⇒∣m*n : i ∣ m → i ∣ m * n ∣n⇒∣m*n : i ∣ n → i ∣ m * n ``` * Added new proofs to `Data.Nat.Properties`: ```agda ≤⇒≯ : _≤_ ⇒ _≯_ n≮n : ∀ n → n ≮ n ≤-stepsʳ : ∀ m ≤ n → m ≤ n + o ≤-irrelevance : IrrelevantRel _≤_ <-irrelevance : IrrelevantRel _<_ +-monoˡ-≤ : ∀ n → (_+ n) Preserves _≤_ ⟶ _≤_ +-monoʳ-≤ : ∀ n → (n +_) Preserves _≤_ ⟶ _≤_ +-monoˡ-< : ∀ n → (_+ n) Preserves _<_ ⟶ _<_ +-monoʳ-< : ∀ n → (n +_) Preserves _<_ ⟶ _<_ +-semigroup : Semigroup _ _ +-0-monoid : Monoid _ _ +-0-commutativeMonoid : CommutativeMonoid _ _ *-monoˡ-≤ : ∀ n → (_* n) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤ : ∀ n → (n *_) Preserves _≤_ ⟶ _≤_ *-semigroup : Semigroup _ _ *-1-monoid : Monoid _ _ *-1-commutativeMonoid : CommutativeMonoid _ _ *-+-semiring : Semiring _ _ ^-identityʳ : RightIdentity 1 _^_ ^-zeroˡ : LeftZero 1 _^_ ^-semigroup-morphism : (x ^_) Is +-semigroup -Semigroup⟶ *-semigroup ^-monoid-morphism : (x ^_) Is +-0-monoid -Monoid⟶ *-1-monoid m≤n⇒m⊓n≡m : m ≤ n → m ⊓ n ≡ m m≤n⇒n⊓m≡m : m ≤ n → n ⊓ m ≡ m m≤n⇒n⊔m≡n : m ≤ n → n ⊔ m ≡ n m≤n⇒m⊔n≡n : m ≤ n → m ⊔ n ≡ n ⊔-monoˡ-≤ : ∀ n → (_⊔ n) Preserves _≤_ ⟶ _≤_ ⊔-monoʳ-≤ : ∀ n → (n ⊔_) Preserves _≤_ ⟶ _≤_ ⊓-monoˡ-≤ : ∀ n → (_⊓ n) Preserves _≤_ ⟶ _≤_ ⊓-monoʳ-≤ : ∀ n → (n ⊓_) Preserves _≤_ ⟶ _≤_ m∸n+n≡m : n ≤ m → (m ∸ n) + n ≡ m m∸[m∸n]≡n : n ≤ m → m ∸ (m ∸ n) ≡ n s≤s-injective : s≤s p ≡ s≤s q → p ≡ q ≤′-step-injective : ≤′-step p ≡ ≤′-step q → p ≡ q ``` * Added new proofs to `Data.Plus`: ```agda []-injective : (x [ _∼_ ]⁺ y ∋ [ p ]) ≡ [ q ] → p ≡ q ∼⁺⟨⟩-injectiveˡ : (x [ _∼_ ]⁺ z ∋ x ∼⁺⟨ p ⟩ q) ≡ (x ∼⁺⟨ r ⟩ s) → p ≡ r ∼⁺⟨⟩-injectiveʳ : (x [ _∼_ ]⁺ z ∋ x ∼⁺⟨ p ⟩ q) ≡ (x ∼⁺⟨ r ⟩ s) → q ≡ s ``` * Added new combinator to `Data.Product`: ```agda curry′ : (A × B → C) → (A → B → C) ``` * Added new proofs to `Data.Product.Properties`: ```agda ,-injectiveˡ : (a , b) ≡ (c , d) → a ≡ c ,-injectiveʳ : (Σ A B ∋ (a , b)) ≡ (a , c) → b ≡ c ``` * Added new operator in `Data.Product.Relation.Pointwise.NonDependent`: ```agda _×ₛ_ : Setoid ℓ₁ ℓ₂ → Setoid ℓ₃ ℓ₄ → Setoid _ _ ``` * Added new proofs to `Data.Rational.Properties`: ```agda ≤-irrelevance : IrrelevantRel _≤_ ``` * Added new proofs to `Data.ReflexiveClosure`: ```agda []-injective : (Refl _∼_ x y ∋ [ p ]) ≡ [ q ] → p ≡ q ``` * Added new proofs to `Data.Sign`: ```agda *-isSemigroup : IsSemigroup _≡_ _*_ *-semigroup : Semigroup _ _ *-isMonoid : IsMonoid _≡_ _*_ + *-monoid : Monoid _ _ ``` * Added new proofs to `Data.Star.Properties`: ```agda ◅-injectiveˡ : (Star T i k ∋ x ◅ xs) ≡ y ◅ ys → x ≡ y ◅-injectiveʳ : (Star T i k ∋ x ◅ xs) ≡ y ◅ ys → xs ≡ ys ``` * Added new proofs to `Data.Sum.Properties`: ```agda inj₁-injective : (A ⊎ B ∋ inj₁ x) ≡ inj₁ y → x ≡ y inj₂-injective : (A ⊎ B ∋ inj₂ x) ≡ inj₂ y → x ≡ y ``` * Added new operator in `Data.Sum.Relation.Pointwise`: ```agda _⊎ₛ_ : Setoid ℓ₁ ℓ₂ → Setoid ℓ₃ ℓ₄ → Setoid _ _ ``` * Added new proofs to `Data.Vec.Properties`: ```agda ∷-injectiveˡ : x ∷ xs ≡ y ∷ ys → x ≡ y ∷-injectiveʳ : x ∷ xs ≡ y ∷ ys → xs ≡ ys []=⇒lookup : xs [ i ]= x → lookup i xs ≡ x lookup⇒[]= : lookup i xs ≡ x → xs [ i ]= x lookup-replicate : lookup i (replicate x) ≡ x lookup-⊛ : lookup i (fs ⊛ xs) ≡ (lookup i fs $ lookup i xs) tabulate-cong : f ≗ g → tabulate f ≡ tabulate g ``` * Added new proofs to `Data.Vec.All.Properties` ```agda All-irrelevance : IrrelevantPred P → ∀ {n} → IrrelevantPred (All P {n}) ``` * Added new proofs to `Data.Vec.Relation.Pointwise.Extensional`: ```agda isDecEquivalence : IsDecEquivalence _~_ → IsDecEquivalence (Pointwise _~_) extensional⇒inductive : Pointwise _~_ xs ys → IPointwise _~_ xs ys inductive⇒extensional : IPointwise _~_ xs ys → Pointwise _~_ xs ys ≡⇒Pointwise-≡ : Pointwise _≡_ xs ys → xs ≡ ys Pointwise-≡⇒≡ : xs ≡ ys → Pointwise _≡_ xs ys ``` * Added new proofs to `Data.Vec.Relation.Pointwise.Inductive`: ```agda ++⁺ : Pointwise P xs → Pointwise P ys → Pointwise P (xs ++ ys) ++⁻ˡ : Pointwise P (xs ++ ys) → Pointwise P xs ++⁻ʳ : Pointwise P (xs ++ ys) → Pointwise P ys ++⁻ : Pointwise P (xs ++ ys) → Pointwise P xs × Pointwise P ys concat⁺ : Pointwise (Pointwise P) xss → Pointwise P (concat xss) concat⁻ : Pointwise P (concat xss) → Pointwise (Pointwise P) xss lookup : Pointwise _~_ xs ys → ∀ i → lookup i xs ~ lookup i ys isDecEquivalence : IsDecEquivalence _~_ → IsDecEquivalence (Pointwise _~_) ≡⇒Pointwise-≡ : Pointwise _≡_ xs ys → xs ≡ ys Pointwise-≡⇒≡ : xs ≡ ys → Pointwise _≡_ xs ys Pointwiseˡ⇒All : Pointwise (λ x y → P x) xs ys → All P xs Pointwiseʳ⇒All : Pointwise (λ x y → P y) xs ys → All P ys All⇒Pointwiseˡ : All P xs → Pointwise (λ x y → P x) xs ys All⇒Pointwiseʳ : All P ys → Pointwise (λ x y → P y) xs ys ``` * Added new functions and proofs to `Data.W`: ```agda map : (f : A → C) → ∀[ D ∘ f ⇒ B ] → W A B → W C D induction : (∀ a {f} (hf : ∀ (b : B a) → P (f b)) → (w : W A B) → P w foldr : (∀ a → (B a → P) → P) → W A B → P sup-injective₁ : sup x f ≡ sup y g → x ≡ y sup-injective₂ : sup x f ≡ sup x g → f ≡ g ``` * Added new properties to `Relation.Binary.PropositionalEquality` ```agda isPropositional A = (a b : A) → a ≡ b IrrelevantPred P = ∀ {x} → isPropositional (P x) IrrelevantRel _~_ = ∀ {x y} → isPropositional (x ~ y) ``` * Added new combinator to ` Relation.Binary.PropositionalEquality.TrustMe`: ```agda postulate[_↦_] : (t : A) → B t → (x : A) → B x ``` * Added new proofs to `Relation.Binary.StrictToNonStrict`: ```agda isPreorder₁ : IsPreorder _≈_ _<_ → IsPreorder _≈_ _≤_ isPreorder₂ : IsStrictPartialOrder _≈_ _<_ → IsPreorder _≈_ _≤_ isPartialOrder : IsStrictPartialOrder _≈_ _<_ → IsPartialOrder _≈_ _≤_ isTotalOrder : IsStrictTotalOrder _≈_ _<_ → IsTotalOrder _≈_ _≤_ isDecTotalOrder : IsStrictTotalOrder _≈_ _<_ → IsDecTotalOrder _≈_ _≤_ ``` * Added new syntax, relations and proofs to `Relation.Unary`: ```agda syntax Universal P = ∀[ P ] P ⊈ Q = ¬ (P ⊆ Q) P ⊉ Q = ¬ (P ⊇ Q) P ⊂ Q = P ⊆ Q × Q ⊈ P P ⊃ Q = Q ⊂ P P ⊄ Q = ¬ (P ⊂ Q) P ⊅ Q = ¬ (P ⊃ Q) P ⊈′ Q = ¬ (P ⊆′ Q) P ⊉′ Q = ¬ (P ⊇′ Q) P ⊂′ Q = P ⊆′ Q × Q ⊈′ P P ⊃′ Q = Q ⊂′ P P ⊄′ Q = ¬ (P ⊂′ Q) P ⊅′ Q = ¬ (P ⊃′ Q) f ⊢ P = λ x → P (f x) ∁? : Decidable P → Decidable (∁ P) ``` * Added `recompute` to `Relation.Nullary`: ```agda recompute : ∀ {a} {A : Set a} → Dec A → .A → A ``` agda-stdlib-1.1/CHANGELOG/v0.16.md000066400000000000000000000643351350553555600161400ustar00rootroot00000000000000Version 0.16 ============ The library has been tested using Agda version 2.5.4. Important changes since 0.15: Non-backwards compatible changes -------------------------------- #### Final overhaul of list membership * The aim of this final rearrangement of list membership is to create a better interface for the different varieties of membership, and make it easier to predict where certain proofs are found. Each of the new membership modules are parameterised by the relevant types so as to allow easy access to the infix `_∈_` and `_∈?_` operators. It also increases the discoverability of the modules by new users of the library. * The following re-organisation of list membership modules has occurred: ```agda Data.List.Any.BagAndSetEquality ↦ Data.List.Relation.BagAndSetEquality Data.List.Any.Membership ↦ Data.List.Membership.Setoid ↘ Data.List.Membership.DecSetoid ↘ Data.List.Relation.Sublist.Setoid Data.List.Any.Membership.Propositional ↦ Data.List.Membership.Propositional ↘ Data.List.Membership.DecPropositional ↘ Data.List.Relation.Sublist.Propositional ``` * The `_⊆_` relation has been moved out of the `Membership` modules to new modules `Data.List.Relation.Sublist.(Setoid/Propositional)`. Consequently the `mono` proofs that were in `Data.List.Membership.Propositional.Properties` have been moved to `Data.List.Relation.Sublist.Propositional.Properties`. * The following proofs have been moved from `Data.List.Any.Properties` to `Data.List.Membership.Propositional.Properties.Core`: ```agda map∘find, find∘map, find-∈, lose∘find, find∘lose, ∃∈-Any, Any↔ ``` * The following types and terms have been moved from `Data.List.Membership.Propositional` into `Relation.BagAndSetEquality`: ```agda Kind, Symmetric-kind set, subset, superset, bag, subbag, superbag [_]-Order, [_]-Equality, _∼[_]_ ``` * The type of the proof of `∈-resp-≈` in `Data.List.Membership.Setoid.Properties` has changed from `∀ {x} → (x ≈_) Respects _≈_` to `∀ {xs} → (_∈ xs) Respects _≈_`. #### Upgrade of `Algebra.Operations` * Previously `Algebra.Operations` was parameterised by a semiring, however several of the operators it defined depended only on the additive component. Therefore the modules have been rearranged to allow more fine-grained use depending on the current position in the algebra heirarchy. Currently there exist two modules: ``` Algebra.Operations.CommutativeMonoid Algebra.Operations.Semiring ``` where `Algebra.Operations.Semiring` exports all the definitions previously exported by `Algebra.Operations`. More modules may be added in future as required. Also the fixity of `_×_`, `_×′_` and `_^_` have all been increased by 1. #### Upgrade of `takeWhile`, `dropWhile`, `span` and `break` in `Data.List` * These functions in `Data.List.Base` now use decidable predicates instead of boolean-valued functions. The boolean versions discarded type information, and hence were difficult to use and prove properties about. The proofs have been updated and renamed accordingly. The old boolean versions still exist as `boolTakeWhile`, `boolSpan` etc. for backwards compatibility reasons, but are deprecated and may be removed in some future release. The old versions can be implemented via the new versions by passing the decidability proof `λ v → f v ≟ true` with `_≟_` from `Data.Bool`. #### Other * `Relation.Binary.Consequences` no longer exports `Total`. The standard way of accessing it through `Relation.Binary` remains unchanged. * `_⇒_` in `Relation.Unary` is now right associative instead of left associative. * Added new module `Relation.Unary.Properties`. The following proofs have been moved to the new module from `Relation.Unary`: `∅-Empty`, `∁∅-Universal`, `U-Universal`, `∁U-Empty`, `∅-⊆`, `⊆-U` and `∁?`. * The set operations `_∩/∪_` in `Data.Fin.Subset` are now implemented more efficiently using `zipWith _∧/∨_ p q` rather than `replicate _∧/∨_ ⊛ p ⊛ q`. The proof `booleanAlgebra` has been moved to `∩-∪-booleanAlgebra` in `Data.Fin.Subset.Properties`. * The decidability proofs `_≟_` and `__ : F A → (A → B) → F B ``` * Added new function to `Category.Monad.Indexed`: ```agda RawIMonadT : (T : IFun I f → IFun I f) → Set (i ⊔ suc f) ``` * Added new function to `Category.Monad`: ```agda RawMonadT : (T : (Set f → Set f) → (Set f → Set f)) → Set _ ``` * Added new functions to `Codata.Delay`: ```agda alignWith : (These A B → C) → Delay A i → Delay B i → Delay C i zip : Delay A i → Delay B i → Delay (A × B) i align : Delay A i → Delay B i → Delay (These A B) i ``` * Added new functions to `Codata.Musical.M`: ```agda map : (C₁ ⇒ C₂) → M C₁ → M C₂ unfold : (S → ⟦ C ⟧ S) → S → M C ``` * Added new proof to `Data.Fin.Permutation`: ```agda refute : m ≢ n → ¬ Permutation m n ``` Additionally the definitions `punchIn-permute` and `punchIn-permute′` have been generalised to work with heterogeneous permutations. * Added new proof to `Data.Fin.Properties`: ```agda toℕ-fromℕ≤″ : toℕ (fromℕ≤″ m m?_ : Decidable _>_ _≤′?_ : Decidable _≤′_ _<′?_ : Decidable _<′_ _≤″?_ : Decidable _≤″_ _<″?_ : Decidable _<″_ _≥″?_ : Decidable _≥″_ _>″?_ : Decidable _>″_ n≤0⇒n≡0 : n ≤ 0 → n ≡ 0 m Val` rather than a value together with a merging function `Val -> Val -> Val` to handle the case where a value is already present at that key. * Various functions have been made polymorphic which makes their biases & limitations clearer. e.g. we have: `unionWith : (V -> Maybe W -> W) -> Tree V -> Tree W -> Tree W` but ideally we would like to have: `unionWith : (These V W -> X) -> Tree V -> Tree W -> Tree X` * Keys are now implemented via the new `Relation.(Binary/Nullary).Construct.AddExtrema` modules. #### Overhaul of `Data.Container` * `Data.Container` has been split up into the standard hierarchy. * Moved `Data.Container`'s `All` and `Any` into their own `Data.Container.Relation.Unary.X` module. Made them record types to improve type inference. * Moved morphisms to `Data.Container.Morphism` and their properties to `Data.Container.Morphism.Properties`. * Made the index set explicit in `Data.Container.Combinator`'s `Π` and `Σ`. * Moved `Eq` to `Data.Container.Relation.Binary.Pointwise` (and renamed it to `Pointwise`) and its properties to `Data.Container.Relation.Binary.Pointwise.Properties`. * The type family `Data.Container.ν` is now defined using `Codata.M.M` rather than Codata.Musical.M.M`. #### Overhaul of `Data.Maybe` * `Data.Maybe` has been split up into the standard hierarchy for container datatypes. * Moved `Data.Maybe.Base`'s `Is-just`, `Is-nothing`, `to-witness`, and `to-witness-T` to `Data.Maybe` (they rely on `All` and `Any` which are now outside of `Data.Maybe.Base`). * Moved `Data.Maybe.Base`'s `All` and `Data.Maybe`'s `allDec` to `Data.Maybe.Relation.Unary.All` and renamed the proof `allDec` to `dec`. * Moved `Data.Maybe.Base`'s `Any` and `Data.Maybe`'s `anyDec` to `Data.Maybe.Relation.Unary.Any` and renamed the proof `anyDec` to `dec`. * Created `Data.Maybe.Properties` and moved `Data.Maybe.Base`'s `just-injective` into it and added new results. * Moved `Data.Maybe`'s `Eq` to `Data.Maybe.Relation.Binary.Pointwise`, made the relation heterogeneously typed and renamed the following proofs: ```agda Eq ↦ Pointwise Eq-refl ↦ refl Eq-sym ↦ sym Eq-trans ↦ trans Eq-dec ↦ dec Eq-isEquivalence ↦ isEquivalence Eq-isDecEquivalence ↦ isDecEquivalence ``` #### Overhaul of `Data.Sum.Relation.Binary` * The implementations of `Data.Sum.Relation.Binary.(Pointwise/LeftOrder)` have been altered to bring them in line with implementations of similar orders for other datatypes. Namely they are no longer specialised instances of some `Core` module. * The constructor `₁∼₂` for `LeftOrder` no longer takes an argument of type `⊤`. * The constructor `₁∼₁` and `₂∼₂` in `Pointwise` have been renamed `inj₁` and `inj₂` respectively. The old names still exist but have been deprecated. #### Overhaul of `MonadZero` and `MonadPlus` * Introduce `RawIApplicativeZero` for an indexed applicative with a zero and `RawAlternative` for an indexed applicative with a zero and a sum. * `RawIMonadZero` is now packing a `RawIApplicativeZero` rather than a `∅` directly * Similarly `RawIMonadPlus` is defined in terms of `RawIAlternative` rather than directly packing a _∣_. * Instances will be broken but usages should still work thanks to re-exports striving to maintain backwards compatibility. #### Overhaul of `Data.Char` and `Data.String` * Moved `setoid` and `strictTotalOrder` from `Data.(Char/String)` into the new module `Data.(Char/String).Properties`. * Used the new builtins from `Agda.Builtin.(Char/String).Properties` to implement decidable equality (`_≟_`) in a safe manner. This has allowed `_≟_`, `decSetoid` and `_==_` to be moved from `Data.(Char/String).Unsafe` to `Data.(Char/String).Properties`. #### Overhaul of `Data.Rational` * Many new operators have been added to `Data.Rational` including addition, substraction, multiplication, inverse etc. * The existing operator `_÷_` has been renamed `_/_` and is now more liberal as it now accepts non-coprime arguments (e.g. `+ 2 / 4`) which are then normalised. * The old name `_÷_` has been repurposed to represent division between two rationals. * The proofs `drop-*≤*`, `≃⇒≡` and `≡⇒≃` have been moved from `Data.Rational` to `Data.Rational.Properties`. #### Changes in `Data.List` * In `Data.List.Membership.Propositional.Properties`: - the `Set` argument has been made implicit in `∈-++⁺ˡ`, `∈-++⁺ʳ`, `∈-++⁻`, `∈-insert`, `∈-∃++`. - the `A → B` argument has been made explicit in `∈-map⁺`, `∈-map⁻`, `map-∈↔`. * The module `Data.List.Relation.Binary.Sublist.Propositional.Solver` has been removed and replaced by `Data.List.Relation.Binary.Sublist.DecPropositional.Solver`. * The functions `_∷=_` and `_─_` have been removed from `Data.List.Membership.Setoid` as they are subsumed by the more general versions now part of `Data.List.Any`. #### Changes in `Data.Nat` * Changed the implementation of `_≟_` and `_≤″?_` for natural numbers to use a (fast) boolean test. Compiled code that uses these should now run faster. * Made the contents of the modules `Data.Nat.Unsafe` and `Data.Nat.DivMod.Unsafe` safe by using the new safe equality erasure primitive instead of the unsafe one defined in `Relation.Binary.PropositionalEquality.TrustMe`. As the safe erasure primitive requires the K axiom the two files are now named `Data.Nat.WithK` and `Data.Nat.DivMod.WithK`. * Fixed a bug in `Data.Nat.Properties` where the type of `m⊓n≤m⊔n` was `∀ m n → m ⊔ n ≤ m ⊔ n`. The type has been corrected to `∀ m n → m ⊓ n ≤ m ⊔ n`. #### Changes in `Data.Vec` * The argument order for `lookup`, `insert` and `remove` in `Data.Vec` has been altered so that the `Vec` argument always come first, e.g. what was written as `lookup i v xs` is now `lookup xs i v`. The argument order for the corresponding proofs has also changed. This makes the operations more consistent with those in `Data.List`. * The proofs `toList⁺` and `toList⁻` in `Data.Vec.Relation.Unary.All.Properties` have been swapped as they were the opposite way round to similar properties in the rest of the library. #### Other changes * The proof `sel⇒idem` in `Algebra.FunctionProperties.Consequences` now only takes the equality relation as an argument instead of a full `Setoid`. * The proof `_≟_` that equality is decidable for `Bool` has been moved from `Data.Bool.Base` to `Data.Bool.Properties`. Backwards compatibility has been (nearly completely) preserved by having `Data.Bool` publicly re-export `_≟_`. * The type `Coprime` and proof `coprime-divisor` have been moved from `Data.Integer.Divisibility` to `Data.Integer.Coprimality`. * The functions `fromMusical` and `toMusical` were moved from the `Codata` modules to the corresponding `Codata.Musical` modules. Removed features ---------------- * The following modules that were deprecated in v0.14 and v0.15 have been removed. ```agda Data.Nat.Properties.Simple Data.Integer.Multiplication.Properties Data.Integer.Addition.Properties Relation.Binary.Sigma.Pointwise Relation.Binary.Sum Relation.Binary.List.NonStrictLex Relation.Binary.List.Pointwise Relation.Binary.List.StrictLex Relation.Binary.Product.NonStrictLex Relation.Binary.Product.Pointwise Relation.Binary.Product.StrictLex Relation.Binary.Vec.Pointwise ``` Deprecated features ------------------- The following renaming has occurred as part of a drive to improve consistency across the library. The old names still exist and therefore all existing code should still work, however they have been deprecated and use of the new names is encouraged. Although not anticipated any time soon, they may eventually be removed in some future release of the library. * In `Data.Bool.Properties`: ```agda T-irrelevance ↦ T-irrelevant ``` * In `Data.Fin.Properties`: ```agda ≤-irrelevance ↦ ≤-irrelevant <-irrelevance ↦ <-irrelevant ``` * In `Data.Integer.Properties`: ```agda ≰→> ↦ ≰⇒> ≤-irrelevance ↦ ≤-irrelevant <-irrelevance ↦ <-irrelevant ``` * In `Data.List.Relation.Binary.Permutation.Inductive.Properties`: ```agda ↭⇒~bag ↦ ↭⇒∼bag ~bag⇒↭ ↦ ∼bag⇒↭ ``` (now typed with "\sim" rather than "~") * In `Data.List.Relation.Binary.Pointwise`: ```agda decidable-≡ ↦ Data.List.Properties.≡-dec ``` * In `Data.List.Relation.Unary.All.Properties`: ```agda filter⁺₁ ↦ all-filter filter⁺₂ ↦ filter⁺ ``` * In `Data.Nat.Properties`: ```agda ≤-irrelevance ↦ ≤-irrelevant <-irrelevance ↦ <-irrelevant ``` * In `Data.Rational`: ```agda drop-*≤* ≃⇒≡ ≡⇒≃ ``` (moved to `Data.Rational.Properties`) * In `Data.Rational.Properties`: ```agda ≤-irrelevance ↦ ≤-irrelevant ``` * In `Data.Vec.Properties.WithK`: ```agda []=-irrelevance ↦ []=-irrelevant ``` * In `Relation.Binary.HeterogeneousEquality`: ```agda ≅-irrelevance ↦ ≅-irrelevant ≅-heterogeneous-irrelevance ↦ ≅-heterogeneous-irrelevant ≅-heterogeneous-irrelevanceˡ ↦ ≅-heterogeneous-irrelevantˡ ≅-heterogeneous-irrelevanceʳ ↦ ≅-heterogeneous-irrelevantʳ ``` * In `Induction.WellFounded`: ```agda module Inverse-image ↦ InverseImage module Transitive-closure ↦ TransitiveClosure ``` * In `Relation.Binary.PropositionalEquality.WithK`: ```agda ≡-irrelevance ↦ ≡-irrelevant ``` Other minor additions --------------------- * Added new records to `Algebra`: ```agda record RawMagma c ℓ : Set (suc (c ⊔ ℓ)) record Magma c ℓ : Set (suc (c ⊔ ℓ)) ``` * Added new types to `Algebra.FunctionProperties`: ```agda LeftConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → x ≈ e RightConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → y ≈ e Conical e ∙ = LeftConical e ∙ × RightConical e ∙ LeftCongruent _∙_ = ∀ {x} → (x ∙_) Preserves _≈_ ⟶ _≈_ RightCongruent _∙_ = ∀ {x} → (_∙ x) Preserves _≈_ ⟶ _≈_ ``` * Added new proof to `Algebra.FunctionProperties.Consequences`: ```agda wlog : Commutative f → Total _R_ → (∀ a b → a R b → P (f a b)) → ∀ a b → P (f a b) ``` * Added new proofs to `Algebra.Properties.Lattice`: ```agda ∧-isSemilattice : IsSemilattice _≈_ _∧_ ∧-semilattice : Semilattice l₁ l₂ ∨-isSemilattice : IsSemilattice _≈_ _∨_ ∨-semilattice : Semilattice l₁ l₂ ``` * Added new operator to `Algebra.Solver.Ring`. ```agda _:×_ ``` * Added new records to `Algebra.Structures`: ```agda record IsMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) ``` * Added new proofs to `Category.Monad.State`: ```agda StateTIApplicative : RawMonad M → RawIApplicative (IStateT S M) StateTIApplicativeZero : RawMonadZero M → RawIApplicativeZero (IStateT S M) StateTIAlternative : RawMonadPlus M → RawIAlternative (IStateT S M) ``` * Added new functions to `Codata.Colist`: ```agda fromCowriter : Cowriter W A i → Colist W i toCowriter : Colist A i → Cowriter A ⊤ i [_] : A → Colist A ∞ chunksOf : (n : ℕ) → Colist A ∞ → Cowriter (Vec A n) (BoundedVec A n) ∞ ``` * Added new proofs to `Codata.Delay.Categorical`: ```agda Sequential.applicativeZero : RawApplicativeZero (λ A → Delay A i) Zippy.applicativeZero : RawApplicativeZero (λ A → Delay A i) Zippy.alternative : RawAlternative (λ A → Delay A i) ``` * Added new functions to `Codata.Stream`: ```agda splitAt : (n : ℕ) → Stream A ∞ → Vec A n × Stream A ∞ drop : ℕ → Stream A ∞ → Stream A ∞ interleave : Stream A i → Thunk (Stream A) i → Stream A i chunksOf : (n : ℕ) → Stream A ∞ → Stream (Vec A n) ∞ ``` * Added new proofs to `Codata.Stream.Properties`: ```agda splitAt-map : splitAt n (map f xs) ≡ map (map f) (map f) (splitAt n xs) lookup-iterate-identity : lookup n (iterate f a) ≡ fold a f n ``` * Added new proofs to `Data.Bool.Properties`: ```agda ∧-isMagma : IsMagma _∧_ ∨-isMagma : IsMagma _∨_ ∨-isBand : IsBand _∨_ ∨-isSemilattice : IsSemilattice _∨_ ∧-isBand : IsBand _∧_ ∧-isSemilattice : IsSemilattice _∧_ ∧-magma : Magma 0ℓ 0ℓ ∨-magma : Magma 0ℓ 0ℓ ∨-band : Band 0ℓ 0ℓ ∧-band : Band 0ℓ 0ℓ ∨-semilattice : Semilattice 0ℓ 0ℓ ∧-semilattice : Semilattice 0ℓ 0ℓ T? : Decidable T T?-diag : T b → True (T? b) ``` * Added new functions to `Data.Char`: ```agda toUpper : Char → Char toLower : Char → Char ``` * Added new functions to `Data.Fin.Base`: ```agda cast : m ≡ n → Fin m → Fin n lower₁ : (i : Fin (suc n)) → (n ≢ toℕ i) → Fin n ``` * Added new proof to `Data.Fin.Properties`: ```agda toℕ-cast : toℕ (cast eq k) ≡ toℕ k toℕ-inject₁-≢ : n ≢ toℕ (inject₁ i) inject₁-lower₁ : inject₁ (lower₁ i n≢i) ≡ i lower₁-inject₁′ : lower₁ (inject₁ i) n≢i ≡ i lower₁-inject₁ : lower₁ (inject₁ i) (toℕ-inject₁-≢ i) ≡ i lower₁-irrelevant : lower₁ i n≢i₁ ≡ lower₁ i n≢i₂ ``` * Added new proofs to `Data.Fin.Subset.Properties`: ```agda ∩-isMagma : IsMagma _∩_ ∪-isMagma : IsMagma _∪_ ∩-isBand : IsBand _∩_ ∪-isBand : IsBand _∪_ ∩-isSemilattice : IsSemilattice _∩_ ∪-isSemilattice : IsSemilattice _∪_ ∩-magma : Magma _ _ ∪-magma : Magma _ _ ∩-band : Band _ _ ∪-band : Band _ _ ∩-semilattice : Semilattice _ _ ∪-semilattice : Semilattice _ _ ``` * Added new proofs to `Data.Integer.Properties`: ```agda suc-pred : sucℤ (pred m) ≡ m pred-suc : pred (sucℤ m) ≡ m neg-suc : - + suc m ≡ pred (- + m) suc-+ : + suc m + n ≡ sucℤ (+ m + n) +-pred : m + pred n ≡ pred (m + n) pred-+ : pred m + n ≡ pred (m + n) minus-suc : m - + suc n ≡ pred (m - + n) [1+m]*n≡n+m*n : sucℤ m * n ≡ n + m * n ⊓-comm : Commutative _⊓_ ⊓-assoc : Associative _⊓_ ⊓-idem : Idempotent _⊓_ ⊓-sel : Selective _⊓_ m≤n⇒m⊓n≡m : m ≤ n → m ⊓ n ≡ m m⊓n≡m⇒m≤n : m ⊓ n ≡ m → m ≤ n m≥n⇒m⊓n≡n : m ≥ n → m ⊓ n ≡ n m⊓n≡n⇒m≥n : m ⊓ n ≡ n → m ≥ n m⊓n≤n : m ⊓ n ≤ n m⊓n≤m : m ⊓ n ≤ m ⊔-comm : Commutative _⊔_ ⊔-assoc : Associative _⊔_ ⊔-idem : Idempotent _⊔_ ⊔-sel : Selective _⊔_ m≤n⇒m⊔n≡n : m ≤ n → m ⊔ n ≡ n m⊔n≡n⇒m≤n : m ⊔ n ≡ n → m ≤ n m≥n⇒m⊔n≡m : m ≥ n → m ⊔ n ≡ m m⊔n≡m⇒m≥n : m ⊔ n ≡ m → m ≥ n m≤m⊔n : m ≤ m ⊔ n n≤m⊔n : n ≤ m ⊔ n neg-distrib-⊔-⊓ : - (m ⊔ n) ≡ - m ⊓ - n neg-distrib-⊓-⊔ : - (m ⊓ n) ≡ - m ⊔ - n pred-mono : pred Preserves _≤_ ⟶ _≤_ suc-mono : sucℤ Preserves _≤_ ⟶ _≤_ ⊖-monoʳ-≥-≤ : (p ⊖_) Preserves ℕ._≥_ ⟶ _≤_ ⊖-monoˡ-≤ : (_⊖ p) Preserves ℕ._≤_ ⟶ _≤_ +-monoʳ-≤ : (_+_ n) Preserves _≤_ ⟶ _≤_ +-monoˡ-≤ : (_+ n) Preserves _≤_ ⟶ _≤_ +-monoˡ-< : (_+ n) Preserves _<_ ⟶ _<_ +-monoʳ-< : (_+_ n) Preserves _<_ ⟶ _<_ *-monoˡ-≤-pos : (+ suc n *_) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤-non-neg : (_* + n) Preserves _≤_ ⟶ _≤ *-monoˡ-≤-non-neg : (+ n *_) Preserves _≤_ ⟶ _≤_ +-mono-≤ : _+_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ +-mono-< : _+_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ +-mono-≤-< : _+_ Preserves₂ _≤_ ⟶ _<_ ⟶ _<_ +-mono-<-≤ : _+_ Preserves₂ _<_ ⟶ _≤_ ⟶ _<_ neg-mono-≤-≥ : -_ Preserves _≤_ ⟶ _≥_ neg-mono-<-> : -_ Preserves _<_ ⟶ _>_ *-cancelˡ-≡ : i ≢ + 0 → i * j ≡ i * k → j ≡ k *-cancelˡ-≤-pos : + suc m * n ≤ + suc m * o → n ≤ o neg-≤-pos : - (+ m) ≤ + n 0⊖m≤+ : 0 ⊖ m ≤ + n m≤n⇒m-n≤0 : m ≤ n → m - n ≤ + 0 m-n≤0⇒m≤n : m - n ≤ + 0 → m ≤ n m≤n⇒0≤n-m : m ≤ n → + 0 ≤ n - m 0≤n-m⇒m≤n : + 0 ≤ n - m → m ≤ n m≤pred[n]⇒m→≰ : x > y → x ≰ y >-irrefl : Irreflexive _≡_ _>_ pos-+-commute : Homomorphic₂ +_ ℕ._+_ _+_ neg-distribˡ-* : - (x * y) ≡ (- x) * y neg-distribʳ-* : - (x * y) ≡ x * (- y) *-distribˡ-+ : _*_ DistributesOverˡ _+_ ≤-steps : m ≤ n → m ≤ + p + n ≤-step-neg : m ≤ n → pred m ≤ n ≤-steps-neg : m ≤ n → m - + p ≤ n m≡n⇒m-n≡0 : m ≡ n → m - n ≡ + 0 m-n≡0⇒m≡n : m - n ≡ + 0 → m ≡ n 0≤n⇒+∣n∣≡n : + 0 ≤ n → + ∣ n ∣ ≡ n +∣n∣≡n⇒0≤n : + ∣ n ∣ ≡ n → + 0 ≤ n ◃-≡ : sign m ≡ sign n → ∣ m ∣ ≡ ∣ n ∣ → m ≡ n +-isMagma : IsMagma _+_ *-isMagma : IsMagma _*_ +-magma : Magma 0ℓ 0ℓ *-magma : Magma 0ℓ 0ℓ +-semigroup : Semigroup 0ℓ 0ℓ *-semigroup : Semigroup 0ℓ 0ℓ +-0-monoid : Monoid 0ℓ 0ℓ *-1-monoid : Monoid 0ℓ 0ℓ +-*-ring : Ring 0ℓ 0ℓ <-isStrictPartialOrder : IsStrictPartialOrder _≡_ _<_ <-strictPartialOrder : StrictPartialOrder _ _ _ ``` * Added new proofs to `Data.List.Categorical`: ```agda applicativeZero : RawApplicativeZero List alternative : RawAlternative List ``` * Added new operations to `Data.List.Relation.Unary.All`: ```agda zipWith : P ∩ Q ⊆ R → All P ∩ All Q ⊆ All R unzipWith : R ⊆ P ∩ Q → All R ⊆ All P ∩ All Q sequenceA : All (F ∘′ P) ⊆ F ∘′ All P sequenceM : All (M ∘′ P) ⊆ M ∘′ All P mapA : (Q ⊆ F ∘′ P) → All Q ⊆ (F ∘′ All P) mapM : (Q ⊆ M ∘′ P) → All Q ⊆ (M ∘′ All P) forA : All Q xs → (Q ⊆ F ∘′ P) → F (All P xs) forM : All Q xs → (Q ⊆ M ∘′ P) → M (All P xs) updateAt : x ∈ xs → (P x → P x) → All P xs → All P xs _[_]%=_ : All P xs → x ∈ xs → (P x → P x) → All P xs _[_]≔_ : All P xs → x ∈ xs → P x → All P xs ``` * Added new proofs to `Data.List.Relation.Unary.All.Properties`: ```agda respects : P Respects _≈_ → (All P) Respects _≋_ ─⁺ : All Q xs → All Q (xs Any.─ p) ─⁻ : Q (Any.lookup p) → All Q (xs Any.─ p) → All Q xs map-cong : f ≗ g → map f ps ≡ map g ps map-id : map id ps ≡ ps map-compose : map g (map f ps) ≡ map (g ∘ f) ps lookup-map : lookup (map f ps) i ≡ f (lookup ps i) ∷ʳ⁺ : All P xs → P x → All P (xs ∷ʳ x) ∷ʳ⁻ : All P (xs ∷ʳ x) → All P xs × P x ``` * Added new proofs to `Data.List.Relation.Binary.Equality.DecPropositional`: ```agda _≡?_ : Decidable (_≡_ {A = List A}) ``` * Added new functions to `Data.List.Relation.Unary.Any`: ```agda lookup : Any P xs → A _∷=_ : Any P xs → A → List A _─_ : ∀ xs → Any P xs → List A ``` * Added new functions to `Data.List.Base`: ```agda intercalate : List A → List (List A) → List A partitionSumsWith : (A → B ⊎ C) → List A → List B × List C partitionSums : List (A ⊎ B) → List A × List B _[_]%=_ : (xs : List A) → Fin (length xs) → (A → A) → List A _[_]∷=_ : (xs : List A) → Fin (length xs) → A → List A _─_ : (xs : List A) → Fin (length xs) → List A reverseAcc : List A → List A → List A ``` * Added new proofs to `Data.List.Membership.Propositional.Properties`: ```agda ∈-allFin : (k : Fin n) → k ∈ allFin n []∈inits : [] ∈ inits as ``` * Added new function to `Data.List.Membership.(Setoid/Propositional)`: ```agda _∷=_ : x ∈ xs → A → List A _─_ : (xs : List A) → x ∈ xs → List A ``` Added laws for `updateAt`. The laws that previously existed for `_[_]≔_` are now special instances of these. * Added new proofs to `Data.List.Membership.Setoid.Properties`: ```agda length-mapWith∈ : length (mapWith∈ xs f) ≡ length xs ∈-∷=⁺-updated : v ∈ (x∈xs ∷= v) ∈-∷=⁺-untouched : x ≉ y → y ∈ xs → y ∈ (x∈xs ∷= v) ∈-∷=⁻ : y ≉ v → y ∈ (x∈xs ∷= v) → y ∈ xs map-∷= : map f (x∈xs ∷= v) ≡ ∈-map⁺ f≈ pr ∷= f v ``` * Added new proofs to `Data.List.Properties`: ```agda ≡-dec : Decidable _≡_ → Decidable {A = List A} _≡_ ++-cancelˡ : xs ++ ys ≡ xs ++ zs → ys ≡ zs ++-cancelʳ : ys ++ xs ≡ zs ++ xs → ys ≡ zs ++-cancel : Cancellative _++_ ++-conicalˡ : xs ++ ys ≡ [] → xs ≡ [] ++-conicalʳ : xs ++ ys ≡ [] → ys ≡ [] ++-conical : Conical [] _++_ ++-isMagma : IsMagma _++_ length-%= : length (xs [ k ]%= f) ≡ length xs length-∷= : length (xs [ k ]∷= v) ≡ length xs length-─ : length (xs ─ k) ≡ pred (length xs) map-∷= : map f (xs [ k ]∷= v) ≡ map f xs [ cast eq k ]∷= f v map-─ : map f (xs ─ k) ≡ map f xs ─ cast eq k length-applyUpTo : length (applyUpTo f n) ≡ n length-applyDownFrom : length (applyDownFrom f n) ≡ n length-upTo : length (upTo n) ≡ n length-downFrom : length (downFrom n) ≡ n length-tabulate : length (tabulate f ) ≡ n lookup-applyUpTo : lookup (applyUpTo f n) i ≡ f (toℕ i) lookup-applyDownFrom : lookup (applyDownFrom f n) i ≡ f (n ∸ (suc (toℕ i))) lookup-upTo : lookup (upTo n) i ≡ toℕ i lookup-downFrom : lookup (downFrom n) i ≡ n ∸ (suc (toℕ i)) lookup-tabulate : lookup (tabulate f) i′ ≡ f i map-tabulate : map f (tabulate g) ≡ tabulate (f ∘ g) ``` * Added new proofs to `Data.List.Relation.Binary.Permutation.Inductive.Properties`: ```agda ++-isMagma : IsMagma _↭_ _++_ ++-magma : Magma _ _ ``` * Added new proofs to `Data.List.Relation.Binary.Pointwise`: ```agda reverseAcc⁺ : Pointwise R a x → Pointwise R b y → Pointwise R (reverseAcc a b) (reverseAcc x y) reverse⁺ : Pointwise R as bs → Pointwise R (reverse as) (reverse bs) map⁺ : Pointwise (λ a b → R (f a) (g b)) as bs → Pointwise R (map f as) (map g bs) map⁻ : Pointwise R (map f as) (map g bs) → Pointwise (λ a b → R (f a) (g b)) as bs filter⁺ : Pointwise R as bs → Pointwise R (filter P? as) (filter Q? bs) replicate⁺ : R a b → Pointwise R (replicate n a) (replicate n b) irrelevant : Irrelevant R → Irrelevant (Pointwise R) ``` * Added new function to `Data.Maybe.Base`: ```agda _<∣>_ : Maybe A → Maybe A → Maybe A ``` * Added new proofs to `Data.Maybe.Categorical`: ```agda applicativeZero : RawApplicativeZero Maybe alternative : RawAlternative Maybe ``` * Added new proof to `Data.Maybe.Properties`: ```agda ≡-dec : Decidable _≡_ → Decidable {A = Maybe A} _≡_ ``` * Added new proof to `Data.Maybe.Relation.Binary.Pointwise`: ```agda reflexive : _≡_ ⇒ R → _≡_ ⇒ Pointwise R ``` * Added new proofs to `Data.Maybe.Relation.Unary.All`: ```agda drop-just : All P (just x) → P x just-equivalence : P x ⇔ All P (just x) map : P ⊆ Q → All P ⊆ All Q fromAny : Any P ⊆ All P zipWith : P ∩ Q ⊆ R → All P ∩ All Q ⊆ All R unzipWith : P ⊆ Q ∩ R → All P ⊆ All Q ∩ All R zip : All P ∩ All Q ⊆ All (P ∩ Q) unzip : All (P ∩ Q) ⊆ All P ∩ All Q sequenceA : RawApplicative F → All (F ∘′ P) ⊆ F ∘′ All P mapA : RawApplicative F → (Q ⊆ F ∘′ P) → All Q ⊆ (F ∘′ All P) forA : RawApplicative F → All Q xs → (Q ⊆ F ∘′ P) → F (All P xs) sequenceM : RawMonad M → All (M ∘′ P) ⊆ M ∘′ All P mapM : RawMonad M → (Q ⊆ M ∘′ P) → All Q ⊆ (M ∘′ All P) forM : RawMonad M → All Q xs → (Q ⊆ M ∘′ P) → M (All P xs) universal : Universal P → Universal (All P) irrelevant : Irrelevant P → Irrelevant (All P) satisfiable : Satisfiable (All P) ``` * Added new proofs to `Data.Maybe.Relation.Unary.Any`: ```agda drop-just : Any P (just x) → P x just-equivalence : P x ⇔ Any P (just x) map : P ⊆ Q → Any P ⊆ Any Q satisfied : Any P x → ∃ P zipWith : P ∩ Q ⊆ R → Any P ∩ Any Q ⊆ Any R unzipWith : P ⊆ Q ∩ R → Any P ⊆ Any Q ∩ Any R zip : Any P ∩ Any Q ⊆ Any (P ∩ Q) unzip : Any (P ∩ Q) ⊆ Any P ∩ Any Q irrelevant : Irrelevant P → Irrelevant (Any P) satisfiable : Satisfiable P → Satisfiable (Any P) ``` * Added a third alternative definition of "less than" to `Data.Nat.Base`: ```agda _≤‴_ : Rel ℕ 0ℓ _<‴_ : Rel ℕ 0ℓ _≥‴_ : Rel ℕ 0ℓ _>‴_ : Rel ℕ 0ℓ ``` * Added new proofs to `Data.Nat.Properties`: ```agda +-isMagma : IsMagma _+_ *-isMagma : IsMagma _*_ ⊔-isMagma : IsMagma _⊔_ ⊓-isMagma : IsMagma _⊓_ ⊔-isBand : IsBand _⊔_ ⊓-isBand : IsBand _⊓_ ⊔-isSemilattice : IsSemilattice _⊔_ ⊓-isSemilattice : IsSemilattice _⊓_ +-magma : Magma 0ℓ 0ℓ *-magma : Magma 0ℓ 0ℓ ⊔-magma : Magma 0ℓ 0ℓ ⊓-magma : Magma 0ℓ 0ℓ ⊔-band : Band 0ℓ 0ℓ ⊓-band : Band 0ℓ 0ℓ ⊔-semilattice : Semilattice 0ℓ 0ℓ ⊓-semilattice : Semilattice 0ℓ 0ℓ +-cancelˡ-< : LeftCancellative _<_ _+_ +-cancelʳ-< : RightCancellative _<_ _+_ +-cancel-< : Cancellative _<_ _+_ m≤n⇒m⊓o≤n : m ≤ n → m ⊓ o ≤ n m≤n⇒o⊓m≤n : m ≤ n → o ⊓ m ≤ n m″-irrelevant : Irrelevant _>″_ m≤‴m+k : m + k ≡ n → m ≤‴ n ``` * Added new proof to `Data.Product.Properties.WithK`: ```agda ,-injective : (a , b) ≡ (c , d) → a ≡ c × b ≡ d ≡-dec : Decidable _≡_ → (∀ {a} → Decidable {A = B a} _≡_) → Decidable {A = Σ A B} _≡_ ``` * Added new functions to `Data.Product.Relation.Binary.Pointwise.NonDependent`: ```agda <_,_>ₛ : A ⟶ B → A ⟶ C → A ⟶ (B ×ₛ C) proj₁ₛ : (A ×ₛ B) ⟶ A proj₂ₛ : (A ×ₛ B) ⟶ B swapₛ : (A ×ₛ B) ⟶ (B ×ₛ A) ``` * Added new functions to `Data.Rational`: ```agda -_ : ℚ → ℚ 1/_ : (p : ℚ) → .{n≢0 : ∣ ℚ.numerator p ∣ ≢0} → ℚ _*_ : ℚ → ℚ → ℚ _+_ : ℚ → ℚ → ℚ _-_ : ℚ → ℚ → ℚ _/_ : (p₁ p₂ : ℚ) → {n≢0 : ∣ ℚ.numerator p₂ ∣ ≢0} → ℚ show : ℚ → String ``` * Added new proofs to `Data.Sign.Properties`: ```agda *-isMagma : IsMagma _*_ *-magma : Magma 0ℓ 0ℓ ``` * Added new functions to `Data.Sum.Base`: ```agda fromDec : Dec P → P ⊎ ¬ P toDec : P ⊎ ¬ P → Dec P ``` * Added new proof to `Data.Sum.Properties`: ```agda ≡-dec : Decidable _≡_ → Decidable _≡_ → Decidable {A = A ⊎ B} _≡_ ``` * Added new functions to `Data.Sum.Relation.Binary.Pointwise`: ```agda inj₁ₛ : A ⟶ (A ⊎ₛ B) inj₂ₛ : B ⟶ (A ⊎ₛ B) [_,_]ₛ : (A ⟶ C) → (B ⟶ C) → (A ⊎ₛ B) ⟶ C swapₛ : (A ⊎ₛ B) ⟶ (B ⊎ₛ A) ``` * Added new function to `Data.These`: ```agda fromSum : A ⊎ B → These A B ``` * Added to `Data.Vec` a generalization of single point overwrite `_[_]≔_` to single-point modification `_[_]%=_` (with an alias `updateAt` with different argument order): ```agda _[_]%=_ : Vec A n → Fin n → (A → A) → Vec A n updateAt : Fin n → (A → A) → Vec A n → Vec A n ``` * Added proofs for `updateAt` to `Data.Vec.Properties`. Previously existing proofs for `_[_]≔_` are now special instances of these. * Added new proofs to `Data.Vec.Relation.Unary.Any.Properties`: ```agda lookup-index : (p : Any P xs) → P (lookup (index p) xs) lift-resp : P Respects _≈_ → (Any P) Respects (Pointwise _≈_) here-injective : here p ≡ here q → p ≡ q there-injective : there p ≡ there q → p ≡ q ¬Any[] : ¬ Any P [] ⊥↔Any⊥ : ⊥ ↔ Any (const ⊥) xs ⊥↔Any[] : ⊥ ↔ Any P [] map-id : ∀ f → (∀ p → f p ≡ p) → ∀ p → Any.map f p ≡ p map-∘ : Any.map (f ∘ g) p ≡ Any.map f (Any.map g p) swap : Any (λ x → Any (x ∼_) ys) xs → Any (λ y → Any (_∼ y) xs) ys swap-there : swap (Any.map there p) ≡ there (swap p) swap-invol : swap (swap p) ≡ p swap↔ : Any (λ x → Any (x ∼_) ys) xs ↔ Any (λ y → Any (_∼ y) xs) ys 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 P xs ⊎ Any Q xs) ↔ Any (λ x → P x ⊎ Q x) 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 singleton⁺ : P x → Any P [ x ] singleton⁻ : Any P [ x ] → P x singleton⁺∘singleton⁻ : singleton⁺ (singleton⁻ p) ≡ p singleton⁻∘singleton⁺ : singleton⁻ (singleton⁺ p) ≡ p singleton↔ : P x ↔ Any P [ x ] map⁺ : Any (P ∘ f) xs → Any P (map f xs) map⁻ : Any P (map f xs) → Any (P ∘ f) xs map⁺∘map⁻ : map⁺ (map⁻ p) ≡ p map⁻∘map⁺ : map⁻ (map⁺ p) ≡ p map↔ : Any (P ∘ f) xs ↔ Any P (map 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 ++⁺∘++⁻ : ∀ p → [ ++⁺ˡ , ++⁺ʳ xs ]′ (++⁻ xs p) ≡ p ++⁻∘++⁺ : ∀ p → ++⁻ xs ([ ++⁺ˡ , ++⁺ʳ xs ]′ p) ≡ p ++-comm : ∀ xs ys → Any P (xs ++ ys) → Any P (ys ++ xs) ++-comm∘++-comm : ∀ p → ++-comm ys xs (++-comm xs ys p) ≡ p ++-insert : ∀ xs → P x → Any P (xs ++ [ x ] ++ ys) ++↔ : (Any P xs ⊎ Any P ys) ↔ Any P (xs ++ ys) ++↔++ : ∀ xs ys → Any P (xs ++ ys) ↔ Any P (ys ++ xs) concat⁺ : Any (Any P) xss → Any P (concat xss) concat⁻ : Any P (concat xss) → Any (Any P) xss concat⁻∘++⁺ˡ : ∀ xss p → concat⁻ (xs ∷ xss) (++⁺ˡ p) ≡ here p concat⁻∘++⁺ʳ : ∀ xs xss p → concat⁻ (xs ∷ xss) (++⁺ʳ xs p) ≡ there (concat⁻ xss p) concat⁺∘concat⁻ : ∀ xss p → concat⁺ (concat⁻ xss p) ≡ p concat⁻∘concat⁺ : ∀ p → concat⁻ xss (concat⁺ p) ≡ p concat↔ : Any (Any P) xss ↔ Any P (concat xss) tabulate⁺ : ∀ i → P (f i) → Any P (tabulate f) tabulate⁻ : Any P (tabulate f) → ∃ λ i → P (f i) mapWith∈⁺ : ∀ f → (∃₂ λ x p → P (f p)) → Any P (mapWith∈ xs f) mapWith∈⁻ : ∀ xs f → Any P (mapWith∈ xs f) → ∃₂ λ x p → P (f p) mapWith∈↔ : (∃₂ λ x p → P (f p)) ↔ Any P (mapWith∈ xs f) toList⁺ : Any P xs → List.Any P (toList xs) toList⁻ : List.Any P (toList xs) → Any P xs fromList⁺ : List.Any P xs → Any P (fromList xs) fromList⁻ : Any P (fromList xs) → List.Any P xs ∷↔ : ∀ P → (P x ⊎ Any P xs) ↔ Any P (x ∷ xs) >>=↔ : Any (Any P ∘ f) xs ↔ Any P (xs >>= f) ``` * Added new functions to `Data.Vec.Membership.Propositional.Properties`: ```agda fromAny : Any P xs → ∃ λ x → x ∈ xs × P x toAny : x ∈ xs → P x → Any P xs ``` * Added new proof to `Data.Vec.Properties`: ```agda ≡-dec : Decidable _≡_ → ∀ {n} → Decidable {A = Vec A n} _≡_ ``` * Added new proofs to `Function.Related.TypeIsomorphisms`: ```agda ×-isMagma : ∀ k ℓ → IsMagma (Related ⌊ k ⌋) _×_ ⊎-isMagma : ∀ k ℓ → IsMagma (Related ⌊ k ⌋) _⊎_ ×-magma : Symmetric-kind → (ℓ : Level) → Magma _ _ ⊎-magma : Symmetric-kind → (ℓ : Level) → Semigroup _ _ ``` * Added new proofs to `Relation.Binary.Consequences`: ```agda wlog : Total _R_ → Symmetric Q → (∀ a b → a R b → Q a b) → ∀ a b → Q a b ``` * Added new definitions to `Relation.Binary.Core`: ```agda Antisym R S E = ∀ {i j} → R i j → S j i → E i j Max : REL A B ℓ → B → Set _ Min : REL A B ℓ → A → Set _ Conn P Q = ∀ x y → P x y ⊎ Q y x P ⟶ Q Respects _∼_ = ∀ {x y} → x ∼ y → P x → Q y ``` Additionally the definition of the types `_Respectsʳ_`/`_Respectsˡ_` has been generalised as follows in order to support heterogenous relations: ```agda _Respectsʳ_ : REL A B ℓ₁ → Rel B ℓ₂ → Set _ _Respectsˡ_ : REL A B ℓ₁ → Rel A ℓ₂ → Set _ ``` * Added new proofs to `Relation.Binary.Lattice`: ```agda Lattice.setoid : Setoid c ℓ BoundedLattice.setoid : Setoid c ℓ ``` * Added new operations and proofs to `Relation.Binary.Properties.HeytingAlgebra`: ```agda y≤x⇨y : y ≤ x ⇨ y ⇨-unit : x ⇨ x ≈ ⊤ ⇨-drop : (x ⇨ y) ∧ y ≈ y ⇨-app : (x ⇨ y) ∧ x ≈ y ∧ x ⇨-relax : _⇨_ Preserves₂ (flip _≤_) ⟶ _≤_ ⟶ _≤_ ⇨-cong : _⇨_ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_ ⇨-applyˡ : w ≤ x → (x ⇨ y) ∧ w ≤ y ⇨-applyʳ : w ≤ x → w ∧ (x ⇨ y) ≤ y ⇨-curry : x ∧ y ⇨ z ≈ x ⇨ y ⇨ z ⇨ʳ-covariant : (x ⇨_) Preserves _≤_ ⟶ _≤_ ⇨ˡ-contravariant : (_⇨ x) Preserves (flip _≤_) ⟶ _≤_ ¬_ : Op₁ Carrier x≤¬¬x : x ≤ ¬ ¬ x de-morgan₁ : ¬ (x ∨ y) ≈ ¬ x ∧ ¬ y de-morgan₂-≤ : ¬ (x ∧ y) ≤ ¬ ¬ (¬ x ∨ ¬ y) de-morgan₂-≥ : ¬ ¬ (¬ x ∨ ¬ y) ≤ ¬ (x ∧ y) de-morgan₂ : ¬ (x ∧ y) ≈ ¬ ¬ (¬ x ∨ ¬ y) weak-lem : ¬ ¬ (¬ x ∨ x) ≈ ⊤ ``` * Added new proofs to `Relation.Binary.Properties.JoinSemilattice`: ```agda x≤y⇒x∨y≈y : x ≤ y → x ∨ y ≈ y ``` * Added new proofs to `Relation.Binary.Properties.Lattice`: ```agda ∧≤∨ : x ∧ y ≤ x ∨ y quadrilateral₁ : x ∨ y ≈ x → x ∧ y ≈ y quadrilateral₂ : x ∧ y ≈ y → x ∨ y ≈ x collapse₁ : x ≈ y → x ∧ y ≈ x ∨ y collapse₂ : x ∨ y ≤ x ∧ y → x ≈ y ``` * Added new proofs to `Relation.Binary.Properties.MeetSemilattice`: ```agda y≤x⇒x∧y≈y : y ≤ x → x ∧ y ≈ y ``` * Added new definitions to `Relation.Binary.PropositionalEquality`: ```agda trans-injectiveˡ : trans p₁ q ≡ trans p₂ q → p₁ ≡ p₂ trans-injectiveʳ : trans p q₁ ≡ trans p q₂ → q₁ ≡ q₂ subst-injective : subst P x≡y p ≡ subst P x≡y q → p ≡ q cong-id : cong id p ≡ p cong-∘ : cong (f ∘ g) p ≡ cong f (cong g p) cong-≡id : (f≡id : ∀ x → f x ≡ x) → cong f (f≡id x) ≡ f≡id (f x) naturality : trans (cong f x≡y) (f≡g y) ≡ trans (f≡g x) (cong g x≡y) subst-application : (eq : x₁ ≡ x₂) → subst B₂ eq (g x₁ y) ≡ g x₂ (subst B₁ (cong f eq) y) subst-subst : subst P y≡z (subst P x≡y p) ≡ subst P (trans x≡y y≡z) p subst-subst-sym : subst P x≡y (subst P (sym x≡y) p) ≡ p subst-sym-subst : subst P (sym x≡y) (subst P x≡y p) ≡ p subst-∘ : subst (P ∘ f) x≡y p ≡ subst P (cong f x≡y) p trans-assoc : trans (trans p q) r ≡ trans p (trans q r) trans-reflʳ : trans p refl ≡ p trans-symʳ : trans p (sym p) ≡ refl trans-symˡ : trans (sym p) p ≡ refl ``` agda-stdlib-1.1/GNUmakefile000066400000000000000000000012211350553555600156100ustar00rootroot00000000000000AGDA_EXEC=agda RTS_OPTIONS=+RTS -M2.5G -H2.5G -A128M -RTS AGDA=$(AGDA_EXEC) $(RTS_OPTIONS) # 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 check-whitespace $(AGDA) -i. -isrc README.agda check-whitespace: cabal exec -- fix-agda-whitespace --check 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-1.1/GenerateEverything.hs000066400000000000000000000240321350553555600176760ustar00rootroot00000000000000{-# LANGUAGE PatternGuards #-} import Control.Applicative import qualified Data.List as List import System.Environment import System.Exit import System.FilePath import System.FilePath.Find import System.IO headerFile = "Header" allOutputFile = "Everything" safeOutputFile = "EverythingSafe" srcDir = "src" --------------------------------------------------------------------------- -- Files with a special status -- | Checks whether a module is declared (un)safe unsafeModules :: [FilePath] unsafeModules = map toAgdaFilePath [ "Codata.Musical.Cofin" , "Codata.Musical.Colist" , "Codata.Musical.Colist.Infinite-merge" , "Codata.Musical.Conat" , "Codata.Musical.Costring" , "Codata.Musical.Covec" , "Codata.Musical.M" , "Codata.Musical.Stream" , "Data.Char.Unsafe" , "Data.Float.Unsafe" , "Data.Nat.Unsafe" , "Data.Nat.DivMod.Unsafe" , "Data.String.Unsafe" , "Data.Word.Unsafe" , "Debug.Trace" , "Foreign.Haskell" , "Foreign.Haskell.Maybe" , "Foreign.Haskell.Pair" , "IO" , "IO.Primitive" , "Reflection" , "Relation.Binary.PropositionalEquality.TrustMe" ] where toAgdaFilePath :: String -> FilePath toAgdaFilePath name = concat [ "src/" , map (\ c -> if c == '.' then '/' else c) name , ".agda" ] isUnsafeModule :: FilePath -> Bool isUnsafeModule = -- GA 2019-02-24: it is crucial to use an anonymous lambda -- here so that `unsafeModules` is shared between all calls -- to `isUnsafeModule`. \ fp -> unqualifiedModuleName fp == "Unsafe" || fp `elem` unsafeModules -- | Checks whether a module is declared as using K isWithKModule :: FilePath -> Bool isWithKModule = -- GA 2019-02-24: it is crucial to use an anonymous lambda -- here so that `withKModules` is shared between all calls -- to `isWithKModule`. \ fp -> unqualifiedModuleName fp == "WithK" || fp `elem` withKModules where withKModules :: [FilePath] withKModules = map modToFile [ "Axiom.Extensionality.Heterogeneous" , "Data.Char.Unsafe" , "Data.Float.Unsafe" , "Data.Nat.Unsafe" , "Data.Nat.DivMod.Unsafe" , "Data.Star.BoundedVec" , "Data.Star.Decoration" , "Data.Star.Environment" , "Data.Star.Fin" , "Data.Star.Pointer" , "Data.Star.Vec" , "Data.String.Unsafe" , "Data.Word.Unsafe" , "Reflection" , "Relation.Binary.HeterogeneousEquality" , "Relation.Binary.HeterogeneousEquality.Core" , "Relation.Binary.HeterogeneousEquality.Quotients.Examples" , "Relation.Binary.HeterogeneousEquality.Quotients" , "Relation.Binary.PropositionalEquality.TrustMe" ] unqualifiedModuleName :: FilePath -> String unqualifiedModuleName = dropExtension . takeFileName -- | Returns 'True' for all Agda files except for core modules. isLibraryModule :: FilePath -> Bool isLibraryModule f = takeExtension f `elem` [".agda", ".lagda"] && unqualifiedModuleName f /= "Core" --------------------------------------------------------------------------- -- Analysing library files -- | Extracting the header. -- It needs to have the form: -- ------------------------------------------------------------------------ -- -- The Agda standard library -- -- -- -- Description of the module -- ------------------------------------------------------------------------ extractHeader :: FilePath -> [String] -> [String] extractHeader mod = extract where delimiter = all (== '-') extract (d1 : "-- The Agda standard library" : "--" : ss) | delimiter d1 , (info, d2 : rest) <- span ("-- " `List.isPrefixOf`) ss , delimiter d2 = info extract (d1 : _) | not (delimiter d1) , last d1 == '\r' = error $ mod ++ " contains \\r, probably due to git misconfiguration; maybe set autocrf to input?" extract _ = error $ unwords [ mod ++ " is malformed." , "It needs to have a module header." , "Please see other existing files or consult HACKING.md." ] -- | A crude classifier looking for lines containing options & trying to guess -- whether the safe file is using either @--guardedness@ or @--sized-types@ data Safety = Unsafe | Safe | SafeGuardedness | SafeSizedTypes deriving (Eq) classify :: FilePath -> [String] -> Safety classify fp ls -- We start with sanity checks | isUnsafe && safe = error $ fp ++ contradiction "unsafe" "safe" | not (isUnsafe || safe) = error $ fp ++ uncategorized "unsafe" "safe" | isWithK && withoutK = error $ fp ++ contradiction "as relying on K" "without-K" | isWithK && not withK = error $ fp ++ missingWithK | not (isWithK || withoutK) = error $ fp ++ uncategorized "as relying on K" "without-K" -- And then perform the actual classification | isUnsafe = Unsafe | guardedness = SafeGuardedness | sizedtypes = SafeSizedTypes | safe = Safe -- We know that @not (isUnsafe || safe)@, all cases are covered | otherwise = error "IMPOSSIBLE" where -- based on declarations isWithK = isWithKModule fp isUnsafe = isUnsafeModule fp -- based on detected OPTIONS guardedness = option "--guardedness" sizedtypes = option "--sized-types" safe = option "--safe" withK = option "--with-K" withoutK = option "--without-K" -- GA 2019-02-24: note that we do not reprocess the whole module for every -- option check: the shared @options@ definition ensures we only inspect a -- handful of lines (at most one, ideally) option str = let detect = List.isSubsequenceOf ["{-#", "OPTIONS", str, "#-}"] in not $ null $ filter detect options options = words <$> filter (List.isInfixOf "OPTIONS") ls -- formatting error messages contradiction d o = unwords [ " is declared", d, "but uses the", "--" ++ o, "option." ] uncategorized d o = unwords [ " is not declared", d, "but not using the", "--" ++ o, "option either." ] missingWithK = " is declared as relying on K but not using the --with-K option." -- | Analyse a file: extracting header and classifying it. data LibraryFile = LibraryFile { filepath :: FilePath -- ^ FilePath of the source file , header :: [String] -- ^ All lines in the headers are already prefixed with \"-- \". , safety :: Safety -- ^ Safety options used by the module } analyse :: FilePath -> IO LibraryFile analyse fp = do ls <- lines <$> readFileUTF8 fp return $ LibraryFile { filepath = fp , header = extractHeader fp ls , safety = classify fp ls } --------------------------------------------------------------------------- -- Collecting all non-Core library files, analysing them and generating -- 4 files: -- Everything.agda all the modules -- EverythingSafe.agda all the safe modules (may be incompatible) -- EverythingSafeGuardedness.agda all the safe modules using --guardedness -- EverythingSafeSizedTypes.agda all the safe modules using --sized-types 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 libraryfiles <- mapM analyse modules let mkModule str = "module " ++ str ++ " where" writeFileUTF8 (allOutputFile ++ ".agda") $ unlines [ header , mkModule allOutputFile , format libraryfiles ] writeFileUTF8 (safeOutputFile ++ ".agda") $ unlines [ header , "{-# OPTIONS --guardedness --sized-types #-}\n" , mkModule safeOutputFile , format $ filter ((Unsafe /=) . safety) libraryfiles ] let safeGuardednessOutputFile = safeOutputFile ++ "Guardedness" writeFileUTF8 (safeGuardednessOutputFile ++ ".agda") $ unlines [ header , "{-# OPTIONS --safe --guardedness #-}\n" , mkModule safeGuardednessOutputFile , format $ filter ((SafeGuardedness ==) . safety) libraryfiles ] let safeSizedTypesOutputFile = safeOutputFile ++ "SizedTypes" writeFileUTF8 (safeSizedTypesOutputFile ++ ".agda") $ unlines [ header , "{-# OPTIONS --safe --sized-types #-}\n" , mkModule safeSizedTypesOutputFile , format $ filter ((SafeSizedTypes ==) . safety) libraryfiles ] -- | 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 " ++ allOutputFile , "with the file " ++ headerFile ++ " inserted verbatim at the beginning." ] -- | Formats the extracted module information. format :: [LibraryFile] -> String format = unlines . concat . map fmt where fmt lf = "" : header lf ++ ["import " ++ fileToMod (filepath lf)] -- | Translates back and forth between a file name and the corresponding module -- name. We assume 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 modToFile :: String -> FilePath modToFile name = concat [ srcDir, [pathSeparator], map dotToSlash name, ".agda" ] where dotToSlash c | c == '.' = pathSeparator | 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 s <- hGetContents h length s `seq` return s -- | 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-1.1/HACKING.md000066400000000000000000000107331350553555600151340ustar00rootroot00000000000000Contributing to the library =========================== Thank you for your interest in contributing to the Agda standard library. Hopefully this guide should make it easy to do so! Feel free to ask any questions on the Agda mailing list. Before you start please read the [style-guide](https://github.com/agda/agda-stdlib/blob/master/notes/style-guide.md). How to make changes ------------------- ### Fork and download the repository 1. Create a fork by clicking `Fork` button at the top right of the [repository](https://github.com/agda/agda-stdlib). 2. If you are on a Mac, make sure that your git options has `autocrlf` set to `input`. This can be done by executing ``` git config --global core.autocrlf input ``` If you are on Windows, make sure that your editor can deal with Unix format files. 3. On the command line, and in a suitable folder, download your fork by running the command ``` git clone https://github.com/USER_NAME/agda-stdlib agda-stdlib-fork ``` where `USER_NAME` is your Git username. The folder `agda-stdlib-fork` should now contain a copy of the standard library. 4. Enter the folder `agda-stdlib-fork` and choose the correct branch of the library to make your changes on by running the command ``` git checkout X ``` where `X` should be `master` if your changes are compatible with the current released version of Agda, and `experimental` if your changes require the development version of Agda. ### Make your changes 5. Make your proposed changes. Please try to obey existing conventions in the library. See `agda-stdlib-fork/notes/style-guide.md` for a selection of the most important ones. 6. Document your changes in `agda-stdlib-fork/CHANGELOG.md`. 7. Ensure your changes are compatible with the rest of the library by running the commands ``` make clean make test ``` inside the `agda-stdlib-fork` folder. Continue to correct any bugs thrown up until the tests are passed. Your proposed changes MUST pass these tests. Note that the tests require the use of a tool called `fix-agda-whitespace`. See the instructions at the end of this file for how to install this. If you are creating new modules, please make sure you are having a proper header, and a brief description of what the module is for, e.g. ``` ------------------------------------------------------------------------ -- The Agda standard library -- -- {PLACE YOUR BRIEF DESCRIPTION HERE} ------------------------------------------------------------------------ ``` If possible, each module should use the options `--safe` and `--without-K`. You can achieve this by placing the following pragma under the header and before any other line of code (including the module name): ``` {-# OPTIONS --without-K --safe #-} ``` If a module cannot be made safe or needs the `--with-K` option then it should be split into a module which is compatible with these options and an auxiliary one which will: * Either be called `SOME/PATH/Unsafe.agda` or `SOME/PATH/WithK.agda` * Or explicitly declared as either unsafe or needing K in `GenerateEverything.hs` ### Upload your changes 8. Use the `git add X` command to add changes to file `X` to the commit, or `git add .` to add all the changed files. 9. Run the command: ``` git commit ``` and enter a meaningful description for your changes. 10. Upload your changes to your fork by running the command: ``` git push ``` 11. Go to your fork on Github at `https://github.com/USER_NAME/agda-stdlib` and follow the [official Git instructions](https://help.github.com/en/articles/creating-a-pull-request-from-a-fork) to open a pull request to the main standard library repository. 12. The library maintainers will then be made aware of your requested changes and should be in touch soon. How to enforce whitespace policies ---------------------------------- ### Installing fix-agda-whitespace This tool is kept in the main agda repository. It can be installed by following these instructions: ``` git clone https://github.com/agda/agda cd agda/src/fix-agda-whitespace cabal install ``` ### Adding fix-agda-whitespace as a pre-commit hook You can add the following code to the file `.git/hooks/pre-commit` to get git to run fix-agda-whitespace before each `git commit` and ensure you are never committing anything with a whitespace violation: ``` #!/bin/sh fix-agda-whitespace --check ``` agda-stdlib-1.1/Header000066400000000000000000000004261350553555600146570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- All library modules, along with short descriptions ------------------------------------------------------------------------ -- Note that core modules are not included. agda-stdlib-1.1/LICENCE000066400000000000000000000031671350553555600145360ustar00rootroot00000000000000Copyright (c) 2007-2019 Nils Anders Danielsson, Ulf Norell, Shin-Cheng Mu, Bradley Hardy, 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, Wen Kokke, Matthew Daggitt, Jason Hu, Sandro Stucki, Milo Turner, Zack Grannan, Lex van der Stoep 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-1.1/README.agda000066400000000000000000000243121350553555600153170ustar00rootroot00000000000000module README where ------------------------------------------------------------------------ -- The Agda standard library, version 1.1 -- -- Authors: Nils Anders Danielsson, Matthew Daggitt, Guillaume Allais -- with contributions from Andreas Abel, Stevan Andjelkovic, -- Jean-Philippe Bernardy, Peter Berry, Bradley Hardy Joachim Breitner, -- Samuel Bronson, Daniel Brown, James Chapman, Liang-Ting Chen, -- Dominique Devriese, Dan Doel, Érdi Gergő, Zack Grannan, -- Helmut Grohne, Simon Foster, Liyang Hu, Jason Hu, Patrik Jansson, -- Alan Jeffrey, Wen 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, Lex van der Stoep, Sandro Stucki, Milo Turner, -- Noam Zeilberger and other anonymous contributors. ------------------------------------------------------------------------ -- This version of the library has been tested using Agda 2.6.0.1. -- 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. ------------------------------------------------------------------------ -- 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. -- • Axiom -- Types and consequences of various additional axioms not -- necessarily included in Agda, e.g. uniqueness of identity -- proofs, function extensionality and excluded middle. import README.Axiom -- • Category -- Category theory-inspired idioms used to structure functional -- programs (functors and monads, for instance). -- • Codata -- Coinductive data types and properties. There are two different -- approaches taken. The `Codata` folder contains the new more -- standard approach using sized types. The `Codata.Musical` -- folder contains modules using the old musical notation. -- • Data -- Data types and properties. import README.Data -- • 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. -- • Reflection -- Support for reflection. -- • Relation -- Properties of and proofs about relations. -- • Size -- Sizes used by the sized types mechanism. -- • Strict -- Provides access to the builtins relating to strictness. ------------------------------------------------------------------------ -- 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.String -- Strings. import Data.Sum -- Disjoint sums. import Data.Unit -- The unit type. import Data.Vec -- Fixed-length vectors. -- • Some co-inductive data types import Codata.Stream -- Streams. import Codata.Colist -- Colists. -- • 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.Reasoning.Preorder -- Solver for commutative ring or semiring equalities: import Algebra.Solver.Ring -- • 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 Data.Nat.Induction -- • Support for coinduction import Codata.Musical.Notation import Codata.Thunk -- • 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 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 how the case expression can be used. import README.Case -- Some examples showing how combinators can be used to emulate -- "functional reasoning" import README.Function.Reasoning -- An example showing how to use the debug tracing mechanism to inspect -- the behaviour of compiled Agda programs. import README.Debug.Trace -- An exploration of the generic programs acting on n-ary functions and -- n-ary heterogeneous products import README.Nary -- Explaining the inspect idiom: use case, equivalent handwritten -- auxiliary definitions, and implementation details. import README.Inspect -- Explaining string formats and the behaviour of printf import README.Text ------------------------------------------------------------------------ -- 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; -- to exclude unsafe modules, see EverythingSafe: import Everything import EverythingSafe -- Note that the Everything* modules are 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-1.1/README.md000066400000000000000000000044771350553555600150350ustar00rootroot00000000000000The Agda standard library ========================= The standard library aims to contain all the tools needed to easily write both programs and proofs. While we always try and write efficient code, we prioritise ease of proof over type-checking and normalisation performance. If computational performance is important to you, then perhaps try [agda-prelude](https://github.com/UlfNorell/agda-prelude) instead. If you're looking to find your way around the library, its structure is described in the [README.agda](https://github.com/agda/agda-stdlib/tree/master/README.agda) and the associated [README folder](https://github.com/agda/agda-stdlib/tree/master/README). You can browse the library source code in glorious clickable html [here](https://agda.github.io/agda-stdlib/README.html). ## Installation instructions See the instructions [here](https://github.com/agda/agda-stdlib/blob/master/notes/installation-guide.md) for how to install version 1.1 of the standard library. #### Old versions of Agda If you're using an old version of Agda, you can download the corresponding version of the standard library on the [Agda wiki](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary). #### Development version of Agda If you're using a development version of Agda rather than the latest official release you should use the `experimental` branch of the standard library rather than `master`. The `experimental` branch contains non-backwards compatible patches for upcoming changes to the language. ## Type-checking with flags #### The `--safe` flag Most of the library can be type-checked using the `--safe` flag. Please consult [GenerateEverything.hs](https://github.com/agda/agda-stdlib/blob/master/GenerateEverything.hs#L23) for a full list of modules that use unsafe features. #### The `--without-k` flag Most of the library can be type-checked using the `--without-k` flag. Please consult [GenerateEverything.hs](https://github.com/agda/agda-stdlib/blob/master/GenerateEverything.hs#L74) for a full list of modules that use axiom K. ## Contributing to the library If you would like to suggest improvements, feel free to use the `Issues` tab. Even better if you would like to make the improvements yourself, we have instructions in [HACKING](https://github.com/agda/agda-stdlib/blob/master/HACKING.md) to help you get started. agda-stdlib-1.1/README/000077500000000000000000000000001350553555600144775ustar00rootroot00000000000000agda-stdlib-1.1/README/Axiom.agda000066400000000000000000000064341350553555600164010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An explanation about the `Axiom` modules. ------------------------------------------------------------------------ module README.Axiom where open import Level using (Level) private variable ℓ : Level ------------------------------------------------------------------------ -- Introduction -- Several rules that are used without thought in written mathematics -- cannot be proved in Agda. The modules in the `Axiom` folder -- provide types expressing some of these rules that users may want to -- use even when they're not provable in Agda. ------------------------------------------------------------------------ -- Example: law of excluded middle -- In classical logic the law of excluded middle states that for any -- proposition `P` either `P` or `¬P` must hold. This is impossible -- to prove in Agda because Agda is a constructive system and so any -- proof of the excluded middle would have to build a term of either -- type `P` or `¬P`. This is clearly impossible without any knowledge -- of what proposition `P` is. -- The types for which `P` or `¬P` holds is called `Dec P` in the -- standard library (short for `Decidable`). open import Relation.Nullary using (Dec) -- The type of the proof of saying that excluded middle holds for -- all types at universe level ℓ is therefore: -- -- ExcludedMiddle ℓ = ∀ {P : Set ℓ} → Dec P -- -- and this type is exactly the one found in `Axiom.ExcludedMiddle`: open import Axiom.ExcludedMiddle -- There are two different ways that the axiom can be introduced into -- your Agda development. The first option is to postulate it: postulate excludedMiddle : ExcludedMiddle ℓ -- This has the advantage that it only needs to be postulated once -- and it can then be imported into many different modules as with any -- other proof. The downside is that the resulting Agda code will no -- longer type check under the --safe flag. -- The second approach is to pass it as a module parameter: module Proof (excludedMiddle : ExcludedMiddle ℓ) where -- The advantage of this approach is that the resulting Agda -- development can still be type checked under the --safe flag. -- Intuitively the reason for this is that when postulating it -- you are telling Agda that excluded middle does hold (which is clearly -- untrue as discussed above). In contrast when passing it as a module -- parameter you are telling Agda that **if** excluded middle was true -- then the following proofs would hold, which is logically valid. -- The disadvantage of this approach is that it is now necessary to -- include the excluded middle assumption as a parameter in every module -- that you want to use it in. Additionally the modules can never -- be fully instantiated (without postulating excluded middle). ------------------------------------------------------------------------ -- Other axioms -- Double negation elimination -- (∀ P → ¬ ¬ P → P) import Axiom.DoubleNegationElimination -- Function extensionality -- (∀ f g → (∀ x → f x ≡ g x) → f ≡ g) import Axiom.Extensionality.Propositional import Axiom.Extensionality.Heterogeneous -- Uniqueness of identity proofs (UIP) -- (∀ x y (p q : x ≡ y) → p ≡ q) import Axiom.UniquenessOfIdentityProofs agda-stdlib-1.1/README/Case.agda000066400000000000000000000040211350553555600161650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the case expressions can be used with anonymous -- pattern-matching lambda abstractions ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} 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 Data.List open import Data.Sum open import Data.Product open import Function open import Relation.Nullary open import Relation.Binary open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Different types of pattern-matching lambdas -- absurd pattern empty : ∀ {a} {A : Set a} → Fin 0 → A empty i = case i of λ () -- {}-delimited and ;-separated list of clauses -- Note that they do not need to be on different lines pred : ℕ → ℕ pred n = case n of λ { zero → zero ; (suc n) → n } -- where-introduced and indentation-identified block of list of clauses from-just : ∀ {a} {A : Set a} (x : Maybe A) → From-just x from-just x = case x return From-just of λ where (just x) → x nothing → _ ------------------------------------------------------------------------ -- We can define some recursive functions with case plus : ℕ → ℕ → ℕ plus m n = case m of λ { zero → n ; (suc m) → suc (plus m n) } div2 : ℕ → ℕ div2 zero = zero div2 (suc m) = case m of λ where zero → zero (suc m') → suc (div2 m') -- Note that some natural uses of case are rejected by the termination -- checker: -- module _ {a} {A : Set a} (eq? : Decidable {A = A} _≡_) where -- pairBy : List A → List (A ⊎ (A × A)) -- pairBy [] = [] -- pairBy (x ∷ []) = inj₁ x ∷ [] -- pairBy (x ∷ y ∷ xs) = case eq? x y of λ where -- (yes _) → inj₂ (x , y) ∷ pairBy xs -- (no _) → inj₁ x ∷ pairBy (y ∷ xs) agda-stdlib-1.1/README/Data.agda000066400000000000000000000157121350553555600161740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An explanation about how data types are laid out in the standard -- library. ------------------------------------------------------------------------ module README.Data where -- The top-level folder `Data` contains all the definitions of datatypes -- and their associated properties. -- Datatypes can broadly split into two categories -- i) "Basic" datatypes which do not take other datatypes as generic -- arguments (Nat, String, Fin, Bool, Char etc.) -- ii) "Container" datatypes which take other generic datatypes as -- arguments, (List, Vec, Sum, Product, Maybe, AVL trees etc.) ------------------------------------------------------------------------ -- Basic datatypes ------------------------------------------------------------------------ -- Basic datatypes are usually organised as follows: -- 1. A `Base` module which either contains the definition of the -- datatype or reimports it from the builtin modules, along with common -- functions, operations and relations over elements of the datatype. import Data.Nat.Base import Data.Integer.Base import Data.Char.Base import Data.String.Base import Data.Bool.Base -- Commonly these modules don't need to be imported directly as their -- contents is re-exported by the top level module (see below). -- 2. A `Properties` module which contains the basic properties of the -- functions, operations and relations contained in the base module. import Data.Nat.Properties import Data.Integer.Properties import Data.Char.Properties import Data.String.Properties import Data.Bool.Properties -- 3. A top-level module which re-exports the contents of the base -- module as well as various queries (i.e. decidability proofs) from the -- properties file. import Data.Nat import Data.Integer import Data.Char import Data.String import Data.Bool -- 4. A `Solver` module (for those datatypes that have an algebraic solver) -- which can be used to automatically solve equalities over the basic datatype. import Data.Nat.Solver import Data.Integer.Solver import Data.Bool.Solver -- 5. More complex operations and relations are commonly found in their -- own module beneath the top-level directory. For example: import Data.Nat.DivMod import Data.Integer.Coprimality -- Note that eventually there is a plan to re-organise the library to -- have the top-level module export a far wider range of properties and -- additional operations in order to minimise the number of imports -- needed. Currently it is necessary to import each of these seperately -- however. ------------------------------------------------------------------------ -- Container datatypes ------------------------------------------------------------------------ -- 1. As with basic datatypes, a `Base` module which contains the -- definition of the datatype, along with common functions and -- operations over that data. Unlike basic datatypes, the `Base` module -- for container datatypes does not export any relations or predicates -- over the datatype (see the `Relation` section below). import Data.List.Base import Data.Maybe.Base import Data.Sum.Base -- Commonly these modules don't need to be imported directly as their -- contents is re-exported by the top level module (see below). -- 2. As with basic datatypes, a `Properties` module which contains the -- basic properties of the functions, operations and contained in the -- base module. import Data.List.Properties import Data.Maybe.Properties import Data.Sum.Properties -- 3. As with basic datatypes, a top-level module which re-exports the -- contents of the base module. In some cases this may also contain -- additional functions which could not be placed into the corresponding -- Base module because of cyclic dependencies. import Data.List import Data.Maybe import Data.Sum -- 4. A `Relation.Binary` folder where binary relations over the datatypes -- are stored. Because relations over container datatypes often depend on -- relations over the parameter datatype, this differs from basic datatypes -- where the binary relations are usually defined in the `Base` module, e.g. -- equality over the type `List A` depends on equality over type `A`. -- For example the `Pointwise` relation that takes a relation over the -- underlying type A and lifts it to the container parameterised can be found -- as follows: import Data.List.Relation.Binary.Pointwise import Data.Maybe.Relation.Binary.Pointwise import Data.Sum.Relation.Binary.Pointwise -- Another useful subfolder in the `Data.X.Relation.Binary` folders is the -- `Data.X.Relation.Binary.Equality` folder which contains various forms of -- equality over the datatype. -- 5. A `Relation.Unary` folder where unary relations, or predicates, -- over the datatypes are stored. These can be viewed as properties -- over a single list. -- For example a commmon, useful example is `Data.X.Relation.Unary.Any` -- that contains the types of proofs that at least one element in the -- container satisfies some predicate/property. import Data.List.Relation.Unary.Any import Data.Vec.Relation.Unary.Any import Data.Maybe.Relation.Unary.Any -- Alternatively the `Data.X.Relation.Unary.All` module contains the -- type of proofs that all elements in the container satisfy some -- property. import Data.List.Relation.Unary.All import Data.Vec.Relation.Unary.All import Data.Maybe.Relation.Unary.All -- 6. A `Categorical` module/folder that contains categorical -- interpretations of the datatype. import Data.List.Categorical import Data.Maybe.Categorical import Data.Sum.Categorical.Left import Data.Sum.Categorical.Right -- 7. A `Function` folder that contains lifting of various types of -- functions (e.g. injections, surjections, bijections, inverses) to -- the datatype. import Data.Sum.Function.Propositional import Data.Sum.Function.Setoid import Data.Product.Function.Dependent.Propositional import Data.Product.Function.Dependent.Setoid ------------------------------------------------------------------------ -- Full list of documentation for the Data folder ------------------------------------------------------------------------ -- Some examples showing where the natural numbers/integers and some -- related operations and properties are defined, and how they can be -- used: import README.Data.Nat import README.Data.Nat.Induction import README.Data.Integer -- Some examples showing how the AVL tree module can be used. import README.Data.AVL -- Some examples showing how List module can be used. import README.Data.List -- Using List's Interleaving to define a fully certified filter function. import README.Data.Interleaving -- Example of an encoding of record types with manifest fields and "with". import README.Data.Record -- Example use case for a trie: a wee generic lexer import README.Data.Trie.NonDependent -- Examples how (indexed) containers and constructions over them (free -- monad, least fixed point, etc.) can be used import README.Data.Container.FreeMonad import README.Data.Container.Indexed agda-stdlib-1.1/README/Data/000077500000000000000000000000001350553555600153505ustar00rootroot00000000000000agda-stdlib-1.1/README/Data/AVL.agda000066400000000000000000000064101350553555600166110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing how the AVL tree module can be used ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module README.Data.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 (<-strictTotalOrder) open import Data.String using (String) open import Data.Vec using (Vec; _∷_; []) open import Relation.Binary.PropositionalEquality open Data.AVL <-strictTotalOrder renaming (Tree to Tree') Tree = Tree' (MkValue (Vec String) (subst (Vec String))) ------------------------------------------------------------------------ -- 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₄ : Tree 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-1.1/README/Data/Container/000077500000000000000000000000001350553555600172725ustar00rootroot00000000000000agda-stdlib-1.1/README/Data/Container/FreeMonad.agda000066400000000000000000000037461350553555600217620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example showing how the free monad construction on containers can be -- used ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module README.Data.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 as P ------------------------------------------------------------------------ -- 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 = inn (inj₁ _ , return) where open RawMonad rawMonad put : ∀ {S} → S → State S ⋆ ⊤ put s = inn (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 : Set} → 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 = P.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-1.1/README/Data/Container/Indexed.agda000066400000000000000000000062141350553555600214730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example showing how to define an indexed container ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe --guardedness #-} module README.Data.Container.Indexed where open import Data.Unit open import Data.Empty open import Data.Nat.Base open import Data.Product open import Function open import Data.W.Indexed open import Data.Container.Indexed open import Data.Container.Indexed.WithK module _ {a} (A : Set a) where ------------------------------------------------------------------------ -- Vector as an indexed container -- An indexed container is defined by three things: -- 1. Commands the user can emit -- 2. Responses the indexed container returns to these commands -- 3. Update of the index based on the command and the response issued. -- For a vector, commands are constructors, responses are the number of subvectors -- (0 if the vector is empty, 1 otherwise) and the update corresponds to setting the -- size of the tail (if it exists). We can formalize these ideas like so: -- Depending on the size of the vector, we may have reached the end already (nil) -- or we may specify what the head should be (cons). This is the type of commands. data VecC : ℕ → Set a where nil : VecC zero cons : ∀ n → A → VecC (suc n) Vec : Container ℕ ℕ a _ Command Vec = VecC -- We then treat each command independently, specifying both the response and the -- next index based on that response. -- In the nil case, the response is the empty type: there won't be any tail. As -- a consequence, the next index won't be needed (and we can rely on the fact the -- user will never be able to call it). Response Vec nil = ⊥ next Vec nil = λ () -- In the cons case, the response is the unit type: there is exactly one tail. The -- next index is the predecessor of the current one. It is handily handed over to -- use by `cons`. -- cons Response Vec (cons n a) = ⊤ next Vec (cons n a) = λ _ → n -- Finally we can define the type of Vector as the least fixed point of Vec. Vector : ℕ → Set a Vector = μ Vec module _ {a} {A : Set a} where -- We can recover the usual constructors by using `sup` to enter the fixpoint -- and then using the appropriate pairing of a command & a handler for the -- response. -- For [], the response is ⊥ which makes it easy to conclude. [] : Vector A 0 [] = sup (nil , λ ()) -- For _∷_, the response is ⊤ so we need to pass a tail. We give the one we took -- as an argument. infixr 3 _∷_ _∷_ : ∀ {n} → A → Vector A n → Vector A (suc n) x ∷ xs = sup (cons _ x , λ _ → xs) -- We can now use these constructors to build up vectors: 1⋯3 : Vector ℕ 3 1⋯3 = 1 ∷ 2 ∷ 3 ∷ [] -- Horrible thing to check the definition of _∈_ is not buggy. -- Not sure whether we can say anything interesting about it in the case of Vector... open import Relation.Binary.HeterogeneousEquality _ : _∈_ {C = Vec ℕ} {X = Vector ℕ} 1⋯3 (⟦ Vec ℕ ⟧ (Vector ℕ) 4 ∋ cons _ 0 , λ _ → 1⋯3) _ = _ , refl agda-stdlib-1.1/README/Data/Integer.agda000066400000000000000000000037271350553555600175740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing where the integers and some related -- operations and properties are defined, and how they can be used ------------------------------------------------------------------------ {-# OPTIONS --without-K #-} module README.Data.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. import Data.Integer.Properties as ℤₚ ex₅ : ∀ i j → i * j ≡ j * i ex₅ i j = ℤₚ.*-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 *_) (ℤₚ.+-identityʳ j) ⟩ i * j ≡⟨ ℤₚ.*-comm i j ⟩ j * i ∎ -- The module RingSolver in Data.Integer.Solver contains a solver -- for integer equalities involving variables, constants, _+_, _*_, -_ -- and _-_. open import Data.Integer.Solver using (module +-*-Solver) open +-*-Solver 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 agda-stdlib-1.1/README/Data/Interleaving.agda000066400000000000000000000062141350553555600206200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the notion of Interleaving can be used ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module README.Data.Interleaving where open import Level open import Data.List.Base hiding (filter) open import Data.List.Relation.Unary.All open import Function open import Relation.Nullary open import Relation.Unary -- In its most general form, `Interleaving` is parametrised by two relations -- `L` (for Left) and `R` (for Right). Given three lists, `xs`, `ys` and `zs`, -- a proof of `Interleaving xs ys zs` is essentially a diagram explaining how -- `zs` can be pulled apart into `xs` and `ys` in a way compatible with `L` -- and `R`. For instance: -- xs zs ys -- -- x₁ -- L x₁ z₁ -- z₁ -- x₂ -- L x₂ z₂ -- z₂ -- z₃ -- R z₃ z₁ -- y₁ -- x₃ -- L x₃ z₄ -- z₄ -- z₅ -- R z₅ y₂ -- y₂ open import Data.List.Relation.Ternary.Interleaving.Propositional -- The special case we will focus on here is the propositional case: both -- `L` and ̀R` are propositional equality. Rethinking our previous example, -- this gives us the proof that [z₁, ⋯, z₅] can be partitioned into -- [z₁, z₂, z₄] on the one hand and [z₃, z₅] in the other. -- One possible use case for such a relation is the definition of a very -- precise filter function. Provided a decidable predicate `P`, it will -- prove not only that the retained values satisfy `P` but that the ones -- that didn't make the cut satisfy the negation of P. -- We can make this formal by defining the following record type: infix 3 _≡_⊎_ record Filter {a p} {A : Set a} (P : Pred A p) (xs : List A) : Set (a ⊔ p) where constructor _≡_⊎_ field -- The result of running filter is two lists: -- * the elements we have kept -- * and the ones we have thrown away -- We leave these implicit: they can be inferred from the rest {kept} : List A {thrown} : List A -- There is a way for us to recover the original -- input by interleaving the two lists cover : Interleaving kept thrown xs -- Finally, the partition was made according to the predicate allP : All P kept all¬P : All (∁ P) thrown -- Once we have this type written down, we can write the function. -- We use an anonymous module to clean up the function's type. module _ {a p} {A : Set a} {P : Pred A p} (P? : Decidable P) where filter : ∀ xs → Filter P xs -- If the list is empty, we are done. filter [] = [] ≡ [] ⊎ [] filter (x ∷ xs) = -- otherwise we start by running filter on the tail let xs' ≡ ps ⊎ ¬ps = filter xs in -- And depending on whether `P` holds of the head, -- we cons it to the `kept` or `thrown` list. case P? x of λ where -- [1] (yes p) → consˡ xs' ≡ p ∷ ps ⊎ ¬ps (no ¬p) → consʳ xs' ≡ ps ⊎ ¬p ∷ ¬ps -- [1] See the following module for explanations of `case_of_` and -- pattern-matching lambdas import README.Case agda-stdlib-1.1/README/Data/List.agda000066400000000000000000000402141350553555600171020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Documentation for the List type ------------------------------------------------------------------------ {-# OPTIONS --warning noMissingDefinitions #-} module README.Data.List where open import Algebra.Structures open import Data.Char.Base using (Char; fromℕ) open import Data.Char.Properties as CharProp hiding (setoid) open import Data.Nat open import Data.Nat.Properties as NatProp open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; cong; setoid) ------------------------------------------------------------------------ -- 1. Basics ------------------------------------------------------------------------ -- The `List` datatype is exported by the following file: open import Data.List module Basics where -- Lists are built using the "[]" and "_∷_" constructors. list₁ : List ℕ list₁ = 3 ∷ 1 ∷ 2 ∷ [] -- Basic operations over lists are also exported by the same file. lem₁ : sum list₁ ≡ 6 lem₁ = refl lem₂ : map (_+ 2) list₁ ≡ 5 ∷ 3 ∷ 4 ∷ [] lem₂ = refl lem₃ : take 2 list₁ ≡ 3 ∷ 1 ∷ [] lem₃ = refl lem₄ : reverse list₁ ≡ 2 ∷ 1 ∷ 3 ∷ [] lem₄ = refl lem₅ : list₁ ++ list₁ ≡ 3 ∷ 1 ∷ 2 ∷ 3 ∷ 1 ∷ 2 ∷ [] lem₅ = refl -- Various properties of these operations can be found in: open import Data.List.Properties lem₆ : ∀ n (xs : List ℕ) → take n xs ++ drop n xs ≡ xs lem₆ = take++drop lem₇ : ∀ (xs : List ℕ) → reverse (reverse xs) ≡ xs lem₇ = reverse-involutive lem₈ : ∀ (xs ys zs : List ℕ) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs) lem₈ = ++-assoc ------------------------------------------------------------------------ -- 2. Binary relations over lists ------------------------------------------------------------------------ -- All binary relations over lists are found in the folder -- `Data.List.Relation.Binary`. ------------------------------------------------------------------------ -- Pointwise module PointwiseExplanation where -- One of the most basic ways to form a binary relation between two -- lists of type `List A`, given a binary relation over `A`, is to say -- that two lists are related if: -- i) the first elements in the lists are related -- ii) the second elements in the lists are related -- iii) the third elements in the lists are related etc. -- -- A formalisation of this "pointwise" lifting of a relation to lists -- is found in: open import Data.List.Relation.Binary.Pointwise -- The same syntax to construct a list (`[]` & `_∷_`) is used to -- construct proofs for the `Pointwise` relation. For example if you -- want to prove that one list is strictly less than another list: lem₁ : Pointwise _<_ (0 ∷ 2 ∷ 1 ∷ []) (1 ∷ 4 ∷ 2 ∷ []) lem₁ = 0<1 ∷ 2<4 ∷ 1<2 ∷ [] where 0<1 = s≤s z≤n 2<4 = s≤s (s≤s (s≤s z≤n)) 1<2 = s≤s 0<1 -- Lists that are related by `Pointwise` must be of the same length. -- For example: open import Relation.Nullary using (¬_) lem₂ : ¬ Pointwise _<_ (0 ∷ 2 ∷ []) (1 ∷ []) lem₂ (0<1 ∷ ()) ------------------------------------------------------------------------ -- Equality module EqualityExplanation where -- There are many different options for what it means for two -- different lists of type `List A` to be "equal". We will initially -- consider notions of equality that require the list elements to be -- in the same order and later discuss other types of equality. -- The most basic option in the former case is simply to use -- propositional equality `_≡_` over lists: open import Relation.Binary.PropositionalEquality using (_≡_; sym; refl) lem₁ : 1 ∷ 2 ∷ 3 ∷ [] ≡ 1 ∷ 2 ∷ 3 ∷ [] lem₁ = refl -- However propositional equality is only suitable when we want to -- use propositional equality to compare the individual elements. -- Although a contrived example, consider trying to prove the -- equality of two lists of the type `List (ℕ → ℕ)`: lem₂ : (λ x → 2 * x + 2) ∷ [] ≡ (λ x → 2 * (x + 1)) ∷ [] -- In such a case it is impossible to prove the two lists equal with -- refl as the two functions are not propositionally equal. In the -- absence of postulating function extensionality (see README.Axioms), -- the most common definition of function equality is to say that two -- functions are equal if their outputs are always propositionally -- equal for any input. This notion of function equality `_≗_` is -- found in: open import Relation.Binary.PropositionalEquality using (_≗_) -- We now want to use the `Pointwise` relation to say that the two -- lists are equal if their elements are pointwise equal with resepct -- to `_≗_`. However instead of using the pointwise module directly -- to write: open import Data.List.Relation.Binary.Pointwise using (Pointwise) lem₃ : Pointwise _≗_ ((λ x → x + 1) ∷ []) ((λ x → x + 2 ∸ 1) ∷ []) -- the library provides some nicer wrappers and infix notation in the -- folder "Data.List.Relation.Binary.Equality". -- Within this folder there are four different modules. import Data.List.Relation.Binary.Equality.Setoid as SetoidEq import Data.List.Relation.Binary.Equality.DecSetoid as DecSetoidEq import Data.List.Relation.Binary.Equality.Propositional as PropEq import Data.List.Relation.Binary.Equality.DecPropositional as DecPropEq -- Which one should be used depends on whether the underlying equality -- over "A" is: -- i) propositional or setoid-based -- ii) decidable. -- Each of the modules except `PropEq` are designed to be opened with a -- module parameter. This is to avoid having to specify the underlying -- equality relation or the decidability proofs every time you use the -- list equality. -- In our example function equality is not decidable and not propositional -- and so we want to use the `SetoidEq` module. This requires a proof that -- the `_≗_` relation forms a setoid over functions of the type `ℕ → ℕ`. -- This is found in: open import Relation.Binary.PropositionalEquality using (_→-setoid_) -- The `SetoidEq` module should therefore be opened as follows: open SetoidEq (ℕ →-setoid ℕ) -- All four equality modules provide an infix operator `_≋_` for the -- new equality relation over lists. The type of `lem₃` can therefore -- be rewritten as: lem₄ : (λ x → x + 1) ∷ [] ≋ (λ x → x + 2 ∸ 1) ∷ [] lem₄ = 2x+2≗2[x+1] ∷ [] where 2x+2≗2[x+1] : (λ x → x + 1) ≗ (λ x → x + 2 ∸ 1) 2x+2≗2[x+1] x = sym (+-∸-assoc x (s≤s z≤n)) -- The modules also provide proofs that the `_≋_` relation is a -- setoid in its own right and therefore is reflexive, symmetric, -- transitive: lem₅ : (λ x → 2 * x + 2) ∷ [] ≋ (λ x → 2 * x + 2) ∷ [] lem₅ = ≋-refl -- If we could prove that `_≗_` forms a `DecSetoid` then we could use -- the module `DecSetoidEq` instead. This exports everything from -- `SetoidEq` as well as the additional proof `_≋?_` that the list -- equality is decidable. -- This pattern of four modules for each of the four different types -- of equality is repeated throughout the library (e.g. see the -- `Membership` subheading below). Note that in this case the modules -- `PropEq` and `DecPropEq` are not very useful as if two lists are -- pointwise propositionally equal they are necessarily -- propositionally equal (and vice-versa). There are proofs of this -- fact exported by `PropEq` and `DecPropEq`. Although, these two -- types of list equality are not very useful in practice, they are -- included for completeness's sake. ------------------------------------------------------------------------ -- Permutations module PermutationExplanation where -- Alternatively you might consider two lists to be equal if they -- contain the same elements regardless of the order of the elements. -- This is known as either "set equality" or a "permutation". -- The easiest-to-use formalisation of this relation is found in the -- module: open import Data.List.Relation.Binary.Permutation.Inductive -- The permutation relation is written as `_↭_` and has four -- constructors. The first `refl` says that a list is always -- a permutation of itself, the second `prep` says that if the -- heads of the lists are the same they can be skipped, the third -- `swap` says that the first two elements of the lists can be -- swapped and the fourth `trans` says that permutation proofs -- can be chained transitively. -- For example a proof that two lists are a permutation of one -- another can be written as follows: lem₁ : 1 ∷ 2 ∷ 3 ∷ [] ↭ 3 ∷ 1 ∷ 2 ∷ [] lem₁ = trans (prep 1 (swap 2 3 refl)) (swap 1 3 refl) -- In practice it is difficult to parse the constructors in the -- proof above and hence understand why it holds. The -- `PermutationReasoning` module can be used to write this proof -- in a much more readable form: open PermutationReasoning lem₂ : 1 ∷ 2 ∷ 3 ∷ [] ↭ 3 ∷ 1 ∷ 2 ∷ [] lem₂ = begin 1 ∷ 2 ∷ 3 ∷ [] ↭⟨ prep 1 (swap 2 3 refl) ⟩ 1 ∷ 3 ∷ 2 ∷ [] ↭⟨ swap 1 3 refl ⟩ 3 ∷ 1 ∷ 2 ∷ [] ∎ -- As might be expected, properties of the permutation relation may be -- found in `Data.List.Relation.Binary.Permutation.Inductive.Properties`. open import Data.List.Relation.Binary.Permutation.Inductive.Properties lem₃ : ∀ {xs ys : List ℕ} → xs ↭ ys → map fromℕ xs ↭ map fromℕ ys lem₃ = map⁺ fromℕ lem₄ : IsCommutativeMonoid {A = List ℕ} _↭_ _++_ [] lem₄ = ++-isCommutativeMonoid -- Note: at the moment permutations have only been formalised for -- propositional equality. Permutations for the other three types of -- equality (decidable propositional, setoid and decidable setoid) -- will hopefully be added in later versions of the library. ------------------------------------------------------------------------ -- Other relations -- There exist many other binary relations in the -- `Data.List.Relation.Binary` folder, including: -- 1. lexicographic orderings -- 2. bag/multiset equality -- 3. the subset relations. -- 4. the sublist relations ------------------------------------------------------------------------ -- 3. Properties of lists ------------------------------------------------------------------------ -- Whereas binary relations deal with how two lists relate to one -- another, the unary relations in `Data.List.Relation.Unary` are used -- to reason about the properties of an individual list. ------------------------------------------------------------------------ -- Any module AnyExplanation where -- The predicate `Any` encodes the idea of at least one element of a -- given list satisfying a given property (or more formally a -- predicate, see the `Pred` type in `Relation.Unary`). open import Data.List.Relation.Unary.Any as Any -- A proof of type Any consists of a sequence of the "there" -- constructors, which says that the element lies in the remainder of -- the list, followed by a single "here" constructor which indicates -- that the head of the list satisfies the predicate and takes a proof -- that it does so. -- For example a proof that a given list of natural numbers contains -- at least one number greater than or equal to 4 can be written as -- follows: lem₁ : Any (4 ≤_) (3 ∷ 5 ∷ 1 ∷ 6 ∷ []) lem₁ = there (here 4≤5) where 4≤5 = s≤s (s≤s (s≤s (s≤s z≤n))) -- Note that nothing requires that the proof of `Any` points at the -- first such element in the list. There is therefore an alternative -- proof for the above lemma which points to 6 instead of 5. lem₂ : Any (4 ≤_) (3 ∷ 5 ∷ 1 ∷ 6 ∷ []) lem₂ = there (there (there (here 4≤6))) where 4≤6 = s≤s (s≤s (s≤s (s≤s z≤n))) -- There also exist various operations over proofs of `Any` whose names -- shadow the corresponding list operation. The standard way of using -- these is to use `as` to name the module: import Data.List.Relation.Unary.Any as Any -- and then use the qualified name `Any.map`. For example, map can -- be used to change the predicate of `Any`: open import Data.Nat.Properties using (≤-trans; n≤1+n) lem₃ : Any (3 ≤_) (3 ∷ 5 ∷ 1 ∷ 6 ∷ []) lem₃ = Any.map 4≤x⇒3≤x lem₂ where 4≤x⇒3≤x : ∀ {x} → 4 ≤ x → 3 ≤ x 4≤x⇒3≤x = ≤-trans (n≤1+n 3) ------------------------------------------------------------------------ -- All module AllExplanation where -- The dual to `Any` is the predicate `All` which encodes the idea that -- every element in a given list satisfies a given property. open import Data.List.Relation.Unary.All -- Proofs for `All` are constructed using exactly the same syntax as -- is used to construct lists ("[]" & "_∷_"). For example to prove -- that every element in a list is less than or equal to one: lem₁ : All (_≤ 1) (1 ∷ 0 ∷ 1 ∷ []) lem₁ = 1≤1 ∷ 0≤1 ∷ 1≤1 ∷ [] where 0≤1 = z≤n 1≤1 = s≤s z≤n -- As with `Any`, the module also provides the standard operators -- `map`, `zip` etc. to manipulate proofs for `All`. import Data.List.Relation.Unary.All as All open import Data.Nat.Properties using (≤-trans; n≤1+n) lem₂ : All (_≤ 2) (1 ∷ 0 ∷ 1 ∷ []) lem₂ = All.map ≤1⇒≤2 lem₁ where ≤1⇒≤2 : ∀ {x} → x ≤ 1 → x ≤ 2 ≤1⇒≤2 x≤1 = ≤-trans x≤1 (n≤1+n 1) ------------------------------------------------------------------------ -- Membership module MembershipExplanation where -- Membership of a list is simply a special case of `Any` where -- `x ∈ xs` is defined as `Any (x ≈_) xs`. -- Just like pointwise equality of lists, the exact membership module -- that should be used depends on whether the equality on the -- underlying elements of the list is i) propositional or setoid-based -- and ii) decidable. import Data.List.Membership.Setoid as SetoidMembership import Data.List.Membership.DecSetoid as DecSetoidMembership import Data.List.Membership.Propositional as PropMembership import Data.List.Membership.DecPropositional as DecPropMembership -- For example if we want to reason about membership for `List ℕ` -- then you would use the `DecSetoidMembership` as we use -- propositional equality over `ℕ` and it is also decidable. Therefore -- the module `DecPropMembership` should be opened as follows: open DecPropMembership NatProp._≟_ -- As membership is just an instance of `Any` we also need to import -- the constructors `here` and `there`. (See issue #553 on Github for -- why we're struggling to have `here` and `there` automatically -- re-exported by the membership modules). open import Data.List.Relation.Unary.Any using (here; there) -- These modules provide the infix notation `_∈_` which can be used -- as follows: lem₁ : 1 ∈ 2 ∷ 1 ∷ 3 ∷ [] lem₁ = there (here refl) -- Properties of the membership relation can be found in the following -- two files: import Data.List.Membership.Setoid.Properties as SetoidProperties import Data.List.Membership.Propositional.Properties as PropProperties -- As of yet there are no corresponding files for properties of -- membership for decidable versions of setoid and propositional -- equality as we have no properties that only hold when equality is -- decidable. -- These `Properties` modules are NOT parameterised in the same way as -- the main membership modules as some of the properties relate -- membership proofs for lists of different types. For example in the -- following the first `∈` refers to lists of type `List ℕ` whereas -- the second `∈` refers to lists of type `List Char`. open DecPropMembership CharProp._≟_ renaming (_∈_ to _∈ᶜ_) open SetoidProperties using (∈-map⁺) lem₂ : {v : ℕ} {xs : List ℕ} → v ∈ xs → fromℕ v ∈ᶜ map fromℕ xs lem₂ = ∈-map⁺ (setoid ℕ) (setoid Char) (cong fromℕ) agda-stdlib-1.1/README/Data/Nat.agda000066400000000000000000000030061350553555600167070ustar00rootroot00000000000000------------------------------------------------------------------------ -- 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 ------------------------------------------------------------------------ {-# OPTIONS --without-K #-} module README.Data.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.Solver contains a solver -- for natural number equalities involving variables, constants, _+_ -- and _*_. open import Data.Nat.Solver using (module +-*-Solver) open +-*-Solver ex₅ : ∀ m n → m * (n + 0) ≡ n * m ex₅ = solve 2 (λ m n → m :* (n :+ con 0) := n :* m) refl agda-stdlib-1.1/README/Data/Nat/000077500000000000000000000000001350553555600160725ustar00rootroot00000000000000agda-stdlib-1.1/README/Data/Nat/Induction.agda000066400000000000000000000116651350553555600206550ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples of how to use non-trivial induction over the natural -- numbers. ------------------------------------------------------------------------ module README.Data.Nat.Induction where open import Data.Nat open import Data.Nat.Induction open import Data.Product using (_,_) open import Function using (_∘_) open import Induction.WellFounded open import Relation.Binary.PropositionalEquality -- Doubles its input. twice : ℕ → ℕ twice = rec _ λ { zero _ → zero ; (suc n) twice-n → suc (suc twice-n) } -- Halves its input (rounding downwards). -- -- The step function is mentioned in a proof below, so it has been -- given a name. (The mutual keyword is used to avoid having to give -- a type signature for the step function.) mutual half₁-step = λ { zero _ → zero ; (suc zero) _ → zero ; (suc (suc n)) (_ , half₁n , _) → suc half₁n } half₁ : ℕ → ℕ half₁ = cRec _ half₁-step -- An alternative implementation of half₁. mutual half₂-step = λ { zero _ → zero ; (suc zero) _ → zero ; (suc (suc n)) rec → suc (rec n (≤′-step ≤′-refl)) } half₂ : ℕ → ℕ half₂ = <′-rec _ half₂-step -- The application half₁ (2 + n) is definitionally equal to -- 1 + half₁ n. Perhaps it is instructive to see why. half₁-2+ : ∀ n → half₁ (2 + n) ≡ 1 + half₁ n half₁-2+ n = begin half₁ (2 + n) ≡⟨⟩ cRec _ half₁-step (2 + n) ≡⟨⟩ half₁-step (2 + n) (cRecBuilder _ half₁-step (2 + n)) ≡⟨⟩ half₁-step (2 + n) (let ih = cRecBuilder _ half₁-step (1 + n) in half₁-step (1 + n) ih , ih) ≡⟨⟩ half₁-step (2 + n) (let ih = cRecBuilder _ half₁-step n in half₁-step (1 + n) (half₁-step n ih , ih) , half₁-step n ih , ih) ≡⟨⟩ 1 + half₁-step n (cRecBuilder _ half₁-step n) ≡⟨⟩ 1 + cRec _ half₁-step n ≡⟨⟩ 1 + half₁ n ∎ where open ≡-Reasoning -- The application half₂ (2 + n) is definitionally equal to -- 1 + half₂ n. Perhaps it is instructive to see why. half₂-2+ : ∀ n → half₂ (2 + n) ≡ 1 + half₂ n half₂-2+ n = begin half₂ (2 + n) ≡⟨⟩ <′-rec _ half₂-step (2 + n) ≡⟨⟩ half₂-step (2 + n) (<′-recBuilder _ half₂-step (2 + n)) ≡⟨⟩ 1 + <′-recBuilder _ half₂-step (2 + n) n (≤′-step ≤′-refl) ≡⟨⟩ 1 + Some.wfRecBuilder _ half₂-step (2 + n) (<′-wellFounded (2 + n)) n (≤′-step ≤′-refl) ≡⟨⟩ 1 + Some.wfRecBuilder _ half₂-step (2 + n) (acc (<′-wellFounded′ (2 + n))) n (≤′-step ≤′-refl) ≡⟨⟩ 1 + half₂-step n (Some.wfRecBuilder _ half₂-step n (<′-wellFounded′ (2 + n) n (≤′-step ≤′-refl))) ≡⟨⟩ 1 + half₂-step n (Some.wfRecBuilder _ half₂-step n (<′-wellFounded′ (1 + n) n ≤′-refl)) ≡⟨⟩ 1 + half₂-step n (Some.wfRecBuilder _ half₂-step n (<′-wellFounded n)) ≡⟨⟩ 1 + half₂-step n (<′-recBuilder _ half₂-step n) ≡⟨⟩ 1 + <′-rec _ half₂-step n ≡⟨⟩ 1 + half₂ n ∎ where open ≡-Reasoning -- Some properties that the functions above satisfy, proved using -- cRec. half₁-+₁ : ∀ n → half₁ (twice n) ≡ n half₁-+₁ = cRec _ λ { zero _ → refl ; (suc zero) _ → refl ; (suc (suc n)) (_ , half₁twice-n≡n , _) → cong (suc ∘ suc) half₁twice-n≡n } half₂-+₁ : ∀ n → half₂ (twice n) ≡ n half₂-+₁ = cRec _ λ { zero _ → refl ; (suc zero) _ → refl ; (suc (suc n)) (_ , half₁twice-n≡n , _) → cong (suc ∘ suc) half₁twice-n≡n } -- Some properties that the functions above satisfy, proved using -- <′-rec. half₁-+₂ : ∀ n → half₁ (twice n) ≡ n half₁-+₂ = <′-rec _ λ { zero _ → refl ; (suc zero) _ → refl ; (suc (suc n)) rec → cong (suc ∘ suc) (rec n (≤′-step ≤′-refl)) } half₂-+₂ : ∀ n → half₂ (twice n) ≡ n half₂-+₂ = <′-rec _ λ { zero _ → refl ; (suc zero) _ → refl ; (suc (suc n)) rec → cong (suc ∘ suc) (rec n (≤′-step ≤′-refl)) } agda-stdlib-1.1/README/Data/Record.agda000066400000000000000000000022521350553555600174050ustar00rootroot00000000000000------------------------------------------------------------------------ -- 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". {-# OPTIONS --with-K #-} module README.Data.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-1.1/README/Data/Trie/000077500000000000000000000000001350553555600162535ustar00rootroot00000000000000agda-stdlib-1.1/README/Data/Trie/NonDependent.agda000066400000000000000000000147631350553555600214650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example use case for a trie: a wee generic lexer ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module README.Data.Trie.NonDependent where ------------------------------------------------------------------------ -- Introduction -- A Trie is a tree of values indexed by words in a finite language. It -- allows users to quickly compute the Brzozowski derivative of that -- little mapping from words to values. -- In the most general case, values can depend upon the list of characters -- that constitutes the path leading to them. Here however we consider a -- non-dependent case (cf. README.Trie.Dependent for a dependent use case). -- We can recognize keywords by storing the list of characters they -- correspond to as paths in a Trie and the constructor they are decoded -- to as the tree's values. -- E.g. -- [ . ] is a root -- [ -- m --> ] is an m-labeled edge and is followed when reading 'm' -- [ (X) ] is a value leaf storing constructor X -- --> -- m --> -- m --> -- a --> (LEMMA) -- / -- -- l --> -- e --> -- t --> (LET) -- / -- / -- u --> -- t --> -- u --> -- a --> -- l --> (MUTUAL) -- / / -- .< -- m --> -- o --> -- d --> -- u --> -- l --> -- e --> (MODULE) -- \ -- -- w --> -- h --> -- e --> -- r --> -- e --> (WHERE) -- \ -- --> -- n --> (WHEN) -- after reading 'w', we get the derivative: -- . -- h --> -- e --> -- r --> -- e --> (WHERE) -- \ -- --> -- n --> (WHEN) open import Level open import Data.Unit open import Data.Bool open import Data.Char as Char import Data.Char.Properties as Char open import Data.List as List using (List; []; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) open import Data.Maybe as Maybe open import Data.Product as Prod open import Data.String.Base as String using (String) open import Data.These as These open import Function using (case_of_; _$_; _∘′_; id) open import Data.Trie Char.<-strictTotalOrder-≈ open import Data.AVL.Value ------------------------------------------------------------------------ -- Generic lexer module Lexer -- Our lexer is parametrised over the type of tokens {t} {Tok : Set t} -- We start with an association list between -- * keywords (as Strings) -- * keywords (as token values) (lex : List⁺ (String × Tok)) -- Some characters are special: they are separators, breaking a string -- into a list of tokens. Some are associated to a token value -- (e.g. parentheses) others are not (e.g. space) (breaking : Char → ∃ λ b → if b then Maybe Tok else Lift _ ⊤) -- Finally, strings which are not decoded as keywords are coerced -- using a function to token values. (default : String → Tok) where tokenize : String → List Tok tokenize = start ∘′ String.toList where mutual -- A Trie is defined for an alphabet of strictly ordered letters (here -- we have picked Char for letters and decided to use the strict total -- order induced by their injection into ℕ as witnessed by the statement -- open import Data.Trie Char.strictTotalOrder earlier in this file). -- It is parametrised by a set of Values indexed over list of letters. -- Because we focus on the non-dependent case, we pick the constant -- family of Value uniformly equal to Tok. It is trivially compatible -- with the notion of equality underlying the strict total order on Chars. Keywords : Set _ Keywords = Trie (const _ Tok) _ -- We build a trie from the association list so that we may easily -- compute the successive derivatives obtained by eating the -- characters one by one init : Keywords init = fromList $ List⁺.toList $ List⁺.map (Prod.map₁ String.toList) lex -- Kickstart the tokeniser with an empty accumulator and the initial -- trie. start : List Char → List Tok start = loop [] init -- The main loop loop : (acc : List Char) → -- chars read so far in this token (toks : Keywords) → -- keyword candidates left at this point (input : List Char) → -- list of chars to tokenize List Tok -- Empty input: finish up, check whether we have a non-empty accumulator loop acc toks [] = push acc [] -- At least one character loop acc toks (c ∷ cs) = case breaking c of λ where -- if we are supposed to break on this character, we do (true , m) → push acc $ maybe′ _∷_ id m $ start cs -- otherwise we see whether it leads to a recognized keyword (false , _) → case lookupValue (c ∷ []) toks of λ where -- if so we can forget about the current accumulator and -- restart the tokenizer on the rest of the input (just tok) → tok ∷ start cs -- otherwise we record the character we read in the accumulator, -- compute the derivative of the map of keyword candidates and -- keep going with the rest of the input nothing → loop (c ∷ acc) (lookupTrie c toks) cs -- Grab the accumulator and, unless it is empty, push it on top of -- the decoded list of tokens push : List Char → List Tok → List Tok push [] ts = ts push cs ts = default (String.fromList (List.reverse cs)) ∷ ts ------------------------------------------------------------------------ -- Concrete instance -- A small set of keywords for a language with expressions of the form -- `let x = e in b`. data TOK : Set where LET EQ IN : TOK LPAR RPAR : TOK ID : String → TOK toks : List⁺ (String × TOK) toks = ("let" , LET) ∷ ("=" , EQ) ∷ ("in" , IN) ∷ [] -- Breaking characters: spaces (thrown away) and parentheses (kept) breaking : Char → ∃ λ b → if b then Maybe TOK else Lift _ ⊤ breaking c = if isSpace c then true , nothing else parens c where parens : Char → _ parens '(' = true , just LPAR parens ')' = true , just RPAR parens _ = false , _ open import Agda.Builtin.Equality open Lexer toks breaking ID -- A test case: _ : tokenize "fix f x = let b = fix f in (f b) x" ≡ ID "fix" ∷ ID "f" ∷ ID "x" ∷ EQ ∷ LET ∷ ID "b" ∷ EQ ∷ ID "fix" ∷ ID "f" ∷ IN ∷ LPAR ∷ ID "f" ∷ ID "b" ∷ RPAR ∷ ID "x" ∷ [] _ = refl agda-stdlib-1.1/README/Debug/000077500000000000000000000000001350553555600155255ustar00rootroot00000000000000agda-stdlib-1.1/README/Debug/Trace.agda000066400000000000000000000072221350553555600174040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example showing how the Debug.Trace module can be used ------------------------------------------------------------------------ {-# OPTIONS --without-K #-} module README.Debug.Trace where ------------------------------------------------------------------------ -- Sometimes compiled code can contain bugs. -- Whether caused by the compiler or present in the source code already, they -- can be hard to track. A primitive debugging technique is to strategically -- insert calls to tracing functions which will display their String argument -- upon evaluation. open import Data.String.Base using (_++_) open import Debug.Trace -- We can for instance add tracing messages to make sure an invariant is -- respected or check in which order evaluation takes place in the backend -- (which can inform our decision to use, or not, strictness primitives). -- In the following example, we define a division operation on natural numbers -- using the original dividend as the termination measure. We: -- 1. check in the base case that when the fuel runs out then the updated dividend -- is already zero. -- 2. wrap the calls to _∸_ and go in respective calls to trace to see when all -- of these thunks are forced: are we building a big thunk in go's second -- argument or evaluating it as we go? open import Data.Maybe.Base open import Data.Nat.Base open import Data.Nat.Show using (show) div : ℕ → ℕ → Maybe ℕ div m zero = nothing div m n = just (go m m) where -- invariants: m ≤ fuel -- result : m / n go : (fuel : ℕ) (m : ℕ) → ℕ go zero m = trace ("Invariant: " ++ show m ++ " should be zero.") zero go (suc fuel) m = let m' = trace ("Thunk for step " ++ show fuel ++ " forced") (m ∸ n) in trace ("Recursive call for step " ++ show fuel) (suc (go fuel m')) -- To observe the behaviour of this code, we need to compile it and run it. -- To run it, we need a main function. We define a very basic one: run div, -- and display its result if the run was successful. -- We add two calls to trace to see when div is evaluated and when the returned -- number is forced (by a call to show). open import IO main = let r = trace "Call to div" (div 4 2) j = λ n → trace "Forcing the result wrapped in just." (putStrLn (show n)) in run (maybe′ j (return _) r) -- We get the following trace where we can see that checking that the -- maybe-solution is just-headed does not force the natural number. Once forced, -- we observe that we indeed build a big thunk on go's second argument (all the -- recursive calls happen first and then we force the thunks one by one). -- Call to div -- Forcing the result wrapped in just. -- Recursive call for step 3 -- Recursive call for step 2 -- Recursive call for step 1 -- Recursive call for step 0 -- Thunk for step 0 forced -- Thunk for step 1 forced -- Thunk for step 2 forced -- Thunk for step 3 forced -- Invariant: 0 should be zero. -- 4 -- We also notice that the result is incorrect: 4/2 is 2 and not 4. We quickly -- notice that (div m (suc n)) will perform m recursive calls no matter what. -- And at each call it will put add 1. We can fix this bug by adding a new first -- equation to go: -- go fuel zero = zero -- Running the example again we observe that because we now need to check -- whether go's second argument is zero, the function is more strict: we see -- that recursive calls and thunk forcings are interleaved. -- Call to div -- Forcing the result wrapped in just. -- Recursive call for step 3 -- Thunk for step 3 forced -- Recursive call for step 2 -- Thunk for step 2 forced -- 2 agda-stdlib-1.1/README/Function/000077500000000000000000000000001350553555600162645ustar00rootroot00000000000000agda-stdlib-1.1/README/Function/Reasoning.agda000066400000000000000000000046301350553555600210320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing how the Function.Reasoning module -- can be used to perform "functional reasoning" similar to what is being -- described in: https://stackoverflow.com/q/22676703/3168666 ------------------------------------------------------------------------ {-# OPTIONS --with-K #-} module README.Function.Reasoning where -- Function.Reasoning exports a flipped application (_|>_) combinator -- as well as a type annotation (_∶_) combinator. open import Function.Reasoning ------------------------------------------------------------------------ -- A simple example module _ {A B C : Set} {A→B : A → B} {B→C : B → C} where -- Using the combinators we can, starting from a value, chain various -- functions whilst tracking the types of the intermediate results. A→C : A → C A→C a = a ∶ A |> A→B ∶ B |> B→C ∶ C ------------------------------------------------------------------------ -- A more concrete example open import Data.Nat open import Data.List.Base open import Data.Char.Base open import Data.String using (String; toList; fromList; _==_) open import Function open import Data.Bool hiding (_≤?_) open import Data.Product as P using (_×_; <_,_>; uncurry; proj₁) open import Agda.Builtin.Equality -- This can give us for instance this decomposition of a function -- collecting all of the substrings of the input which happen to be -- palindromes: subpalindromes : String → List String subpalindromes str = let Chars = List Char in str ∶ String -- first generate the substrings |> toList ∶ Chars |> inits ∶ List Chars |> concatMap tails ∶ List Chars -- then only keeps the ones which are not singletons |> filter (λ cs → 2 ≤? length cs) ∶ List Chars -- only keep the ones that are palindromes |> map < fromList , fromList ∘ reverse > ∶ List (String × String) |> boolFilter (uncurry _==_) ∶ List (String × String) |> map proj₁ ∶ List String -- Test cases _ : subpalindromes "doctoresreverse" ≡ "eve" ∷ "rever" ∷ "srevers" ∷ "esreverse" ∷ [] _ = refl _ : subpalindromes "elle-meme" ≡ "ll" ∷ "elle" ∷ "mem" ∷ "eme" ∷ [] _ = refl agda-stdlib-1.1/README/Inspect.agda000066400000000000000000000123671350553555600167330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Explaining how to use the inspect idiom and elaborating on the way -- it is implemented in the standard library. ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module README.Inspect where open import Data.Nat.Base open import Data.Nat.Properties open import Data.Product open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Using inspect -- We start with the definition of a (silly) predicate: `Plus m n p` states -- that `m + n` is equal to `p` in a rather convoluted way. Crucially, it -- distinguishes two cases: whether `p` is 0 or not. Plus-eq : (m n p : ℕ) → Set Plus-eq m n zero = m ≡ 0 × n ≡ 0 Plus-eq m n p@(suc _) = m + n ≡ p -- A sensible lemma to prove of this predicate is that whenever `p` is literally -- `m + n` then `Plus m n p` holds. That is to say `∀ m n → Plus m n (m + n)`. -- To be able to prove `Plus-eq m n (m + n)`, we need `m + n` to have either -- the shape `zero` or `suc _` so that `Plus-eq` may reduce. -- We could follow the way `_+_` computes by mimicking the same splitting -- strategy, thus forcing `m + n` to reduce: plus-eq-+ : ∀ m n → Plus-eq m n (m + n) plus-eq-+ zero zero = refl , refl plus-eq-+ zero (suc n) = refl plus-eq-+ (suc m) n = refl -- Or we could attempt to compute `m + n` first and check whether the result -- is `zero` or `suc p`. By using `with m + n` and naming the result `p`, -- the goal will become `Plus-eq m n p`. We can further refine this definition -- by distinguishing two cases like so: -- plus-eq-with : ∀ m n → Plus-eq m n (m + n) -- plus-eq-with m n with m + n -- ... | zero = {!!} -- ... | suc p = {!!} -- The problem however is that we have abolutely lost the connection between the -- computation `m + n` and its result `p`. Which makes the two goals unprovable: -- 1. `m ≡ 0 × n ≡ 0`, with no assumption whatsoever -- 2. `m + n ≡ suc p`, with no assumption either -- By using the `with` construct, we have generated an auxiliary function that -- looks like this: -- `plus-eq-with-aux : ∀ m n p → Plus-eq m n p` -- when we would have wanted a more precise type of the form: -- `plus-eq-aux : ∀ m n p → m + n ≡ p → Plus-eq m n p`. -- This is where we can use `inspect`. By using `with f x | inspect f x`, -- we get both a `y` which is the result of `f x` and a proof that `f x ≡ y`. -- Splitting on the result of `m + n`, we get two cases: -- 1. `m ≡ 0 × n ≡ 0` under the assumption that `m + n ≡ zero` -- 2. `m + n ≡ suc p` under the assumption that `m + n ≡ suc p` -- The first one can be discharged using lemmas from Data.Nat.Properties and -- the second one is trivial. plus-eq-with : ∀ m n → Plus-eq m n (m + n) plus-eq-with m n with m + n | inspect (m +_) n ... | zero | [ m+n≡0 ] = m+n≡0⇒m≡0 m m+n≡0 , m+n≡0⇒n≡0 m m+n≡0 ... | suc p | [ m+n≡1+p ] = m+n≡1+p ------------------------------------------------------------------------ -- Understanding the implementation of inspect -- So why is it that we have to go through the record type `Reveal_·_is_` -- and the ̀inspect` function? The fact is: we don't have to if we write -- our own auxiliary lemma: plus-eq-aux : ∀ m n → Plus-eq m n (m + n) plus-eq-aux m n = aux m n (m + n) refl where aux : ∀ m n p → m + n ≡ p → Plus-eq m n p aux m n zero m+n≡0 = m+n≡0⇒m≡0 m m+n≡0 , m+n≡0⇒n≡0 m m+n≡0 aux m n (suc p) m+n≡1+p = m+n≡1+p -- The problem is that when we write ̀with f x | pr`, `with` decides to call `y` -- the result `f x` and to replace *all* of the occurences of `f x` in the type -- of `pr` with `y`. That is to say that if we were to write: -- plus-eq-naïve : ∀ m n → Plus-eq m n (m + n) -- plus-eq-naïve m n with m + n | refl {x = m + n} -- ... | p | eq = {!!} -- then `with` would abstract `m + n` as `p` on *both* sides of the equality -- proven by `refl` thus giving us the following goal with an extra, useless, -- assumption: -- 1. `Plus-eq m n p` under the assumption that `p ≡ p` -- So how does `inspect` work? The standard library uses a more general version -- of the following type and function: record MyReveal_·_is_ (f : ℕ → ℕ) (x y : ℕ) : Set where constructor [_] field eq : f x ≡ y my-inspect : ∀ f n → MyReveal f · n is (f n) my-inspect f n = [ refl ] -- Given that `inspect` has the type `∀ f n → Reveal f · n is (f n)`, when we -- write `with f n | inspect f n`, the only `f n` that can be abstracted in the -- type of `inspect f n` is the third argument to `Reveal_·_is_`. -- That is to say that the auxiliary definition generated looks like this: plus-eq-reveal : ∀ m n → Plus-eq m n (m + n) plus-eq-reveal m n = aux m n (m + n) (my-inspect (m +_) n) where aux : ∀ m n p → MyReveal (m +_) · n is p → Plus-eq m n p aux m n zero [ m+n≡0 ] = m+n≡0⇒m≡0 m m+n≡0 , m+n≡0⇒n≡0 m m+n≡0 aux m n (suc p) [ m+n≡1+p ] = m+n≡1+p -- At the cost of having to unwrap the constructor `[_]` around the equality -- we care about, we can keep relying on `with` and avoid having to roll out -- handwritten auxiliary definitions. agda-stdlib-1.1/README/Nary.agda000066400000000000000000000376231350553555600162410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the generic n-ary operations the stdlib provides -- can be used ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module README.Nary where open import Level using (Level) open import Data.Nat.Base open import Data.Nat.Properties open import Data.Fin using (Fin; fromℕ; #_; inject₁) open import Data.List open import Data.List.Properties open import Data.Product using (_×_; _,_) open import Data.Sum using (inj₁; inj₂) open import Function open import Relation.Nullary open import Relation.Binary using (module Tri); open Tri open import Relation.Binary.PropositionalEquality private variable a b c d e : Level A : Set a B : Set b C : Set c D : Set d E : Set e ------------------------------------------------------------------------ -- Introduction ------------------------------------------------------------------------ -- Function.Nary.NonDependent and Data.Product.N-ary.Heterogeneous provide -- a generic representation of n-ary heterogeneous (non dependent) products -- and the corresponding types of (non-dependent) n-ary functions. The -- representation works well with inference thus allowing us to use generic -- combinators to manipulate such functions. open import Data.Product.Nary.NonDependent open import Function.Nary.NonDependent open import Relation.Nary ------------------------------------------------------------------------ -- Generalised equality-manipulating combinators ------------------------------------------------------------------------ -- By default the standard library provides users with (we are leaving out -- the implicit arguments here): -- -- cong : (f : A₁ → B) → a₁ ≡ b₁ → f a₁ ≡ f b₁ -- cong₂ : (f : A₁ → A₂ → B) → a₁ ≡ b₁ → a₂ ≡ b₂ → f a₁ a₂ ≡ f b₁ b₂ -- -- and -- -- subst : (P : A₁ → Set p) → a₁ ≡ b₁ → P a₁ → P b₁ -- subst₂ : (P : A₁ → A₂ → Set p) → a₁ ≡ b₁ → a₂ ≡ b₂ → P a₁ a₂ → P b₁ b₂ -- -- This pattern can be generalised to any natural number `n`. Thanks to our -- library for n-ary functions, we can write the types and implementations -- of `congₙ` and `substₙ`. ------------------------------------------------------------------------ -- congₙ : ∀ n (f : A₁ → ⋯ → Aₙ → B) → -- a₁ ≡ b₁ → ⋯ aₙ ≡ bₙ → f a₁ ⋯ aₙ ≡ f b₁ ⋯ bₙ -- It may be used directly to prove something: _ : ∀ (as bs cs : List ℕ) → zip (zip (as ++ []) (map id cs)) (reverse (reverse bs)) ≡ zip (zip as cs) bs _ = λ as bs cs → congₙ 3 (λ as bs → zip (zip as bs)) (++-identityʳ as) (map-id cs) (reverse-involutive bs) -- Or as part of a longer derivation: _ : ∀ m n p q → suc (m + (p * n) + (q ^ (m + n))) ≡ (m + 0) + (n * p) + (q ^ m * q ^ n) + 1 _ = λ m n p q → begin suc (m + (p * n) + (q ^ (m + n))) ≡⟨ +-comm 1 _ ⟩ m + (p * n) + (q ^ (m + n)) + 1 ≡⟨ congₙ 3 (λ m n p → m + n + p + 1) (+-comm 0 m) (*-comm p n) (^-distribˡ-+-* q m n) ⟩ m + 0 + n * p + (q ^ m) * (q ^ n) + 1 ∎ where open ≡-Reasoning -- Partial application of the functional argument is fine: the number of arguments -- `congₙ` is going to take is determined by its first argument (a natural number) -- and not by the type of the function it works on. _ : ∀ m → (m +_) ≡ ((m + 0) +_) _ = λ m → congₙ 1 _+_ (+-comm 0 m) -- We don't have to work on the function's first argument either: we can just as -- easily use `congₙ` to act on the second one by `flip`ping it. See `holeₙ` for -- a generalisation of this idea allowing to target *any* of the function's -- arguments and not just the first or second one. _ : ∀ m → (_+ m) ≡ (_+ (m + 0)) _ = λ m → congₙ 1 (flip _+_) (+-comm 0 m) ------------------------------------------------------------------------ -- substₙ : (P : A₁ → ⋯ → Aₙ → Set p) → -- a₁ ≡ b₁ → ⋯ aₙ ≡ bₙ → P a₁ ⋯ aₙ → P b₁ ⋯ bₙ -- We can play the same type of game with subst open import Agda.Builtin.Nat using (mod-helper) -- Because we know from the definition `mod-helper` that this equation holds: -- mod-helper k m (suc n) (suc j) = mod-helper (suc k) m n j -- we should be able to prove the slightly modified statement by transforming -- all the `x + 1` into `suc x`. We can do so using `substₙ`. _ : ∀ k m n j → mod-helper k m (n + 1) (j + 1) ≡ mod-helper (k + 1) m n j _ = λ k m n j → let P sk sn sj = mod-helper k m sn sj ≡ mod-helper sk m n j in substₙ P (+-comm 1 k) (+-comm 1 n) (+-comm 1 j) refl ----------------------------------------------------------------------- -- Generic programs working on n-ary products & functions ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- curryₙ : ∀ n → (A₁ × ⋯ × Aₙ → B) → A₁ → ⋯ → Aₙ → B -- uncurryₙ : ∀ n → (A₁ → ⋯ → Aₙ → B) → A₁ × ⋯ × Aₙ → B -- The first thing we may want to do generically is convert between -- curried function types and uncurried ones. We can do this by using: -- They both work the same way so we will focus on curryₙ only here. -- If we pass to `curryₙ` the arity of its argument then we obtain a -- fully curried function. curry₁ : (A × B × C × D → E) → A → B → C → D → E curry₁ = curryₙ 4 -- Note that here we are not flattening arbitrary nestings: products have -- to be right nested. Which means that if you have a deeply-nested product -- then it won't be affected by the procedure. curry₁' : (A × (B × C) × D → E) → A → (B × C) → D → E curry₁' = curryₙ 3 -- When we are currying a function, we have no obligation to pass its exact -- arity as the parameter: we can decide to only curry part of it like so: -- Indeed (A₁ × ⋯ × Aₙ → B) can also be seen as (A₁ × ⋯ × (Aₖ × ⋯ × Aₙ) → B) curry₂ : (A × B × C × D → E) → A → B → (C × D) → E curry₂ = curryₙ 3 ----------------------------------------------------------------------- -- projₙ : ∀ n (k : Fin n) → (A₁ × ⋯ × Aₙ) → Aₖ₊₁ -- Another useful class of functions to manipulate n-ary product is a -- generic projection function. Note the (k + 1) in the return index: -- Fin counts from 0 up. -- It behaves as one expects (Data.Fin's #_ comes in handy to write down -- Fin literals): proj₃ : (A × B × C × D × E) → C proj₃ = projₙ 5 (# 2) -- Of course we can once more project the "tail" of the n-ary product by -- passing `projₙ` a natural number which is smaller than the size of the -- n-ary product, seeing (A₁ × ⋯ × Aₙ) as (A₁ × ⋯ × (Aₖ × ⋯ × Aₙ)). proj₃' : (A × B × C × D × E) → C × D × E proj₃' = projₙ 3 (# 2) ----------------------------------------------------------------------- -- insertₙ : ∀ n (k : Fin (suc n)) → -- B → (A₁ × ⋯ Aₙ) → (A₁ × ⋯ × Aₖ × B × Aₖ₊₁ × ⋯ Aₙ) insert₁ : C → (A × B × D × E) → (A × B × C × D × E) insert₁ = insertₙ 4 (# 2) insert₁' : C → (A × B × D × E) → (A × B × C × D × E) insert₁' = insertₙ 3 (# 2) -- Note that `insertₙ` takes a `Fin (suc n)`. Indeed in an n-ary product -- there are (suc n) positions at which one may insert a value. We may -- insert at the front or the back of the product: insert-front : A → (B × C × D × E) → (A × B × C × D × E) insert-front = insertₙ 4 (# 0) insert-back : E → (A × B × C × D) → (A × B × C × D × E) insert-back = insertₙ 4 (# 4) ----------------------------------------------------------------------- -- removeₙ : ∀ n (k : Fin n) → (A₁ × ⋯ Aₙ) → (A₁ × ⋯ × Aₖ × Aₖ₊₂ × ⋯ Aₙ) -- Dual to `insertₙ`, we may remove a value. remove₁ : (A × B × C × D × E) → (A × B × D × E) remove₁ = removeₙ 5 (# 2) -- Inserting at `k` and then removing at `inject₁ k` should yield the identity remove-insert : C → (A × B × D × E) → (A × B × D × E) remove-insert c = removeₙ 5 (inject₁ k) ∘′ insertₙ 4 k c where k = # 2 ----------------------------------------------------------------------- -- updateₙ : ∀ n (k : Fin n) (f : (a : Aₖ₊₁) → B a) → -- (p : A₁ × ⋯ Aₙ) → (A₁ × ⋯ × Aₖ × B (projₙ n k p) × Aₖ₊₂ × ⋯ Aₙ) -- We can not only project out, insert or remove values: we can update them -- in place. The type (and value) of the replacement at position k may depend -- upon the current value at position k. update₁ : (p : A × B × ℕ × C × D) → (A × B × Fin _ × C × D) update₁ = updateₙ 5 (# 2) fromℕ -- We can explicitly use the primed version of `updateₙ` to make it known to -- Agda that the update function is non dependent. This type of information -- is useful for inference: the tighter the constraints, the easier it is to -- find a solution (if possible). update₂ : (p : A × B × ℕ × C × D) → (A × B × List D × C × D) update₂ = λ p → updateₙ′ 5 (# 2) (λ n → replicate n (projₙ 5 (# 4) p)) p ----------------------------------------------------------------------- -- _%=_⊢_ : ∀ n → (C → D) → (A₁ → ⋯ Aₙ → D → B) → A₁ → ⋯ → Aₙ → C → B -- Traditional composition (also known as the index update operator `_⊢_` -- in `Relation.Unary`) focuses solely on the first argument of an n-ary -- function. `_%=_⊢_` on the other hand allows us to touch any one of the -- arguments. -- In the following example we have a function `f : A → B` and `replicate` -- of type `ℕ → B → List B`. We want ̀f` to act on the second argument of -- replicate. Which we can do like so. compose₁ : (A → B) → ℕ → A → List B compose₁ f = 1 %= f ⊢ replicate -- Here we spell out the equivalent explicit variable-manipulation and -- prove the two functions equal. compose₁' : (A → B) → ℕ → A → List B compose₁' f n a = replicate n (f a) compose₁-eq : compose₁ {a} {A} {b} {B} ≡ compose₁' compose₁-eq = refl ----------------------------------------------------------------------- -- _∷=_⊢_ : ∀ n → A → (A₁ → ⋯ Aₙ → A → B) → A₁ → ⋯ → Aₙ → B -- Partial application usually focuses on the first argument of a function. -- We can now partially apply a function in any of its arguments using -- `_∷=_⊢_`. Reusing our example involving replicate: we can specialise it -- to only output finite lists of `0`: apply₁ : ℕ → List ℕ apply₁ = 1 ∷= 0 ⊢ replicate apply₁-eq : apply₁ 3 ≡ 0 ∷ 0 ∷ 0 ∷ [] apply₁-eq = refl ------------------------------------------------------------------------ -- holeₙ : ∀ n → (A → (A₁ → ⋯ Aₙ → B)) → A₁ → ⋯ → Aₙ → (A → B) -- As we have seen earlier, `cong` acts on a function's first variable. -- If we want to access the second one, we can use `flip`. But what about -- the fourth one? We typically use an explicit λ-abstraction shuffling -- variables. Not anymore. -- Reusing mod-helper just because it takes a lot of arguments: hole₁ : ∀ k m n j → mod-helper k (m + 1) n j ≡ mod-helper k (suc m) n j hole₁ = λ k m n j → cong (holeₙ 2 (mod-helper k) n j) (+-comm m 1) ----------------------------------------------------------------------- -- mapₙ : ∀ n → (B → C) → (A₁ → ⋯ Aₙ → B) → (A₁ → ⋯ → Aₙ → C) -- (R →_) gives us the reader monad (and, a fortiori, functor). That is to -- say that given a function (A → B) and an (R → A) we can get an (R → B) -- This generalises to n-ary functions. -- Reusing our `composeₙ` example: instead of applying `f` to the replicated -- element, we can map it on the resulting list. Giving us: map₁ : (A → B) → ℕ → A → List B map₁ f = mapₙ 2 (map f) replicate ------------------------------------------------------------------------ -- constₙ : ∀ n → B → A₁ → ⋯ → Aₙ → B -- `const` is basically `pure` for the reader monad discussed above. Just -- like we can generalise the functorial action corresponding to the reader -- functor to n-ary functions, we can do the same for `pure`. const₁ : A → B → C → D → E → A const₁ = constₙ 4 -- Together with `holeₙ`, this means we can make a constant function out -- of any of the arguments. The fourth for instance: const₂ : A → B → C → D → E → D const₂ = holeₙ 3 (constₙ 4) ------------------------------------------------------------------------ -- Generalised quantifiers ------------------------------------------------------------------------ -- As we have seen multiple times already, one of the advantages of working -- with non-dependent products is that they can be easily inferred. This is -- a prime opportunity to define generic quantifiers. -- And because n-ary relations are Set-terminated, there is no ambiguity -- where to split between arguments & codomain. As a consequence Agda can -- infer even `n`, the number of arguments. We can use notations which are -- just like the ones defined in `Relation.Unary`. ------------------------------------------------------------------------ -- ∃⟨_⟩ : (A₁ → ⋯ → Aₙ → Set r) → Set _ -- ∃⟨ P ⟩ = ∃ λ a₁ → ⋯ → ∃ λ aₙ → P a₁ ⋯ aₙ -- Returning to our favourite function taking a lot of arguments: we can -- find a set of input for which it evaluates to 666 exist₁ : ∃⟨ (λ k m n j → mod-helper k m n j ≡ 666) ⟩ exist₁ = 19 , 793 , 3059 , 10 , refl ------------------------------------------------------------------------ -- ∀[_] : (A₁ → ⋯ → Aₙ → Set r) → Set _ -- ∀[_] P = ∀ {a₁} → ⋯ → ∀ {aₙ} → P a₁ ⋯ aₙ all₁ : ∀[ (λ (a₁ a₂ : ℕ) → Dec (a₁ ≡ a₂)) ] all₁ {a₁} {a₂} = a₁ ≟ a₂ ------------------------------------------------------------------------ -- Π : (A₁ → ⋯ → Aₙ → Set r) → Set _ -- Π P = ∀ a₁ → ⋯ → ∀ aₙ → P a₁ ⋯ aₙ all₂ : Π[ (λ (a₁ a₂ : ℕ) → Dec (a₁ ≡ a₂)) ] all₂ = _≟_ ------------------------------------------------------------------------ -- _⇒_ : (A₁ → ⋯ → Aₙ → Set r) → (A₁ → ⋯ → Aₙ → Set s) → (A₁ → ⋯ → Aₙ → Set _) -- P ⇒ Q = λ a₁ → ⋯ → λ aₙ → P a₁ ⋯ aₙ → Q a₁ ⋯ aₙ antisym : ∀[ _≤_ ⇒ _≥_ ⇒ _≡_ ] antisym = ≤-antisym ------------------------------------------------------------------------ -- _∪_ : (A₁ → ⋯ → Aₙ → Set r) → (A₁ → ⋯ → Aₙ → Set s) → (A₁ → ⋯ → Aₙ → Set _) -- P ∪ Q = λ a₁ → ⋯ → λ aₙ → P a₁ ⋯ aₙ ⊎ Q a₁ ⋯ aₙ ≤->-connex : Π[ _≤_ ∪ _>_ ] ≤->-connex m n with <-cmp m n ... | tri< a ¬b ¬c = inj₁ (<⇒≤ a) ... | tri≈ ¬a b ¬c = inj₁ (≤-reflexive b) ... | tri> ¬a ¬b c = inj₂ c ------------------------------------------------------------------------ -- _∩_ : (A₁ → ⋯ → Aₙ → Set r) → (A₁ → ⋯ → Aₙ → Set s) → (A₁ → ⋯ → Aₙ → Set _) -- P ∩ Q = λ a₁ → ⋯ → λ aₙ → P a₁ ⋯ aₙ × Q a₁ ⋯ aₙ <-inversion : ∀[ _<_ ⇒ _≤_ ∩ _≢_ ] <-inversion m_ ⇒ ∁ _≤_ ] mn m≤n = <⇒≱ m>n m≤n agda-stdlib-1.1/README/Text.agda000066400000000000000000000061141350553555600162430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples of format strings and printf ------------------------------------------------------------------------ {-# OPTIONS --safe --without-K #-} module README.Text where open import Data.Nat.Base open import Data.Char.Base open import Data.List.Base open import Data.String.Base open import Data.Sum.Base open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Format strings open import Text.Format -- We can specify a format by writing a string which will get interpreted -- by a lexer into a list of formatting directives. -- The specification types are always started with a '%' character: -- Integers (%d or %i) -- Naturals (%u) -- Floats (%f) -- Chars (%c) -- Strings (%s) -- Anything which is not a type specification is a raw string to be spliced -- in the output of printf. -- For instance the following format alternates types and raw strings _ : lexer "%s: %u + %u ≡ %u" ≡ inj₂ (`String ∷ Raw ": " ∷ `ℕ ∷ Raw " + " ∷ `ℕ ∷ Raw " ≡ " ∷ `ℕ ∷ []) _ = refl -- Lexing can fail. There are two possible errors: -- If we start a specification type with a '%' but the string ends then -- we get an UnexpectedEndOfString error _ : lexer "%s: %u + %u ≡ %" ≡ inj₁ (UnexpectedEndOfString "%s: %u + %u ≡ %") _ = refl -- If we start a specification type with a '%' and the following character -- does not correspond to an existing type, we get an InvalidType error -- together with a focus highlighting the position of the problematic type. _ : lexer "%s: %u + %a ≡ %u" ≡ inj₁ (InvalidType "%s: %u + %" 'a' " ≡ %u") _ = refl ------------------------------------------------------------------------ -- Printf open import Text.Printf -- printf is a function which takes a format string as an argument and -- returns a function expecting a value for each type specification present -- in the format and returns a string splicing in these values into the -- format string. -- For instance `printf "%s: %u + %u ≡ %u"` is a -- `String → ℕ → ℕ → ℕ → String` function. _ : String → ℕ → ℕ → ℕ → String _ = printf "%s: %u + %u ≡ %u" _ : printf "%s: %u + %u ≡ %u" "example" 3 2 5 ≡ "example: 3 + 2 ≡ 5" _ = refl -- If the format string str is invalid then `printf str` will have type -- `Error e` where `e` is the lexing error. _ : Text.Printf.Error (UnexpectedEndOfString "%s: %u + %u ≡ %") _ = printf "%s: %u + %u ≡ %" _ : Text.Printf.Error (InvalidType "%s: %u + %" 'a' " ≡ %u") _ = printf "%s: %u + %a ≡ %u" -- Trying to pass arguments to such an ̀Error` type will lead to a -- unification error which hopefully makes the problem clear e.g. -- `printf "%s: %u + %a ≡ %u" "example" 3 2 5` fails with the error: -- Text.Printf.Error (InvalidType "%s: %u + %" 'a' " ≡ %u") should be -- a function type, but it isn't -- when checking that "example" 3 2 5 are valid arguments to a -- function of type Text.Printf.Printf (lexer "%s: %u + %a ≡ %u") agda-stdlib-1.1/Setup.hs000066400000000000000000000000571350553555600152000ustar00rootroot00000000000000import Distribution.Simple main = defaultMain agda-stdlib-1.1/lib.cabal000066400000000000000000000014361350553555600153000ustar00rootroot00000000000000name: lib version: 1.1 cabal-version: >= 1.10 build-type: Simple description: Helper programs. license: MIT tested-with: GHC == 7.10.3 GHC == 8.0.2 GHC == 8.2.2 GHC == 8.4.4 GHC == 8.6.2 executable GenerateEverything hs-source-dirs: . main-is: GenerateEverything.hs default-language: Haskell2010 build-depends: base >= 4.8.0.0 && < 4.13 , filemanip >= 0.3.6.2 && < 0.4 , filepath >= 1.4.0.0 && < 1.5 executable AllNonAsciiChars hs-source-dirs: . main-is: AllNonAsciiChars.hs default-language: Haskell2010 build-depends: base >= 4.8.0.0 && < 4.13 , filemanip >= 0.3.6.2 && < 0.4 agda-stdlib-1.1/notes/000077500000000000000000000000001350553555600146725ustar00rootroot00000000000000agda-stdlib-1.1/notes/installation-guide.md000066400000000000000000000034361350553555600210160ustar00rootroot00000000000000Installation instructions ========================= Use version v1.1 of the standard library with Agda 2.6.0. 1. Navigate to a suitable directory `$HERE` (replace appropriately) where you would like to install the library. 2. Download the tarball of v1.1 of the standard library. This can either be done manually by visiting the Github repository for the library, or via the command line as follows: ``` wget -O agda-stdlib.tar https://github.com/agda/agda-stdlib/archive/v1.1.tar.gz ``` Note that you can replace `wget` with other popular tools such as `curl` and that you can replace `1.1` with any other version of the library you desire. 3. Extract the standard library from the tarball. Again this can either be done manually or via the command line as follows: ``` tar -zxvf agda-stdlib.tar ``` 4. [ OPTIONAL ] If using [cabal](https://www.haskell.org/cabal/) then run the commands to install via cabal: ``` cd agda-stdlib-1.1 cabal install ``` 5. Register the standard library with Agda's package system by adding the following line to `$HOME/.agda/libraries`: ``` $HERE/agda-stdlib-1.1/standard-library.agda-lib ``` 6. [ OPTIONAL ] To use the standard library in your project `$PROJECT`, put a file `$PROJECT.agda-lib` file in the project root containing: ``` depend: standard-library include: $DIRS ``` where `$DIRS` is a list of directories where Agda searches for modules, for instance `.` (just the project root). 7. [ OPTIONAL ] If you want to refer to the standard library in all your projects, add the following line to `$HOME/.agda/defaults` ``` standard-library ``` Find the full story about installing Agda libraries at [readthedocs](http://agda.readthedocs.io/en/latest/tools/package-system.html). agda-stdlib-1.1/notes/release-guide.txt000066400000000000000000000027021350553555600201470ustar00rootroot00000000000000When releasing a new version of Agda standard library, the following procedure should be followed: #### Pre-release changes * Update `README.agda` by replacing 'development version' by 'version X.Y' in the title. * Update `README.md` * Update `lib.cabal` version to `X.Y`. * Update `notes/installation-guide.txt` * Update `CHANGELOG.md`. * Update the copyright year range in the LICENSE file, if necessary. #### Pre-release tests * Ensure that the library type-checks using Agda A.B.C: make test * Update submodule commit in the Agda repository: cd agda make fast-forward-std-lib * Run the tests involving the library: make lib-succeed * Commit the changes and push #### Release * 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" * Push all the changes and the new tag (requires Git >= 1.8.3): git push --follow-tags * Submit a pull request to update the version of standard library on Homebrew (https://github.com/Homebrew/homebrew-core/blob/master/Formula/agda.rb) * 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). #### Post-release * Move the CHANGELOG.md into the old CHANGELOG folders * Create new CHANGELOG.md file * Revert changes in README.md to reference development version agda-stdlib-1.1/notes/style-guide.md000066400000000000000000000161771350553555600174630ustar00rootroot00000000000000Style guide for the standard library ==================================== This is very much a work-in-progress and is not exhaustive. ## File structure #### Module imports * All module imports should be placed at the top of the file immediately after the module declaration. * If the module takes parameters that require imports from other files then those imports only may be placed above the module declaration. * If it is important that certain names only come into scope later in the file then the module should still be imported at the top of the file but it can be given a shorter name using `as` and then opened later on in the file when needed, e.g. ```agda import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality ... ... open SetoidEquality S ``` * The list of module imports should be in alphabetical order. * When using only a few items from a module, the items should be enumerated in the import with `using` in order to make dependencies clearer. #### Indentation * The contents of a top-level module should have zero indentation. * Every subsequent nested scope should then be indented by an additional two spaces. * `where` blocks should be indented by two spaces and their contents should be aligned with the `where`. * If the type of a term does not fit on one line then the subsequent lines of the type should all be aligned with the first character of the first line of type, e.g. ```agda map-cong₂ : ∀ {a b} {A : Set a} {B : Set b} → ∀ {f g : A → B} {xs} → All (λ x → f x ≡ g x) xs → map f xs ≡ map g xs ``` * As can be seen in the example above, function arrows at line breaks should always go at the end of the line rather the beginning of the next line. #### Module parameters * Module parameters should be put on a single line if they fit. * If they don't fit on a single line, then they should be spread out over multiple lines, each indented by two spaces. If they can be grouped logically by line then it is fine to do so, otherwise a line each is probably clearest. * The `where` should go on it's own line at the end. * For example: ```agda module Relation.Binary.Reasoning.Base.Single {a ℓ} {A : Set a} (_∼_ : Rel A ℓ) (refl : Reflexive _∼_) (trans : Transitive _∼_) where ``` #### Reasoning layout * The `begin` clause should go on the same line as the rest of the proof. * Every subsequent combinator `_≡⟨_⟩_` should go on its own line, indented by two spaces. * The relation sign (e.g. `≡`) for each line should be aligned if possible. * For example: ```agda +-comm : Commutative _+_ +-comm zero n = sym (+-identityʳ n) +-comm (suc m) n = begin suc m + n ≡⟨⟩ suc (m + n) ≡⟨ cong suc (+-comm m n) ⟩ suc (n + m) ≡⟨ sym (+-suc n m) ⟩ n + suc m ∎ ``` * When multiple reasoning frameworks need to be used in the same file, the `open` statement should always come in a where clause local to the definition. This way users can easily see which reasoning toolkit is being used. For instance: ```agda foo m n p = begin (...) ∎ where open ≤-Reasoning ``` #### Record layout * The `record` declaration should go on the same line as the rest of the proof. * The next line with the first record item should start with a single `{`. * Every subsequent item of the record should go on its own line starting with a `;`. * The final line should end with `}` on its own. * For example: ```agda ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPreorder = record { isEquivalence = isEquivalence ; reflexive = ≤-reflexive ; trans = ≤-trans } ``` #### Other * Non-trivial proofs in `private` blocks are generally discouraged. * `where` blocks are preferred rather than the `let` construction. * The `with` syntax is preferred over the use of `case` from the `Function` module. ## Types #### Implicit and explicit arguments * Functions arguments should be implicit if they can "almost always" be inferred. If there are common cases where they cannot be inferred then they should be left explicit. * If there are lots of implicit arguments that are common to a collection of proofs they should be extracted by using an anonymous module. * Implicit of type `Level` and `Set` can be generalised using `variable`. At the moment the policy is *not* to generalise over any other types in order to minimise the amount of information that users have to keep in their head concurrently. ## Naming conventions * Names should be descriptive - i.e. given the name of a proof and the module it lives in then users should be able to make a reasonable guess at what it contains. * Terms from other modules should only be renamed to avoid name clashes, otherwise all names should be used as defined. * Datatype names should be capitalised and function names should be lowercase. #### Variables * Natural variables are named `m`, `n`, `o`, ... (default `n`) * Integer variables are named `i`, `j`, `k`, ... (default `i`) * Rational variables are named `p`, `q`, `r`, ... (default `p`) * When naming proofs, the variables should occur in order, e.g. `m≤n+m` rather than `n≤m+n`. * Collections of elements are usually indicated by appending an `s` (e.g. if you are naming your variables `x` and `y` then lists should be named `xs` and `ys`). #### Preconditions and postconditions * Preconditions should only be included in names of results if "important" (mostly judgement call). * Preconditions of results should be prepended to a description of the result by using the symbol `⇒` in names (e.g. `asym⇒antisym`) * Preconditions and postconditions should be combined using the symbols `∨` and `∧` (e.g. `m*n≡0⇒m≡0∨n≡0`) * Try to avoid the need for bracketing but if necessary use square brackets (e.g. `[m∸n]⊓[n∸m]≡0`) #### Operators and relations * Operators and relations should be defined using mixfix notation where applicable (e.g. `_+_`, `_<_`) * Common properties such as those in rings/orders/equivalences etc. have defined abbreviations (e.g. commutativity is shortened to `comm`). `Data.Nat.Properties` is a good place to look for examples. * Properties should be by prefixed by the relevant operator/relation (e.g. commutativity of `_+_` is named `+-comm`) * If the relevant unicode characters are available, negated forms of relations should be used over the `¬` symbol (e.g. `m+n≮n` should be used instead of `¬m+n_ to map) ⟦_⟧Id : ∀ {n} → Expr n → Vec Carrier n → Carrier ⟦_⟧Id = Semantics.⟦_⟧ IdCat.applicative ⟦_⟧Vec : ∀ {m n} → Expr n → Vec (Vec Carrier m) n → Vec Carrier m ⟦_⟧Vec = Semantics.⟦_⟧ VecCat.applicative open module R {n} (i : Fin n) = Reflection setoid var (λ e ρ → Vec.lookup (⟦ e ⟧Vec ρ) i) (λ e ρ → ⟦ e ⟧Id (Vec.map (flip Vec.lookup i) ρ)) (λ e ρ → sym $ reflexive $ Naturality.natural (VecCat.lookup-morphism i) e ρ) agda-stdlib-1.1/src/Algebra/Properties/CommutativeMonoid.agda000066400000000000000000000202571350553555600243110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Properties.CommutativeMonoid {g₁ g₂} (M : CommutativeMonoid g₁ g₂) where open import Algebra.Operations.CommutativeMonoid M open import Algebra.Solver.CommutativeMonoid M open import Relation.Binary as B using (_Preserves_⟶_) open import Function open import Function.Equality using (_⟨$⟩_) open import Data.Product open import Data.Nat using (ℕ; zero; suc) open import Data.Fin using (Fin; zero; suc) open import Data.List as List using ([]; _∷_) import Data.Fin.Properties as FP open import Data.Fin.Permutation as Perm using (Permutation; Permutation′; _⟨$⟩ˡ_; _⟨$⟩ʳ_) open import Data.Fin.Permutation.Components as PermC open import Data.Table as Table open import Data.Table.Relation.Binary.Equality as TE using (_≗_) open import Data.Unit using (tt) import Data.Table.Properties as TP open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary using (yes; no) open import Relation.Nullary.Negation using (contradiction) open import Relation.Nullary.Decidable using (⌊_⌋) open CommutativeMonoid M renaming ( ε to 0# ; _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; comm to +-comm ) open import Algebra.FunctionProperties _≈_ open import Relation.Binary.Reasoning.Setoid setoid module _ {n} where open B.Setoid (TE.setoid setoid n) public using () renaming (_≈_ to _≋_) -- When summing over a function from a finite set, we can pull out any value and move it to the front. sumₜ-remove : ∀ {n} {i : Fin (suc n)} t → sumₜ t ≈ lookup t i + sumₜ (remove i t) sumₜ-remove {_} {zero} t = refl sumₜ-remove {suc n} {suc i} t′ = begin t₀ + ∑t ≈⟨ +-congˡ (sumₜ-remove t) ⟩ t₀ + (tᵢ + ∑t′) ≈⟨ solve 3 (λ x y z → x ⊕ (y ⊕ z) ⊜ y ⊕ (x ⊕ z)) refl t₀ tᵢ ∑t′ ⟩ tᵢ + (t₀ + ∑t′) ∎ where t = tail t′ t₀ = head t′ tᵢ = lookup t i ∑t = sumₜ t ∑t′ = sumₜ (remove i t) -- '_≈_' is a congruence over 'sumTable n'. sumₜ-cong-≈ : ∀ {n} → sumₜ {n} Preserves _≋_ ⟶ _≈_ sumₜ-cong-≈ {zero} p = refl sumₜ-cong-≈ {suc n} p = +-cong (p _) (sumₜ-cong-≈ (p ∘ suc)) -- '_≡_' is a congruence over 'sum n'. sumₜ-cong-≡ : ∀ {n} → sumₜ {n} Preserves _≗_ ⟶ _≡_ sumₜ-cong-≡ {zero} p = P.refl sumₜ-cong-≡ {suc n} p = P.cong₂ _+_ (p _) (sumₜ-cong-≡ (p ∘ suc)) -- If addition is idempotent on a particular value 'x', then summing over a -- nonzero number of copies of 'x' gives back 'x'. sumₜ-idem-replicate : ∀ n {x} → _+_ IdempotentOn x → sumₜ (replicate {n = suc n} x) ≈ x sumₜ-idem-replicate zero idem = +-identityʳ _ sumₜ-idem-replicate (suc n) {x} idem = begin x + (x + sumₜ (replicate {n = n} x)) ≈⟨ sym (+-assoc _ _ _) ⟩ (x + x) + sumₜ (replicate {n = n} x) ≈⟨ +-congʳ idem ⟩ x + sumₜ (replicate {n = n} x) ≈⟨ sumₜ-idem-replicate n idem ⟩ x ∎ -- The sum over the constantly zero function is zero. sumₜ-zero : ∀ n → sumₜ (replicate {n = n} 0#) ≈ 0# sumₜ-zero n = begin sumₜ (replicate {n = n} 0#) ≈⟨ sym (+-identityˡ _) ⟩ 0# + sumₜ (replicate {n = n} 0#) ≈⟨ sumₜ-idem-replicate n (+-identityˡ 0#) ⟩ 0# ∎ -- The '∑' operator distributes over addition. ∑-distrib-+ : ∀ n (f g : Fin n → Carrier) → ∑[ i < n ] (f i + g i) ≈ ∑[ i < n ] f i + ∑[ i < n ] g i ∑-distrib-+ zero f g = sym (+-identityˡ _) ∑-distrib-+ (suc n) f g = begin f₀ + g₀ + ∑fg ≈⟨ +-assoc _ _ _ ⟩ f₀ + (g₀ + ∑fg) ≈⟨ +-congˡ (+-congˡ (∑-distrib-+ n _ _)) ⟩ f₀ + (g₀ + (∑f + ∑g)) ≈⟨ solve 4 (λ a b c d → a ⊕ (c ⊕ (b ⊕ d)) ⊜ (a ⊕ b) ⊕ (c ⊕ d)) refl f₀ ∑f g₀ ∑g ⟩ (f₀ + ∑f) + (g₀ + ∑g) ∎ where f₀ = f zero g₀ = g zero ∑f = ∑[ i < n ] f (suc i) ∑g = ∑[ i < n ] g (suc i) ∑fg = ∑[ i < n ] (f (suc i) + g (suc i)) -- The '∑' operator commutes with itself. ∑-comm : ∀ n m (f : Fin n → Fin m → Carrier) → ∑[ i < n ] ∑[ j < m ] f i j ≈ ∑[ j < m ] ∑[ i < n ] f i j ∑-comm zero m f = sym (sumₜ-zero m) ∑-comm (suc n) m f = begin ∑[ j < m ] f zero j + ∑[ i < n ] ∑[ j < m ] f (suc i) j ≈⟨ +-congˡ (∑-comm n m _) ⟩ ∑[ j < m ] f zero j + ∑[ j < m ] ∑[ i < n ] f (suc i) j ≈⟨ sym (∑-distrib-+ m _ _) ⟩ ∑[ j < m ] (f zero j + ∑[ i < n ] f (suc i) j) ∎ -- Any permutation of a table has the same sum as the original. sumₜ-permute : ∀ {m n} t (π : Permutation m n) → sumₜ t ≈ sumₜ (permute π t) sumₜ-permute {zero} {zero} t π = refl sumₜ-permute {zero} {suc n} t π = contradiction π (Perm.refute λ()) sumₜ-permute {suc m} {zero} t π = contradiction π (Perm.refute λ()) sumₜ-permute {suc m} {suc n} t π = begin sumₜ t ≡⟨⟩ lookup t 0i + sumₜ (remove 0i t) ≡⟨ P.cong₂ _+_ (P.cong (lookup t) (P.sym (Perm.inverseʳ π))) P.refl ⟩ lookup πt (π ⟨$⟩ˡ 0i) + sumₜ (remove 0i t) ≈⟨ +-congˡ (sumₜ-permute (remove 0i t) (Perm.remove (π ⟨$⟩ˡ 0i) π)) ⟩ lookup πt (π ⟨$⟩ˡ 0i) + sumₜ (permute (Perm.remove (π ⟨$⟩ˡ 0i) π) (remove 0i t)) ≡⟨ P.cong₂ _+_ P.refl (sumₜ-cong-≡ (P.sym ∘ TP.remove-permute π 0i t)) ⟩ lookup πt (π ⟨$⟩ˡ 0i) + sumₜ (remove (π ⟨$⟩ˡ 0i) πt) ≈⟨ sym (sumₜ-remove (permute π t)) ⟩ sumₜ πt ∎ where 0i = zero πt = permute π t ∑-permute : ∀ {m n} f (π : Permutation m n) → ∑[ i < n ] f i ≈ ∑[ i < m ] f (π ⟨$⟩ʳ i) ∑-permute = sumₜ-permute ∘ tabulate -- If the function takes the same value at 'i' and 'j', then transposing 'i' and -- 'j' then selecting 'j' is the same as selecting 'i'. select-transpose : ∀ {n} t (i j : Fin n) → lookup t i ≈ lookup t j → ∀ k → (lookup (select 0# j t) ∘ PermC.transpose i j) k ≈ lookup (select 0# i t) k select-transpose _ i j e k with k FP.≟ i ... | yes p rewrite P.≡-≟-identity FP._≟_ {j} P.refl = sym e ... | no ¬p with k FP.≟ j ... | no ¬q rewrite proj₂ (P.≢-≟-identity FP._≟_ ¬q) = refl ... | yes q rewrite proj₂ (P.≢-≟-identity FP._≟_ (¬p ∘ P.trans q ∘ P.sym)) = refl -- Summing over a pulse gives you the single value picked out by the pulse. sumₜ-select : ∀ {n i} (t : Table Carrier n) → sumₜ (select 0# i t) ≈ lookup t i sumₜ-select {suc n} {i} t = begin sumₜ (select 0# i t) ≈⟨ sumₜ-remove {i = i} (select 0# i t) ⟩ lookup (select 0# i t) i + sumₜ (remove i (select 0# i t)) ≡⟨ P.cong₂ _+_ (TP.select-lookup t) (sumₜ-cong-≡ (TP.select-remove i t)) ⟩ lookup t i + sumₜ (replicate {n = n} 0#) ≈⟨ +-congˡ (sumₜ-zero n) ⟩ lookup t i + 0# ≈⟨ +-identityʳ _ ⟩ lookup t i ∎ -- Converting to a table then summing is the same as summing the original list sumₜ-fromList : ∀ xs → sumₜ (fromList xs) ≡ sumₗ xs sumₜ-fromList [] = P.refl sumₜ-fromList (x ∷ xs) = P.cong (_ +_) (sumₜ-fromList xs) -- Converting to a list then summing is the same as summing the original table sumₜ-toList : ∀ {n} (t : Table Carrier n) → sumₜ t ≡ sumₗ (toList t) sumₜ-toList {zero} _ = P.refl sumₜ-toList {suc n} _ = P.cong (_ +_) (sumₜ-toList {n} _) agda-stdlib-1.1/src/Algebra/Properties/DistributiveLattice.agda000066400000000000000000000111101350553555600246150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Properties.DistributiveLattice {dl₁ dl₂} (DL : DistributiveLattice dl₁ dl₂) where open DistributiveLattice DL import Algebra.Properties.Lattice as LatticeProperties open import Algebra.Structures open import Algebra.FunctionProperties _≈_ open import Relation.Binary open import Relation.Binary.Reasoning.Setoid setoid open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product using (_,_) ------------------------------------------------------------------------ -- Export properties of lattices open LatticeProperties lattice public hiding (replace-equality) ------------------------------------------------------------------------ -- Other properties ∨-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) ≈⟨ ∧-congʳ $ sym (∧-absorbs-∨ _ _) ⟩ (x ∧ (x ∨ y)) ∧ (y ∨ z) ≈⟨ ∧-congʳ $ ∧-congˡ $ ∨-comm _ _ ⟩ (x ∧ (y ∨ x)) ∧ (y ∨ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ ((y ∨ x) ∧ (y ∨ z)) ≈⟨ ∧-congˡ $ sym (∨-distribˡ-∧ _ _ _) ⟩ x ∧ (y ∨ x ∧ z) ≈⟨ ∧-congʳ $ sym (∨-absorbs-∧ _ _) ⟩ (x ∨ x ∧ z) ∧ (y ∨ x ∧ z) ≈⟨ sym $ ∨-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ʳ-∧ = ∧-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 (LatticeProperties.replace-equality lattice ≈⇔≈′) ; ∨-distribʳ-∧ = λ x y z → to ⟨$⟩ ∨-distribʳ-∧ x y z } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 ∨-∧-distribˡ = ∨-distribˡ-∧ {-# WARNING_ON_USAGE ∨-∧-distribˡ "Warning: ∨-∧-distribˡ was deprecated in v1.1. Please use ∨-distribˡ-∧ instead." #-} ∨-∧-distrib = ∨-distrib-∧ {-# WARNING_ON_USAGE ∨-∧-distrib "Warning: ∨-∧-distrib was deprecated in v1.1. Please use ∨-distrib-∧ instead." #-} ∧-∨-distribˡ = ∧-distribˡ-∨ {-# WARNING_ON_USAGE ∧-∨-distribˡ "Warning: ∧-∨-distribˡ was deprecated in v1.1. Please use ∧-distribˡ-∨ instead." #-} ∧-∨-distribʳ = ∧-distribʳ-∨ {-# WARNING_ON_USAGE ∧-∨-distribʳ "Warning: ∧-∨-distribʳ was deprecated in v1.1. Please use ∧-distribʳ-∨ instead." #-} ∧-∨-distrib = ∧-distrib-∨ {-# WARNING_ON_USAGE ∧-∨-distrib "Warning: ∧-∨-distrib was deprecated in v1.1. Please use ∧-distrib-∨ instead." #-} agda-stdlib-1.1/src/Algebra/Properties/Group.agda000066400000000000000000000113531350553555600217370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Properties.Group {g₁ g₂} (G : Group g₁ g₂) where open Group G open import Algebra.FunctionProperties _≈_ open import Relation.Binary.Reasoning.Setoid setoid open import Function open import Data.Product ε⁻¹≈ε : ε ⁻¹ ≈ ε ε⁻¹≈ε = begin ε ⁻¹ ≈⟨ sym $ identityʳ (ε ⁻¹) ⟩ ε ⁻¹ ∙ ε ≈⟨ inverseˡ ε ⟩ ε ∎ ∙-cancelˡ : LeftCancellative _∙_ ∙-cancelˡ x {y} {z} eq = begin y ≈⟨ sym $ identityˡ y ⟩ ε ∙ y ≈⟨ sym $ ∙-congʳ $ inverseˡ x ⟩ (x ⁻¹ ∙ x) ∙ y ≈⟨ assoc (x ⁻¹) x y ⟩ x ⁻¹ ∙ (x ∙ y) ≈⟨ ∙-congˡ eq ⟩ x ⁻¹ ∙ (x ∙ z) ≈⟨ sym $ assoc (x ⁻¹) x z ⟩ (x ⁻¹ ∙ x) ∙ z ≈⟨ ∙-congʳ $ inverseˡ x ⟩ ε ∙ z ≈⟨ identityˡ z ⟩ z ∎ ∙-cancelʳ : RightCancellative _∙_ ∙-cancelʳ {x} y z eq = begin y ≈⟨ sym $ identityʳ y ⟩ y ∙ ε ≈⟨ sym $ ∙-congˡ $ inverseʳ x ⟩ y ∙ (x ∙ x ⁻¹) ≈⟨ sym $ assoc y x (x ⁻¹) ⟩ (y ∙ x) ∙ x ⁻¹ ≈⟨ ∙-congʳ eq ⟩ (z ∙ x) ∙ x ⁻¹ ≈⟨ assoc z x (x ⁻¹) ⟩ z ∙ (x ∙ x ⁻¹) ≈⟨ ∙-congˡ $ inverseʳ x ⟩ z ∙ ε ≈⟨ identityʳ z ⟩ z ∎ ∙-cancel : Cancellative _∙_ ∙-cancel = ∙-cancelˡ , ∙-cancelʳ ⁻¹-involutive : ∀ x → x ⁻¹ ⁻¹ ≈ x ⁻¹-involutive x = begin x ⁻¹ ⁻¹ ≈⟨ sym $ identityʳ _ ⟩ x ⁻¹ ⁻¹ ∙ ε ≈⟨ ∙-congˡ $ sym (inverseˡ _) ⟩ x ⁻¹ ⁻¹ ∙ (x ⁻¹ ∙ x) ≈⟨ sym $ assoc _ _ _ ⟩ x ⁻¹ ⁻¹ ∙ x ⁻¹ ∙ x ≈⟨ ∙-congʳ $ inverseˡ _ ⟩ ε ∙ x ≈⟨ identityˡ _ ⟩ x ∎ private left-helper : ∀ x y → x ≈ (x ∙ y) ∙ y ⁻¹ left-helper x y = begin x ≈⟨ sym (identityʳ x) ⟩ x ∙ ε ≈⟨ ∙-congˡ $ sym (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 (identityˡ y) ⟩ ε ∙ y ≈⟨ ∙-congʳ $ sym (inverseˡ x) ⟩ (x ⁻¹ ∙ x) ∙ y ≈⟨ assoc (x ⁻¹) x y ⟩ x ⁻¹ ∙ (x ∙ y) ∎ identityˡ-unique : ∀ x y → x ∙ y ≈ y → x ≈ ε identityˡ-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y ⁻¹ ≈⟨ ∙-congʳ eq ⟩ y ∙ y ⁻¹ ≈⟨ inverseʳ y ⟩ ε ∎ identityʳ-unique : ∀ x y → x ∙ y ≈ x → y ≈ ε identityʳ-unique x y eq = begin y ≈⟨ right-helper x y ⟩ x ⁻¹ ∙ (x ∙ y) ≈⟨ refl ⟨ ∙-cong ⟩ eq ⟩ x ⁻¹ ∙ x ≈⟨ inverseˡ x ⟩ ε ∎ identity-unique : ∀ {x} → Identity x _∙_ → x ≈ ε identity-unique {x} id = identityˡ-unique x x (proj₂ id x) inverseˡ-unique : ∀ x y → x ∙ y ≈ ε → x ≈ y ⁻¹ inverseˡ-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y ⁻¹ ≈⟨ ∙-congʳ eq ⟩ ε ∙ y ⁻¹ ≈⟨ identityˡ (y ⁻¹) ⟩ y ⁻¹ ∎ inverseʳ-unique : ∀ x y → x ∙ y ≈ ε → y ≈ x ⁻¹ inverseʳ-unique x y eq = begin y ≈⟨ sym (⁻¹-involutive y) ⟩ y ⁻¹ ⁻¹ ≈⟨ ⁻¹-cong (sym (inverseˡ-unique x y eq)) ⟩ x ⁻¹ ∎ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 left-identity-unique = identityˡ-unique {-# WARNING_ON_USAGE left-identity-unique "Warning: left-identity-unique was deprecated in v1.1. Please use identityˡ-unique instead." #-} right-identity-unique = identityʳ-unique {-# WARNING_ON_USAGE right-identity-unique "Warning: right-identity-unique was deprecated in v1.1. Please use identityʳ-unique instead." #-} left-inverse-unique = inverseˡ-unique {-# WARNING_ON_USAGE left-inverse-unique "Warning: left-inverse-unique was deprecated in v1.1. Please use inverseˡ-unique instead." #-} right-inverse-unique = inverseʳ-unique {-# WARNING_ON_USAGE right-inverse-unique "Warning: right-inverse-unique was deprecated in v1.1. Please use inverseʳ-unique instead." #-} agda-stdlib-1.1/src/Algebra/Properties/Lattice.agda000066400000000000000000000166171350553555600222400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Properties.Lattice {l₁ l₂} (L : Lattice l₁ l₂) where open Lattice L open import Algebra.Structures _≈_ open import Algebra.FunctionProperties _≈_ import Algebra.Properties.Semilattice as SemilatticeProperties open import Relation.Binary import Relation.Binary.Lattice as R open import Relation.Binary.Reasoning.Setoid setoid open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product using (_,_; swap) ------------------------------------------------------------------------ -- _∧_ is a semilattice ∧-idem : Idempotent _∧_ ∧-idem x = begin x ∧ x ≈⟨ ∧-congˡ (sym (∨-absorbs-∧ _ _)) ⟩ x ∧ (x ∨ x ∧ x) ≈⟨ ∧-absorbs-∨ _ _ ⟩ x ∎ ∧-isMagma : IsMagma _∧_ ∧-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = ∧-cong } ∧-isSemigroup : IsSemigroup _∧_ ∧-isSemigroup = record { isMagma = ∧-isMagma ; assoc = ∧-assoc } ∧-isBand : IsBand _∧_ ∧-isBand = record { isSemigroup = ∧-isSemigroup ; idem = ∧-idem } ∧-isSemilattice : IsSemilattice _∧_ ∧-isSemilattice = record { isBand = ∧-isBand ; comm = ∧-comm } ∧-semilattice : Semilattice l₁ l₂ ∧-semilattice = record { isSemilattice = ∧-isSemilattice } open SemilatticeProperties ∧-semilattice public using ( ∧-isOrderTheoreticMeetSemilattice ; ∧-isOrderTheoreticJoinSemilattice ; ∧-orderTheoreticMeetSemilattice ; ∧-orderTheoreticJoinSemilattice ) ------------------------------------------------------------------------ -- _∨_ is a semilattice ∨-idem : Idempotent _∨_ ∨-idem x = begin x ∨ x ≈⟨ ∨-congˡ (sym (∧-idem _)) ⟩ x ∨ x ∧ x ≈⟨ ∨-absorbs-∧ _ _ ⟩ x ∎ ∨-isMagma : IsMagma _∨_ ∨-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = ∨-cong } ∨-isSemigroup : IsSemigroup _∨_ ∨-isSemigroup = record { isMagma = ∨-isMagma ; assoc = ∨-assoc } ∨-isBand : IsBand _∨_ ∨-isBand = record { isSemigroup = ∨-isSemigroup ; idem = ∨-idem } ∨-isSemilattice : IsSemilattice _∨_ ∨-isSemilattice = record { isBand = ∨-isBand ; comm = ∨-comm } ∨-semilattice : Semilattice l₁ l₂ ∨-semilattice = record { isSemilattice = ∨-isSemilattice } open SemilatticeProperties ∨-semilattice public using () renaming ( ∧-isOrderTheoreticMeetSemilattice to ∨-isOrderTheoreticMeetSemilattice ; ∧-isOrderTheoreticJoinSemilattice to ∨-isOrderTheoreticJoinSemilattice ; ∧-orderTheoreticMeetSemilattice to ∨-orderTheoreticMeetSemilattice ; ∧-orderTheoreticJoinSemilattice to ∨-orderTheoreticJoinSemilattice ) ------------------------------------------------------------------------ -- 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 algebraic lattice can be turned into an order-theoretic one. open SemilatticeProperties ∧-semilattice public using (poset) open Poset poset using (_≤_; isPartialOrder) ∨-∧-isOrderTheoreticLattice : R.IsLattice _≈_ _≤_ _∨_ _∧_ ∨-∧-isOrderTheoreticLattice = record { isPartialOrder = isPartialOrder ; supremum = supremum ; infimum = infimum } where open R.MeetSemilattice ∧-orderTheoreticMeetSemilattice using (infimum) open R.JoinSemilattice ∨-orderTheoreticJoinSemilattice using (x≤x∨y; y≤x∨y; ∨-least) renaming (_≤_ to _≤′_) -- An alternative but equivalent interpretation of the order _≤_. sound : ∀ {x y} → x ≤′ y → x ≤ y sound {x} {y} y≈y∨x = sym $ begin x ∧ y ≈⟨ ∧-congˡ y≈y∨x ⟩ x ∧ (y ∨ x) ≈⟨ ∧-congˡ (∨-comm y x) ⟩ x ∧ (x ∨ y) ≈⟨ ∧-absorbs-∨ x y ⟩ x ∎ complete : ∀ {x y} → x ≤ y → x ≤′ y complete {x} {y} x≈x∧y = sym $ begin y ∨ x ≈⟨ ∨-congˡ x≈x∧y ⟩ y ∨ (x ∧ y) ≈⟨ ∨-congˡ (∧-comm x y) ⟩ y ∨ (y ∧ x) ≈⟨ ∨-absorbs-∧ y x ⟩ y ∎ supremum : R.Supremum _≤_ _∨_ supremum x y = sound (x≤x∨y x y) , sound (y≤x∨y x y) , λ z x≤z y≤z → sound (∨-least (complete x≤z) (complete y≤z)) ∨-∧-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 ⟨$⟩ ∨-absorbs-∧ x y) , (λ x y → to ⟨$⟩ ∧-absorbs-∨ x y) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 ∧-idempotent = ∧-idem {-# WARNING_ON_USAGE ∧-idempotent "Warning: ∧-idempotent was deprecated in v1.1. Please use ∧-idem instead." #-} ∨-idempotent = ∨-idem {-# WARNING_ON_USAGE ∨-idempotent "Warning: ∨-idempotent was deprecated in v1.1. Please use ∨-idem instead." #-} isOrderTheoreticLattice = ∨-∧-isOrderTheoreticLattice {-# WARNING_ON_USAGE isOrderTheoreticLattice "Warning: isOrderTheoreticLattice was deprecated in v1.1. Please use ∨-∧-isOrderTheoreticLattice instead." #-} orderTheoreticLattice = ∨-∧-orderTheoreticLattice {-# WARNING_ON_USAGE orderTheoreticLattice "Warning: orderTheoreticLattice was deprecated in v1.1. Please use ∨-∧-orderTheoreticLattice instead." #-} agda-stdlib-1.1/src/Algebra/Properties/Ring.agda000066400000000000000000000067411350553555600215470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some basic properties of Rings ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Properties.Ring {r₁ r₂} (R : Ring r₁ r₂) where open Ring R import Algebra.Properties.AbelianGroup as AbelianGroupProperties open import Function using (_$_) open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Export properties of abelian groups open AbelianGroupProperties +-abelianGroup public renaming ( ε⁻¹≈ε to -0#≈0# ; ∙-cancelˡ to +-cancelˡ ; ∙-cancelʳ to +-cancelʳ ; ∙-cancel to +-cancel ; ⁻¹-involutive to -‿involutive ; identityˡ-unique to +-identityˡ-unique ; identityʳ-unique to +-identityʳ-unique ; identity-unique to +-identity-unique ; inverseˡ-unique to +-inverseˡ-unique ; inverseʳ-unique to +-inverseʳ-unique ; ⁻¹-∙-comm to -‿+-comm -- DEPRECATED ; left-identity-unique to +-left-identity-unique ; right-identity-unique to +-right-identity-unique ; left-inverse-unique to +-left-inverse-unique ; right-inverse-unique to +-right-inverse-unique ) ------------------------------------------------------------------------ -- Ring properties -‿distribˡ-* : ∀ x y → - (x * y) ≈ - x * y -‿distribˡ-* x y = sym $ begin - x * y ≈⟨ sym $ +-identityʳ _ ⟩ - x * y + 0# ≈⟨ +-congˡ $ sym (-‿inverseʳ _) ⟩ - x * y + (x * y + - (x * y)) ≈⟨ sym $ +-assoc _ _ _ ⟩ - x * y + x * y + - (x * y) ≈⟨ +-congʳ $ sym (distribʳ _ _ _) ⟩ (- x + x) * y + - (x * y) ≈⟨ +-congʳ $ *-congʳ $ -‿inverseˡ _ ⟩ 0# * y + - (x * y) ≈⟨ +-congʳ $ zeroˡ _ ⟩ 0# + - (x * y) ≈⟨ +-identityˡ _ ⟩ - (x * y) ∎ -‿distribʳ-* : ∀ x y → - (x * y) ≈ x * - y -‿distribʳ-* x y = sym $ begin x * - y ≈⟨ sym $ +-identityˡ _ ⟩ 0# + x * - y ≈⟨ +-congʳ $ sym (-‿inverseˡ _) ⟩ - (x * y) + x * y + x * - y ≈⟨ +-assoc _ _ _ ⟩ - (x * y) + (x * y + x * - y) ≈⟨ +-congˡ $ sym (distribˡ _ _ _) ⟩ - (x * y) + x * (y + - y) ≈⟨ +-congˡ $ *-congˡ $ -‿inverseʳ _ ⟩ - (x * y) + x * 0# ≈⟨ +-congˡ $ zeroʳ _ ⟩ - (x * y) + 0# ≈⟨ +-identityʳ _ ⟩ - (x * y) ∎ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 -‿*-distribˡ : ∀ x y → - x * y ≈ - (x * y) -‿*-distribˡ x y = sym (-‿distribˡ-* x y) {-# WARNING_ON_USAGE -‿*-distribˡ "Warning: -‿*-distribˡ was deprecated in v1.1. Please use -‿distribˡ-* instead. NOTE: the equality is flipped so you will need sym (-‿distribˡ-* ...)." #-} -‿*-distribʳ : ∀ x y → x * - y ≈ - (x * y) -‿*-distribʳ x y = sym (-‿distribʳ-* x y) {-# WARNING_ON_USAGE -‿*-distribʳ "Warning: -‿*-distribʳ was deprecated in v1.1. Please use -‿distribʳ-* instead. NOTE: the equality is flipped so you will need sym (-‿distribʳ-* ...)." #-} agda-stdlib-1.1/src/Algebra/Properties/Semilattice.agda000066400000000000000000000062011350553555600231020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Properties.Semilattice {c ℓ} (L : Semilattice c ℓ) where open Semilattice L open import Algebra.Structures open import Function open import Data.Product open import Relation.Binary import Relation.Binary.Construct.NaturalOrder.Left _≈_ _∧_ as LeftNaturalOrder open import Relation.Binary.Lattice import Relation.Binary.Properties.Poset as R open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Every semilattice can be turned into a poset via the left natural -- order. poset : Poset c ℓ ℓ poset = LeftNaturalOrder.poset isSemilattice open Poset poset using (_≤_; isPartialOrder) ------------------------------------------------------------------------ -- Every algebraic semilattice can be turned into an order-theoretic one. ∧-isOrderTheoreticMeetSemilattice : IsMeetSemilattice _≈_ _≤_ _∧_ ∧-isOrderTheoreticMeetSemilattice = record { isPartialOrder = isPartialOrder ; infimum = LeftNaturalOrder.infimum isSemilattice } ∧-isOrderTheoreticJoinSemilattice : IsJoinSemilattice _≈_ (flip _≤_) _∧_ ∧-isOrderTheoreticJoinSemilattice = record { isPartialOrder = R.invIsPartialOrder poset ; supremum = IsMeetSemilattice.infimum ∧-isOrderTheoreticMeetSemilattice } ∧-orderTheoreticMeetSemilattice : MeetSemilattice c ℓ ℓ ∧-orderTheoreticMeetSemilattice = record { isMeetSemilattice = ∧-isOrderTheoreticMeetSemilattice } ∧-orderTheoreticJoinSemilattice : JoinSemilattice c ℓ ℓ ∧-orderTheoreticJoinSemilattice = record { isJoinSemilattice = ∧-isOrderTheoreticJoinSemilattice } ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 isOrderTheoreticMeetSemilattice = ∧-isOrderTheoreticMeetSemilattice {-# WARNING_ON_USAGE isOrderTheoreticMeetSemilattice "Warning: isOrderTheoreticMeetSemilattice was deprecated in v1.1. Please use ∧-isOrderTheoreticMeetSemilattice instead." #-} isOrderTheoreticJoinSemilattice = ∧-isOrderTheoreticJoinSemilattice {-# WARNING_ON_USAGE isOrderTheoreticJoinSemilattice "Warning: isOrderTheoreticJoinSemilattice was deprecated in v1.1. Please use ∧-isOrderTheoreticJoinSemilattice instead." #-} orderTheoreticMeetSemilattice = ∧-orderTheoreticMeetSemilattice {-# WARNING_ON_USAGE orderTheoreticMeetSemilattice "Warning: orderTheoreticMeetSemilattice was deprecated in v1.1. Please use ∧-orderTheoreticMeetSemilattice instead." #-} orderTheoreticJoinSemilattice = ∧-orderTheoreticJoinSemilattice {-# WARNING_ON_USAGE orderTheoreticJoinSemilattice "Warning: orderTheoreticJoinSemilattice was deprecated in v1.1. Please use ∧-orderTheoreticJoinSemilattice instead." #-} agda-stdlib-1.1/src/Algebra/Solver/000077500000000000000000000000001350553555600171405ustar00rootroot00000000000000agda-stdlib-1.1/src/Algebra/Solver/CommutativeMonoid.agda000066400000000000000000000146701350553555600234310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for equations in commutative monoids -- -- Adapted from Algebra.Solver.Monoid ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Solver.CommutativeMonoid {m₁ m₂} (M : CommutativeMonoid m₁ m₂) where 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 as ℕ using (ℕ; zero; suc; _+_) open import Data.Nat.GeneralisedArithmetic using (fold) open import Data.Product using (_×_; uncurry) open import Data.Vec using (Vec; []; _∷_; lookup; replicate) open import Function using (_∘_) import Relation.Binary.Reasoning.Setoid as EqReasoning import Relation.Binary.Reflection as Reflection import Relation.Nullary.Decidable as Dec import Data.Vec.Relation.Binary.Pointwise.Inductive as Pointwise open import Relation.Binary.PropositionalEquality as P using (_≡_; decSetoid) open import Relation.Nullary using (Dec) 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ˡ (empty-correct ρ) ⟩ x ∙ ε ≈⟨ 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 (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 _ _) ⟩ (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ˡ (lemma zero m p)) (flip12 _ _ _) lemma (suc l) m p = trans (∙-congˡ (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 (prove′ e₁ e₂) prove _ e₁ e₂ = from-just (prove′ e₁ e₂) -- prove : ∀ n (es : Expr n × Expr n) → -- From-just (uncurry prove′ es) -- prove _ = from-just ∘ uncurry prove′ agda-stdlib-1.1/src/Algebra/Solver/CommutativeMonoid/000077500000000000000000000000001350553555600226035ustar00rootroot00000000000000agda-stdlib-1.1/src/Algebra/Solver/CommutativeMonoid/Example.agda000066400000000000000000000016231350553555600250160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how Algebra.CommutativeMonoidSolver can be used ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Algebra.Solver.CommutativeMonoid.Example where open import Relation.Binary.PropositionalEquality using (_≡_) open import Data.Bool.Base using (_∨_) open import Data.Bool.Properties using (∨-commutativeMonoid) open import Data.Fin using (zero; suc) open import Data.Vec using ([]; _∷_) open import Algebra.Solver.CommutativeMonoid ∨-commutativeMonoid 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-1.1/src/Algebra/Solver/IdempotentCommutativeMonoid.agda000066400000000000000000000160261350553555600254570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for equations in commutative monoids -- -- Adapted from Algebra.Monoid-solver ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra open import Data.Bool 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 (_×_; uncurry) open import Data.Vec using (Vec; []; _∷_; lookup; replicate) open import Function using (_∘_) import Relation.Binary.Reasoning.Setoid as EqReasoning import Relation.Binary.Reflection as Reflection import Relation.Nullary.Decidable as Dec import Data.Vec.Relation.Binary.Pointwise.Inductive as Pointwise open import Relation.Binary.PropositionalEquality as P using (_≡_; decSetoid) open import Relation.Nullary using (Dec) module Algebra.Solver.IdempotentCommutativeMonoid {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ˡ (empty-correct ρ) ⟩ x ∙ ε ≈⟨ 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 _ _) ⟩ (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ˡ (sym (assoc _ _ _)) ⟩ a ∙ ((a ∙ b) ∙ c) ≈⟨ ∙-congˡ (∙-congʳ (comm _ _)) ⟩ a ∙ ((b ∙ a) ∙ c) ≈⟨ ∙-congˡ (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 (identityˡ _) comp-correct (true ∷ v) (true ∷ w) (a ∷ ρ) = trans (∙-congˡ (comp-correct v w ρ)) (distr _ _ _) comp-correct (true ∷ v) (false ∷ w) (a ∷ ρ) = trans (∙-congˡ (comp-correct v w ρ)) (sym (assoc _ _ _)) comp-correct (false ∷ v) (true ∷ w) (a ∷ ρ) = trans (∙-congˡ (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 (prove′ e₁ e₂) prove _ e₁ e₂ = from-just (prove′ e₁ e₂) -- prove : ∀ n (es : Expr n × Expr n) → -- From-just (uncurry prove′ es) -- prove _ = from-just ∘ uncurry prove′ -- -} agda-stdlib-1.1/src/Algebra/Solver/IdempotentCommutativeMonoid/000077500000000000000000000000001350553555600246345ustar00rootroot00000000000000agda-stdlib-1.1/src/Algebra/Solver/IdempotentCommutativeMonoid/Example.agda000066400000000000000000000016721350553555600270530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how Algebra.IdempotentCommutativeMonoidSolver can be -- used ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Algebra.Solver.IdempotentCommutativeMonoid.Example where open import Relation.Binary.PropositionalEquality using (_≡_) open import Data.Bool.Base using (_∨_) open import Data.Bool.Properties using (∨-idempotentCommutativeMonoid) open import Data.Fin using (zero; suc) open import Data.Vec using ([]; _∷_) open import Algebra.Solver.IdempotentCommutativeMonoid ∨-idempotentCommutativeMonoid 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-1.1/src/Algebra/Solver/Monoid.agda000066400000000000000000000113621350553555600212060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for monoid equalities ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Solver.Monoid {m₁ m₂} (M : Monoid m₁ m₂) where open import Data.Fin as Fin hiding (_≟_) import Data.Fin.Properties as Fin open import Data.List.Base hiding (lookup) import Data.List.Relation.Binary.Equality.DecPropositional as ListEq 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 (_∘_; _$_) open import Relation.Binary using (Decidable) 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 import Relation.Binary.Reasoning.Setoid 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 $ identityˡ _ ⟩ ε ∙ ⟦ nf₂ ⟧⇓ ρ ∎ homomorphic (x ∷ nf₁) nf₂ ρ = begin lookup ρ x ∙ ⟦ nf₁ ++ nf₂ ⟧⇓ ρ ≈⟨ ∙-congˡ (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 ∙ ε ≈⟨ 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} → Decidable {A = Normal n} _≡_ nf₁ ≟ nf₂ = Dec.map′ ≋⇒≡ ≡⇒≋ (nf₁ ≋? nf₂) where open ListEq Fin._≟_ -- 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 (uncurry prove′ es) prove _ = from-just ∘ uncurry prove′ agda-stdlib-1.1/src/Algebra/Solver/Ring.agda000066400000000000000000000550601350553555600206630ustar00rootroot00000000000000------------------------------------------------------------------------ -- 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). -- -- At first the `WeaklyDecidable` type may at first glance look useless -- as there is no guarantee that it doesn't always return `nothing`. -- However the implementation of it affects the power of the solver. The -- more equalities it returns, the more expressions the ring solver can -- solve. {-# OPTIONS --without-K --safe #-} open import Algebra open import Algebra.Solver.Ring.AlmostCommutativeRing open import Relation.Binary.Core using (WeaklyDecidable) module Algebra.Solver.Ring {r₁ r₂ r₃} (Coeff : RawRing r₁) -- Coefficient "ring". (R : AlmostCommutativeRing r₂ r₃) -- Main "ring". (morphism : Coeff -Raw-AlmostCommutative⟶ R) (_coeff≟_ : WeaklyDecidable (Induced-equivalence morphism)) where open import Algebra.Solver.Ring.Lemmas Coeff R morphism private module C = RawRing Coeff open AlmostCommutativeRing R renaming (zero to *-zero; zeroˡ to *-zeroˡ; zeroʳ to *-zeroʳ) open import Algebra.FunctionProperties _≈_ open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism renaming (⟦_⟧ to ⟦_⟧′) open import Algebra.Operations.Semiring semiring open import Relation.Binary open import Relation.Nullary using (yes; no) open import Relation.Binary.Reasoning.Setoid setoid import Relation.Binary.PropositionalEquality as PropEq import Relation.Binary.Reflection as Reflection open import Data.Nat.Base using (ℕ; suc; zero) open import Data.Fin using (Fin; zero; suc) open import Data.Vec using (Vec; []; _∷_; lookup) open import Data.Maybe.Base using (just; nothing) 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 _:×_ : ∀ {n} → ℕ → Polynomial n → Polynomial n zero :× p = con C.0# suc m :× p = p :+ m :× p -- 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 weakly decidable. _≟H_ : ∀ {n} → WeaklyDecidable (_≈H_ {n = n}) ∅ ≟H ∅ = just ∅ ∅ ≟H (_ *x+ _) = nothing (_ *x+ _) ≟H ∅ = nothing (p₁ *x+ c₁) ≟H (p₂ *x+ c₂) with p₁ ≟H p₂ | c₁ ≟N c₂ ... | just p₁≈p₂ | just c₁≈c₂ = just (p₁≈p₂ *x+ c₁≈c₂) ... | _ | nothing = nothing ... | nothing | _ = nothing _≟N_ : ∀ {n} → WeaklyDecidable (_≈N_ {n = n}) con c₁ ≟N con c₂ with c₁ coeff≟ c₂ ... | just c₁≈c₂ = just (con c₁≈c₂) ... | nothing = nothing poly p₁ ≟N poly p₂ with p₁ ≟H p₂ ... | just p₁≈p₂ = just (poly p₁≈p₂) ... | nothing = nothing 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 ... | just c≈0 = ∅ ... | nothing = ∅ *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 ... | just c≈0 = ∅ ... | nothing = (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 ... | just c≈0 = ∅ ... | nothing = (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 ... | just c≈0 = begin 0# ≈⟨ 0≈⟦0⟧ c≈0 ρ ⟩ ⟦ c ⟧N ρ ≈⟨ sym $ lemma₆ _ _ ⟩ 0# * x + ⟦ c ⟧N ρ ∎ ... | nothing = 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 ... | just c≈0 = 0≈⟦0⟧ c≈0 ρ ... | nothing = lemma₆ _ _ mutual +H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) → ∀ ρ → ⟦ p₁ +H p₂ ⟧H ρ ≈ ⟦ p₁ ⟧H ρ + ⟦ p₂ ⟧H ρ +H-homo ∅ p₂ ρ = sym (+-identityˡ _) +H-homo (p₁ *x+ x₁) ∅ ρ = sym (+-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 (*-zeroʳ _) *NH-homo c (p *x+ c′) x ρ with c ≟N 0N ... | just c≈0 = begin 0# ≈⟨ sym (*-zeroˡ _) ⟩ 0# * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ≈⟨ 0≈⟦0⟧ c≈0 ρ ⟨ *-cong ⟩ refl ⟩ ⟦ c ⟧N ρ * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ∎ ... | nothing = 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 (*-zeroˡ _) *HN-homo (p *x+ c′) c x ρ with c ≟N 0N ... | just c≈0 = begin 0# ≈⟨ sym (*-zeroʳ _) ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * 0# ≈⟨ refl ⟨ *-cong ⟩ 0≈⟦0⟧ c≈0 ρ ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * ⟦ c ⟧N ρ ∎ ... | nothing = 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 $ *-zeroˡ _ *H-homo (p₁ *x+ c₁) ∅ ρ = sym $ *-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 (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-1.1/src/Algebra/Solver/Ring/000077500000000000000000000000001350553555600200375ustar00rootroot00000000000000agda-stdlib-1.1/src/Algebra/Solver/Ring/AlmostCommutativeRing.agda000066400000000000000000000114651350553555600251610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Commutative semirings with some additional structure ("almost" -- commutative rings), used by the ring solver ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Algebra.Solver.Ring.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 ( +-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-1.1/src/Algebra/Solver/Ring/Lemmas.agda000066400000000000000000000112541350553555600220760ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some boring lemmas used by the ring solver ------------------------------------------------------------------------ -- Note that these proofs use all "almost commutative ring" properties. {-# OPTIONS --without-K --safe #-} open import Algebra open import Algebra.Solver.Ring.AlmostCommutativeRing module Algebra.Solver.Ring.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 open import Relation.Binary.Reasoning.Setoid setoid open import Function lemma₀ : ∀ a b c x → (a + b) * x + c ≈ a * x + (b * x + c) lemma₀ a b c x = begin (a + b) * x + c ≈⟨ 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 $ 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 $ 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 ≈⟨ 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 $ distribˡ _ _ _ ⟨ +-cong ⟩ distribˡ _ _ _ ⟩ a * x * (c * x + d) + b * (c * x + d) ≈⟨ sym $ 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 ≈⟨ 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# ≈⟨ (+-identityˡ _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ 1# * x + 0# ≈⟨ +-identityʳ _ ⟩ 1# * x ≈⟨ *-identityˡ _ ⟩ x ∎ lemma₆ : ∀ a x → 0# * x + a ≈ a lemma₆ a x = begin 0# * x + a ≈⟨ zeroˡ _ ⟨ +-cong ⟩ refl ⟩ 0# + a ≈⟨ +-identityˡ _ ⟩ a ∎ lemma₇ : ∀ x → - 1# * x ≈ - x lemma₇ x = begin - 1# * x ≈⟨ -‿*-distribˡ _ _ ⟩ - (1# * x) ≈⟨ -‿cong (*-identityˡ _) ⟩ - x ∎ agda-stdlib-1.1/src/Algebra/Solver/Ring/NaturalCoefficients.agda000066400000000000000000000041401350553555600246040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver, using the natural numbers as the -- coefficient "ring" ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra import Algebra.Operations.Semiring as SemiringOps open import Data.Maybe.Base using (Maybe; just; nothing; map) module Algebra.Solver.Ring.NaturalCoefficients {r₁ r₂} (R : CommutativeSemiring r₁ r₂) (dec : let open CommutativeSemiring R open SemiringOps semiring in ∀ m n → Maybe (m × 1# ≈ n × 1#)) where import Algebra.Solver.Ring open import Algebra.Solver.Ring.AlmostCommutativeRing open import Data.Nat.Base as ℕ open import Data.Product using (module Σ) open import Function open CommutativeSemiring R open SemiringOps semiring open import Relation.Binary.Reasoning.Setoid 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 → Maybe (m ×′ 1# ≈ n ×′ 1#) dec′ m n = map to (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# ∎ -- The instantiation. open Algebra.Solver.Ring _ _ homomorphism dec′ public agda-stdlib-1.1/src/Algebra/Solver/Ring/NaturalCoefficients/000077500000000000000000000000001350553555600237675ustar00rootroot00000000000000agda-stdlib-1.1/src/Algebra/Solver/Ring/NaturalCoefficients/Default.agda000066400000000000000000000021421350553555600261700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the natural coefficients ring solver, using coefficient -- equality induced by ℕ. -- -- This is sufficient for proving equalities that are independent of the -- characteristic. In particular, this is enough for equalities in rings of -- characteristic 0. ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra module Algebra.Solver.Ring.NaturalCoefficients.Default {r₁ r₂} (R : CommutativeSemiring r₁ r₂) where import Algebra.Operations.Semiring as SemiringOps open import Data.Maybe.Base using (Maybe; map) open import Data.Nat using (_≟_) open import Relation.Binary.Consequences using (dec⟶weaklyDec) import Relation.Binary.PropositionalEquality as P open CommutativeSemiring R open SemiringOps semiring private dec : ∀ m n → Maybe (m × 1# ≈ n × 1#) dec m n = map (λ { P.refl → refl }) (dec⟶weaklyDec _≟_ m n) open import Algebra.Solver.Ring.NaturalCoefficients R dec public agda-stdlib-1.1/src/Algebra/Solver/Ring/Simple.agda000066400000000000000000000013761350553555600221150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver with two copies of the same ring with -- decidable equality ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Algebra.Solver.Ring.AlmostCommutativeRing open import Relation.Binary open import Relation.Binary.Consequences using (dec⟶weaklyDec) module Algebra.Solver.Ring.Simple {r₁ r₂} (R : AlmostCommutativeRing r₁ r₂) (_≟_ : Decidable (AlmostCommutativeRing._≈_ R)) where open AlmostCommutativeRing R import Algebra.Solver.Ring as RS open RS rawRing R (-raw-almostCommutative⟶ R) (dec⟶weaklyDec _≟_) public agda-stdlib-1.1/src/Algebra/Structures.agda000066400000000000000000000402611350553555600206720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some algebraic structures (not packed up with sets, operations, -- etc.) ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Relation.Binary using (Rel; Setoid; IsEquivalence) module Algebra.Structures {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) where -- All the structures are parameterised by the equivalence relation _≈_. -- The file is divided into sections depending on the arities of the -- components of the algebraic structure. open import Algebra.FunctionProperties _≈_ import Algebra.FunctionProperties.Consequences as Consequences open import Data.Product using (_,_; proj₁; proj₂) open import Level using (_⊔_) ------------------------------------------------------------------------ -- Structures with 1 binary operation ------------------------------------------------------------------------ record IsMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isEquivalence : IsEquivalence _≈_ ∙-cong : Congruent₂ ∙ open IsEquivalence isEquivalence public setoid : Setoid a ℓ setoid = record { isEquivalence = isEquivalence } ∙-congˡ : LeftCongruent ∙ ∙-congˡ y≈z = ∙-cong refl y≈z ∙-congʳ : RightCongruent ∙ ∙-congʳ y≈z = ∙-cong y≈z refl record IsSemigroup (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isMagma : IsMagma ∙ assoc : Associative ∙ open IsMagma isMagma public record IsBand (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ idem : Idempotent ∙ open IsSemigroup isSemigroup public record IsSemilattice (∧ : Op₂ A) : Set (a ⊔ ℓ) where field isBand : IsBand ∧ comm : Commutative ∧ open IsBand isBand public renaming (∙-cong to ∧-cong; ∙-congˡ to ∧-congˡ; ∙-congʳ to ∧-congʳ) record IsSelectiveMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isMagma : IsMagma ∙ sel : Selective ∙ open IsMagma isMagma public ------------------------------------------------------------------------ -- Structures with 1 binary operation & 1 element ------------------------------------------------------------------------ record IsMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ identity : Identity ε ∙ open IsSemigroup isSemigroup public identityˡ : LeftIdentity ε ∙ identityˡ = proj₁ identity identityʳ : RightIdentity ε ∙ identityʳ = proj₂ identity record IsCommutativeMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ identityˡ : LeftIdentity ε ∙ comm : Commutative ∙ open IsSemigroup isSemigroup public identityʳ : RightIdentity ε ∙ identityʳ = Consequences.comm+idˡ⇒idʳ setoid comm identityˡ identity : Identity ε ∙ identity = (identityˡ , identityʳ) isMonoid : IsMonoid ∙ ε isMonoid = record { isSemigroup = isSemigroup ; identity = identity } record IsIdempotentCommutativeMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isCommutativeMonoid : IsCommutativeMonoid ∙ ε idem : Idempotent ∙ open IsCommutativeMonoid isCommutativeMonoid public -- Idempotent commutative monoids are also known as bounded lattices. -- Note that the BoundedLattice necessarily uses the notation inherited -- from monoids rather than lattices. IsBoundedLattice = IsIdempotentCommutativeMonoid module IsBoundedLattice {∙ : Op₂ A} {ε : A} (isIdemCommMonoid : IsIdempotentCommutativeMonoid ∙ ε) = IsIdempotentCommutativeMonoid isIdemCommMonoid ------------------------------------------------------------------------ -- Structures with 1 binary operation, 1 unary operation & 1 element ------------------------------------------------------------------------ record IsGroup (_∙_ : Op₂ A) (ε : A) (_⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where field isMonoid : IsMonoid _∙_ ε inverse : Inverse ε _⁻¹ _∙_ ⁻¹-cong : Congruent₁ _⁻¹ open IsMonoid isMonoid public infixl 6 _-_ _-_ : Op₂ A x - y = x ∙ (y ⁻¹) inverseˡ : LeftInverse ε _⁻¹ _∙_ inverseˡ = proj₁ inverse inverseʳ : RightInverse ε _⁻¹ _∙_ inverseʳ = proj₂ inverse uniqueˡ-⁻¹ : ∀ x y → (x ∙ y) ≈ ε → x ≈ (y ⁻¹) uniqueˡ-⁻¹ = Consequences.assoc+id+invʳ⇒invˡ-unique setoid ∙-cong assoc identity inverseʳ uniqueʳ-⁻¹ : ∀ x y → (x ∙ y) ≈ ε → y ≈ (x ⁻¹) uniqueʳ-⁻¹ = Consequences.assoc+id+invˡ⇒invʳ-unique setoid ∙-cong assoc identity inverseˡ record IsAbelianGroup (∙ : Op₂ A) (ε : A) (⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where field isGroup : IsGroup ∙ ε ⁻¹ comm : Commutative ∙ open IsGroup isGroup public isCommutativeMonoid : IsCommutativeMonoid ∙ ε isCommutativeMonoid = record { isSemigroup = isSemigroup ; identityˡ = identityˡ ; comm = comm } ------------------------------------------------------------------------ -- Structures with 2 binary operations ------------------------------------------------------------------------ -- Note that `IsLattice` is not defined in terms of `IsSemilattice` -- because the idempotence laws of ∨ and ∧ can be derived from the -- absorption laws, which makes the corresponding "idem" fields -- redundant. The derived idempotence laws are stated and proved in -- `Algebra.Properties.Lattice` along with the fact that every lattice -- consists of two semilattices. record IsLattice (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where field isEquivalence : IsEquivalence _≈_ ∨-comm : Commutative ∨ ∨-assoc : Associative ∨ ∨-cong : Congruent₂ ∨ ∧-comm : Commutative ∧ ∧-assoc : Associative ∧ ∧-cong : Congruent₂ ∧ absorptive : Absorptive ∨ ∧ open IsEquivalence isEquivalence public ∨-absorbs-∧ : ∨ Absorbs ∧ ∨-absorbs-∧ = proj₁ absorptive ∧-absorbs-∨ : ∧ Absorbs ∨ ∧-absorbs-∨ = proj₂ absorptive ∧-congˡ : LeftCongruent ∧ ∧-congˡ y≈z = ∧-cong refl y≈z ∧-congʳ : RightCongruent ∧ ∧-congʳ y≈z = ∧-cong y≈z refl ∨-congˡ : LeftCongruent ∨ ∨-congˡ y≈z = ∨-cong refl y≈z ∨-congʳ : RightCongruent ∨ ∨-congʳ y≈z = ∨-cong y≈z refl record IsDistributiveLattice (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where field isLattice : IsLattice ∨ ∧ ∨-distribʳ-∧ : ∨ DistributesOverʳ ∧ open IsLattice isLattice public ∨-∧-distribʳ = ∨-distribʳ-∧ {-# WARNING_ON_USAGE ∨-∧-distribʳ "Warning: ∨-∧-distribʳ was deprecated in v1.1. Please use ∨-distribʳ-∧ instead." #-} ------------------------------------------------------------------------ -- Structures with 2 binary operations & 1 element ------------------------------------------------------------------------ record IsNearSemiring (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where field +-isMonoid : IsMonoid + 0# *-isSemigroup : IsSemigroup * distribʳ : * DistributesOverʳ + zeroˡ : LeftZero 0# * open IsMonoid +-isMonoid public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identity to +-identity ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ) open IsSemigroup *-isSemigroup public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; ∙-congˡ to *-congˡ ; ∙-congʳ to *-congʳ ; isMagma to *-isMagma ) record IsSemiringWithoutOne (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where field +-isCommutativeMonoid : IsCommutativeMonoid + 0# *-isSemigroup : IsSemigroup * distrib : * DistributesOver + zero : Zero 0# * open IsCommutativeMonoid +-isCommutativeMonoid public using () renaming ( isMonoid to +-isMonoid ; comm to +-comm ) zeroˡ : LeftZero 0# * zeroˡ = proj₁ zero zeroʳ : RightZero 0# * zeroʳ = proj₂ zero isNearSemiring : IsNearSemiring + * 0# isNearSemiring = record { +-isMonoid = +-isMonoid ; *-isSemigroup = *-isSemigroup ; distribʳ = proj₂ distrib ; zeroˡ = zeroˡ } open IsNearSemiring isNearSemiring public hiding (+-isMonoid; zeroˡ) record IsCommutativeSemiringWithoutOne (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where field isSemiringWithoutOne : IsSemiringWithoutOne + * 0# *-comm : Commutative * open IsSemiringWithoutOne isSemiringWithoutOne public ------------------------------------------------------------------------ -- Structures with 2 binary operations & 2 elements ------------------------------------------------------------------------ record IsSemiringWithoutAnnihilatingZero (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where 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 + distribˡ : * DistributesOverˡ + distribˡ = proj₁ distrib distribʳ : * DistributesOverʳ + distribʳ = proj₂ distrib open IsCommutativeMonoid +-isCommutativeMonoid public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identity to +-identity ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; comm to +-comm ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ; isMonoid to +-isMonoid ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; ∙-congˡ to *-congˡ ; ∙-congʳ to *-congʳ ; identity to *-identity ; identityˡ to *-identityˡ ; identityʳ to *-identityʳ ; isMagma to *-isMagma ; isSemigroup to *-isSemigroup ) record IsSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where 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 ; zeroˡ ; zeroʳ ) record IsCommutativeSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where 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) distribˡ : * DistributesOverˡ + distribˡ = Consequences.comm+distrʳ⇒distrˡ +-CM.setoid +-CM.∙-cong *-comm distribʳ distrib : * DistributesOver + distrib = (distribˡ , distribʳ) zeroʳ : RightZero 0# * zeroʳ = Consequences.comm+zeˡ⇒zeʳ +-CM.setoid *-comm zeroˡ zero : Zero 0# * zero = (zeroˡ , zeroʳ) isSemiring : IsSemiring + * 0# 1# isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-CM.isMonoid ; distrib = distrib } ; zero = zero } open IsSemiring isSemiring public hiding ( distrib; distribʳ; distribˡ ; zero; zeroˡ; zeroʳ ; +-isCommutativeMonoid ) isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne + * 0# isCommutativeSemiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne ; *-comm = *-CM.comm } ------------------------------------------------------------------------ -- Structures with 2 binary operations, 1 unary operation & 2 elements ------------------------------------------------------------------------ record IsRing (+ * : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field +-isAbelianGroup : IsAbelianGroup + 0# -_ *-isMonoid : IsMonoid * 1# distrib : * DistributesOver + open IsAbelianGroup +-isAbelianGroup public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identity to +-identity ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; inverse to -‿inverse ; inverseˡ to -‿inverseˡ ; inverseʳ to -‿inverseʳ ; ⁻¹-cong to -‿cong ; comm to +-comm ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ; isMonoid to +-isMonoid ; isCommutativeMonoid to +-isCommutativeMonoid ; isGroup to +-isGroup ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; ∙-congˡ to *-congˡ ; ∙-congʳ to *-congʳ ; identity to *-identity ; identityˡ to *-identityˡ ; identityʳ to *-identityʳ ; isMagma to *-isMagma ; isSemigroup to *-isSemigroup ) zeroˡ : LeftZero 0# * zeroˡ = Consequences.assoc+distribʳ+idʳ+invʳ⇒zeˡ setoid +-cong *-cong +-assoc (proj₂ distrib) +-identityʳ -‿inverseʳ zeroʳ : RightZero 0# * zeroʳ = Consequences.assoc+distribˡ+idʳ+invʳ⇒zeʳ setoid +-cong *-cong +-assoc (proj₁ distrib) +-identityʳ -‿inverseʳ zero : Zero 0# * zero = (zeroˡ , zeroʳ) 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 (distribˡ; distribʳ; isNearSemiring; isSemiringWithoutOne) record IsCommutativeRing (+ * : Op₂ A) (- : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isRing : IsRing + * - 0# 1# *-comm : Commutative * open IsRing isRing public *-isCommutativeMonoid : IsCommutativeMonoid * 1# *-isCommutativeMonoid = record { isSemigroup = *-isSemigroup ; identityˡ = *-identityˡ ; comm = *-comm } isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# isCommutativeSemiring = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isCommutativeMonoid = *-isCommutativeMonoid ; distribʳ = distribʳ ; zeroˡ = zeroˡ } open IsCommutativeSemiring isCommutativeSemiring public using ( isCommutativeSemiringWithoutOne ) record IsBooleanAlgebra (∨ ∧ : Op₂ A) (¬ : Op₁ A) (⊤ ⊥ : A) : Set (a ⊔ ℓ) where field isDistributiveLattice : IsDistributiveLattice ∨ ∧ ∨-complementʳ : RightInverse ⊤ ¬ ∨ ∧-complementʳ : RightInverse ⊥ ¬ ∧ ¬-cong : Congruent₁ ¬ open IsDistributiveLattice isDistributiveLattice public agda-stdlib-1.1/src/Axiom/000077500000000000000000000000001350553555600154065ustar00rootroot00000000000000agda-stdlib-1.1/src/Axiom/DoubleNegationElimination.agda000066400000000000000000000021661350553555600233210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning double negation elimination. ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Axiom.DoubleNegationElimination where open import Axiom.ExcludedMiddle open import Level open import Relation.Nullary open import Relation.Nullary.Negation ------------------------------------------------------------------------ -- Definition -- The classical statement of double negation elimination says that -- if a property is not not true then it is true. DoubleNegationElimination : (ℓ : Level) → Set (suc ℓ) DoubleNegationElimination ℓ = {P : Set ℓ} → ¬ ¬ P → P ------------------------------------------------------------------------ -- Properties -- Double negation elimination is equivalent to excluded middle em⇒dne : ∀ {ℓ} → ExcludedMiddle ℓ → DoubleNegationElimination ℓ em⇒dne em = decidable-stable em dne⇒em : ∀ {ℓ} → DoubleNegationElimination ℓ → ExcludedMiddle ℓ dne⇒em dne = dne excluded-middle agda-stdlib-1.1/src/Axiom/ExcludedMiddle.agda000066400000000000000000000012311350553555600210750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning the excluded middle axiom. ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Axiom.ExcludedMiddle where open import Level open import Relation.Nullary ------------------------------------------------------------------------ -- Definition -- The classical statement of excluded middle says that every -- statement/set is decidable (i.e. it either holds or it doesn't hold). ExcludedMiddle : (ℓ : Level) → Set (suc ℓ) ExcludedMiddle ℓ = {P : Set ℓ} → Dec P agda-stdlib-1.1/src/Axiom/Extensionality/000077500000000000000000000000001350553555600204255ustar00rootroot00000000000000agda-stdlib-1.1/src/Axiom/Extensionality/Heterogeneous.agda000066400000000000000000000030501350553555600240550ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning function extensionality for propositional equality ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Axiom.Extensionality.Heterogeneous where import Axiom.Extensionality.Propositional as P open import Function open import Level open import Relation.Binary.HeterogeneousEquality.Core open import Relation.Binary.PropositionalEquality.Core ------------------------------------------------------------------------ -- Function extensionality states that if two functions are -- propositionally equal for every input, then the functions themselves -- must be propositionally equal. Extensionality : (a b : Level) → Set _ Extensionality a b = {A : Set a} {B₁ B₂ : A → Set b} {f₁ : (x : A) → B₁ x} {f₂ : (x : A) → B₂ x} → (∀ x → B₁ x ≡ B₂ x) → (∀ x → f₁ x ≅ f₂ x) → f₁ ≅ f₂ ------------------------------------------------------------------------ -- Properties -- This form of extensionality follows from extensionality for _≡_. ≡-ext⇒≅-ext : ∀ {ℓ₁ ℓ₂} → P.Extensionality ℓ₁ (suc ℓ₂) → Extensionality ℓ₁ ℓ₂ ≡-ext⇒≅-ext {ℓ₁} {ℓ₂} ext B₁≡B₂ f₁≅f₂ with ext B₁≡B₂ ... | refl = ≡-to-≅ $ ext′ (≅-to-≡ ∘ f₁≅f₂) where ext′ : P.Extensionality ℓ₁ ℓ₂ ext′ = P.lower-extensionality ℓ₁ (suc ℓ₂) ext agda-stdlib-1.1/src/Axiom/Extensionality/Propositional.agda000066400000000000000000000045361350553555600241150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning function extensionality for propositional equality ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Axiom.Extensionality.Propositional where open import Function open import Level using (Level; _⊔_; suc; lift) open import Relation.Binary.Core open import Relation.Binary.PropositionalEquality.Core ------------------------------------------------------------------------ -- Function extensionality states that if two functions are -- propositionally equal for every input, then the functions themselves -- must be propositionally equal. Extensionality : (a b : Level) → Set _ Extensionality a b = {A : Set a} {B : A → Set b} {f g : (x : A) → B x} → (∀ x → f x ≡ g x) → f ≡ g -- A variant for implicit function spaces. ExtensionalityImplicit : (a b : Level) → Set _ ExtensionalityImplicit a b = {A : Set a} {B : A → Set b} {f g : {x : A} → B x} → (∀ {x} → f {x} ≡ g {x}) → (λ {x} → f {x}) ≡ (λ {x} → g {x}) ------------------------------------------------------------------------ -- Properties -- If extensionality holds for a given universe level, then it also -- holds for lower ones. lower-extensionality : ∀ {a₁ b₁} a₂ b₂ → Extensionality (a₁ ⊔ a₂) (b₁ ⊔ b₂) → Extensionality a₁ b₁ lower-extensionality a₂ b₂ ext f≡g = cong (λ h → Level.lower ∘ h ∘ lift) $ ext (cong (lift {ℓ = b₂}) ∘ f≡g ∘ Level.lower {ℓ = a₂}) -- Functional extensionality implies a form of extensionality for -- Π-types. ∀-extensionality : ∀ {a b} → Extensionality a (suc b) → {A : Set a} (B₁ B₂ : A → Set b) → (∀ x → B₁ x ≡ B₂ x) → (∀ x → B₁ x) ≡ (∀ x → B₂ x) ∀-extensionality ext B₁ B₂ B₁≡B₂ with ext B₁≡B₂ ... | refl = refl -- Extensionality for explicit function spaces implies extensionality -- for implicit function spaces. implicit-extensionality : ∀ {a b} → Extensionality a b → ExtensionalityImplicit a b implicit-extensionality ext f≡g = cong _$- (ext (λ x → f≡g)) agda-stdlib-1.1/src/Axiom/UniquenessOfIdentityProofs.agda000066400000000000000000000051051350553555600235540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning uniqueness of identity proofs ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Axiom.UniquenessOfIdentityProofs where open import Data.Empty open import Relation.Nullary hiding (Irrelevant) open import Relation.Binary.Core open import Relation.Binary.PropositionalEquality.Core ------------------------------------------------------------------------ -- Definition -- -- Uniqueness of Identity Proofs (UIP) states that all proofs of -- equality are themselves equal. In other words, the equality relation -- is irrelevant. Here we define UIP relative to a given type. UIP : ∀ {a} (A : Set a) → Set a UIP A = Irrelevant {A = A} _≡_ ------------------------------------------------------------------------ -- Properties -- UIP always holds when using axiom K -- (see `Axiom.UniquenessOfIdentityProofs.WithK`). -- The existence of a constant function over proofs of equality for -- elements in A is enough to prove UIP for A. Indeed, we can relate any -- proof to its image via this function which we then know is equal to -- the image of any other proof. module Constant⇒UIP {a} {A : Set a} (f : _≡_ {A = A} ⇒ _≡_) (f-constant : ∀ {a b} (p q : a ≡ b) → f p ≡ f q) where ≡-canonical : ∀ {a b} (p : a ≡ b) → trans (sym (f refl)) (f p) ≡ p ≡-canonical refl = trans-symˡ (f refl) ≡-irrelevant : UIP A ≡-irrelevant p q = begin p ≡⟨ sym (≡-canonical p) ⟩ trans (sym (f refl)) (f p) ≡⟨ cong (trans _) (f-constant p q) ⟩ trans (sym (f refl)) (f q) ≡⟨ ≡-canonical q ⟩ q ∎ where open ≡-Reasoning -- If equality is decidable for a given type, then we can prove UIP for -- that type. Indeed, the decision procedure allows us to define a -- function over proofs of equality which is constant: it returns the -- proof produced by the decision procedure. module Decidable⇒UIP {a} {A : Set a} (_≟_ : Decidable {A = A} _≡_) where ≡-normalise : _≡_ {A = A} ⇒ _≡_ ≡-normalise {a} {b} a≡b with a ≟ b ... | yes p = p ... | no ¬p = ⊥-elim (¬p a≡b) ≡-normalise-constant : ∀ {a b} (p q : a ≡ b) → ≡-normalise p ≡ ≡-normalise q ≡-normalise-constant {a} {b} p q with a ≟ b ... | yes _ = refl ... | no ¬p = ⊥-elim (¬p p) ≡-irrelevant : UIP A ≡-irrelevant = Constant⇒UIP.≡-irrelevant ≡-normalise ≡-normalise-constant agda-stdlib-1.1/src/Axiom/UniquenessOfIdentityProofs/000077500000000000000000000000001350553555600227355ustar00rootroot00000000000000agda-stdlib-1.1/src/Axiom/UniquenessOfIdentityProofs/WithK.agda000066400000000000000000000010021350553555600245720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning uniqueness of identity proofs, with axiom K ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Axiom.UniquenessOfIdentityProofs.WithK where open import Axiom.UniquenessOfIdentityProofs open import Relation.Binary.PropositionalEquality.Core -- Axiom K implies UIP. uip : ∀ {a} {A : Set a} → UIP A uip refl refl = refl agda-stdlib-1.1/src/Category/000077500000000000000000000000001350553555600161065ustar00rootroot00000000000000agda-stdlib-1.1/src/Category/Applicative.agda000066400000000000000000000022721350553555600211700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --without-K --safe #-} 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 RawApplicativeZero : ∀ {f} → (Set f → Set f) → Set _ RawApplicativeZero F = RawIApplicativeZero {I = ⊤} (λ _ _ → F) module RawApplicativeZero {f} {F : Set f → Set f} (app : RawApplicativeZero F) where open RawIApplicativeZero app public RawAlternative : ∀ {f} → (Set f → Set f) → Set _ RawAlternative F = RawIAlternative {I = ⊤} (λ _ _ → F) module RawAlternative {f} {F : Set f → Set f} (app : RawAlternative F) where open RawIAlternative app public agda-stdlib-1.1/src/Category/Applicative/000077500000000000000000000000001350553555600203475ustar00rootroot00000000000000agda-stdlib-1.1/src/Category/Applicative/Indexed.agda000066400000000000000000000067521350553555600225570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --without-K --safe #-} module Category.Applicative.Indexed where open import Category.Functor using (RawFunctor) open import Data.Product using (_×_; _,_) 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 ℓ ------------------------------------------------------------------------ -- Type, and usual combinators 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 zip : ∀ {i j k A B} → F i j A → F j k B → F i k (A × B) zip = zipWith _,_ ------------------------------------------------------------------------ -- Applicative with a zero record RawIApplicativeZero {i f} {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where field applicative : RawIApplicative F ∅ : ∀ {i j A} → F i j A open RawIApplicative applicative public ------------------------------------------------------------------------ -- Alternative functors: `F i j A` is a monoid record RawIAlternative {i f} {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where infixr 3 _∣_ field applicativeZero : RawIApplicativeZero F _∣_ : ∀ {i j A} → F i j A → F i j A → F i j A open RawIApplicativeZero applicativeZero public ------------------------------------------------------------------------ -- 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-1.1/src/Category/Applicative/Predicate.agda000066400000000000000000000026621350553555600230730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --without-K --safe #-} 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-1.1/src/Category/Comonad.agda000066400000000000000000000021001350553555600202750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Comonads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --without-K --safe #-} module Category.Comonad where open import Level open import Function record RawComonad {f} (W : Set f → Set f) : Set (suc f) where infixl 1 _=>>_ _=>=_ infixr 1 _<<=_ _=<=_ field extract : ∀ {A} → W A → A extend : ∀ {A B} → (W A → B) → (W A → W B) duplicate : ∀ {A} → W A → W (W A) duplicate = extend id liftW : ∀ {A B} → (A → B) → W A → W B liftW f = extend (f ∘′ extract) _=>>_ : ∀ {A B} → W A → (W A → B) → W B _=>>_ = flip extend _=>=_ : ∀ {c A B} {C : Set c} → (W A → B) → (W B → C) → W A → C f =>= g = g ∘′ extend f _<<=_ : ∀ {A B} → (W A → B) → W A → W B _<<=_ = extend _=<=_ : ∀ {A B c} {C : Set c} → (W B → C) → (W A → B) → W A → C _=<=_ = flip _=>=_ agda-stdlib-1.1/src/Category/Functor.agda000066400000000000000000000022321350553555600203430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. {-# OPTIONS --without-K --safe #-} 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 _<$>_ _<$_ infixl 1 _<&>_ field _<$>_ : ∀ {A B} → (A → B) → F A → F B _<$_ : ∀ {A B} → A → F B → F A x <$ y = const x <$> y _<&>_ : ∀ {A B} → F A → (A → B) → F B _<&>_ = flip _<$>_ -- 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-1.1/src/Category/Functor/000077500000000000000000000000001350553555600175265ustar00rootroot00000000000000agda-stdlib-1.1/src/Category/Functor/Predicate.agda000066400000000000000000000014771350553555600222550ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. {-# OPTIONS --without-K --safe #-} 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-1.1/src/Category/Monad.agda000066400000000000000000000023071350553555600177640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --without-K --safe #-} 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) RawMonadT : ∀ {f} (T : (Set f → Set f) → (Set f → Set f)) → Set _ RawMonadT T = RawIMonadT {I = ⊤} (λ M _ _ → T (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-1.1/src/Category/Monad/000077500000000000000000000000001350553555600171445ustar00rootroot00000000000000agda-stdlib-1.1/src/Category/Monad/Continuation.agda000066400000000000000000000042661350553555600224440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A delimited continuation monad ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Category.Monad.Continuation where open import Category.Applicative open import Category.Applicative.Indexed open import Category.Monad open import Function.Identity.Categorical as Id using (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 Id.monad ------------------------------------------------------------------------ -- 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 Id.monad agda-stdlib-1.1/src/Category/Monad/Indexed.agda000066400000000000000000000043511350553555600213450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --without-K --safe #-} 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 RawIMonadT : ∀ {i f} {I : Set i} (T : IFun I f → IFun I f) → Set (i ⊔ suc f) RawIMonadT T = ∀ {M} → RawIMonad M → RawIMonad (T M) record RawIMonadZero {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M applicativeZero : RawIApplicativeZero M open RawIMonad monad public open RawIApplicativeZero applicativeZero using (∅) public record RawIMonadPlus {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M alternative : RawIAlternative M open RawIMonad monad public open RawIAlternative alternative using (∅; _∣_) public monadZero : RawIMonadZero M monadZero = record { monad = monad ; applicativeZero = RawIAlternative.applicativeZero alternative } agda-stdlib-1.1/src/Category/Monad/Partiality.agda000066400000000000000000001056711350553555600221160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The partiality monad ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --guardedness #-} module Category.Monad.Partiality where open import Codata.Musical.Notation 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 using (_⊎_; inj₁; inj₂) 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 ) -- 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) 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≳ (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-1.1/src/Category/Monad/Partiality/000077500000000000000000000000001350553555600212665ustar00rootroot00000000000000agda-stdlib-1.1/src/Category/Monad/Partiality/All.agda000066400000000000000000000145431350553555600226230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An All predicate for the partiality monad ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --guardedness #-} module Category.Monad.Partiality.All where open import Category.Monad open import Category.Monad.Partiality as Partiality using (_⊥; ⇒≈) open import Codata.Musical.Notation 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-1.1/src/Category/Monad/Predicate.agda000066400000000000000000000036121350553555600216640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --without-K --safe #-} 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-1.1/src/Category/Monad/Reader.agda000066400000000000000000000103521350553555600211650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The reader monad ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Level module Category.Monad.Reader {r} (R : Set r) (a : Level) where open import Function open import Function.Identity.Categorical as Id using (Identity) open import Category.Applicative.Indexed open import Category.Monad.Indexed open import Category.Monad open import Data.Unit ------------------------------------------------------------------------ -- Indexed reader IReaderT : ∀ {ℓ} {I : Set ℓ} → IFun I (r ⊔ a) → IFun I (r ⊔ a) IReaderT M i j A = R → M i j A module _ {ℓ} {I : Set ℓ} {M : IFun I (r ⊔ a)} where ------------------------------------------------------------------------ -- Indexed reader applicative ReaderTIApplicative : RawIApplicative M → RawIApplicative (IReaderT M) ReaderTIApplicative App = record { pure = λ x r → pure x ; _⊛_ = λ m n r → m r ⊛ n r } where open RawIApplicative App ReaderTIApplicativeZero : RawIApplicativeZero M → RawIApplicativeZero (IReaderT M) ReaderTIApplicativeZero App = record { applicative = ReaderTIApplicative applicative ; ∅ = const ∅ } where open RawIApplicativeZero App ReaderTIAlternative : RawIAlternative M → RawIAlternative (IReaderT M) ReaderTIAlternative Alt = record { applicativeZero = ReaderTIApplicativeZero applicativeZero ; _∣_ = λ m n r → m r ∣ n r } where open RawIAlternative Alt ------------------------------------------------------------------------ -- Indexed reader monad ReaderTIMonad : RawIMonad M → RawIMonad (IReaderT M) ReaderTIMonad Mon = record { return = λ x r → return x ; _>>=_ = λ m f r → m r >>= flip f r } where open RawIMonad Mon ReaderTIMonadZero : RawIMonadZero M → RawIMonadZero (IReaderT M) ReaderTIMonadZero Mon = record { monad = ReaderTIMonad monad ; applicativeZero = ReaderTIApplicativeZero applicativeZero } where open RawIMonadZero Mon ReaderTIMonadPlus : RawIMonadPlus M → RawIMonadPlus (IReaderT M) ReaderTIMonadPlus Mon = record { monad = ReaderTIMonad monad ; alternative = ReaderTIAlternative alternative } where open RawIMonadPlus Mon ------------------------------------------------------------------------ -- Reader monad operations record RawIMonadReader {ℓ} {I : Set ℓ} (M : IFun I (r ⊔ a)) : Set (ℓ ⊔ suc (r ⊔ a)) where field monad : RawIMonad M reader : ∀ {i A} → (R → A) → M i i A local : ∀ {i j A} → (R → R) → M i j A → M i j A open RawIMonad monad public ask : ∀ {i} → M i i (Lift (r ⊔ a) R) ask = reader lift asks : ∀ {i A} → (R → A) → M i i A asks = reader ReaderTIMonadReader : ∀ {ℓ} {I : Set ℓ} {M : IFun I (r ⊔ a)} → RawIMonad M → RawIMonadReader (IReaderT M) ReaderTIMonadReader Mon = record { monad = ReaderTIMonad Mon ; reader = λ f r → return (f r) ; local = λ f m → m ∘ f } where open RawIMonad Mon ------------------------------------------------------------------------ -- Ordinary reader monads RawMonadReader : (M : Set (r ⊔ a) → Set (r ⊔ a)) → Set _ RawMonadReader M = RawIMonadReader {I = ⊤} (λ _ _ → M) module RawMonadReader {M} (Mon : RawMonadReader M) where open RawIMonadReader Mon public ReaderT : (M : Set (r ⊔ a) → Set (r ⊔ a)) → Set _ → Set _ ReaderT M = IReaderT {I = ⊤} (λ _ _ → M) _ _ ReaderTMonad : ∀ {M} → RawMonad M → RawMonad (ReaderT M) ReaderTMonad = ReaderTIMonad ReaderTMonadReader : ∀ {M} → RawMonad M → RawMonadReader (ReaderT M) ReaderTMonadReader = ReaderTIMonadReader ReaderTMonadZero : ∀ {M} → RawMonadZero M → RawMonadZero (ReaderT M) ReaderTMonadZero = ReaderTIMonadZero ReaderTMonadPlus : ∀ {M} → RawMonadPlus M → RawMonadPlus (ReaderT M) ReaderTMonadPlus = ReaderTIMonadPlus Reader : Set (r ⊔ a) → Set (r ⊔ a) Reader = ReaderT Identity ReaderMonad : RawMonad Reader ReaderMonad = ReaderTIMonad Id.monad ReaderMonadReader : RawMonadReader Reader ReaderMonadReader = ReaderTIMonadReader Id.monad agda-stdlib-1.1/src/Category/Monad/State.agda000066400000000000000000000122621350553555600210450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The state monad ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Category.Monad.State where open import Category.Applicative.Indexed open import Category.Monad open import Function.Identity.Categorical as Id using (Identity) open import Category.Monad.Indexed open import Data.Product open import Data.Unit open import Function open import Level ------------------------------------------------------------------------ -- Indexed state 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) ------------------------------------------------------------------------ -- Indexed state applicative StateTIApplicative : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonad M → RawIApplicative (IStateT S M) StateTIApplicative S Mon = record { pure = λ a s → return (a , s) ; _⊛_ = λ f t s → do (f′ , s′) ← f s (t′ , s′′) ← t s′ return (f′ t′ , s′′) } where open RawMonad Mon StateTIApplicativeZero : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonadZero M → RawIApplicativeZero (IStateT S M) StateTIApplicativeZero S Mon = record { applicative = StateTIApplicative S monad ; ∅ = const ∅ } where open RawMonadZero Mon StateTIAlternative : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonadPlus M → RawIAlternative (IStateT S M) StateTIAlternative S Mon = record { applicativeZero = StateTIApplicativeZero S monadZero ; _∣_ = λ m n s → m s ∣ n s } where open RawMonadPlus Mon ------------------------------------------------------------------------ -- Indexed state monad 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) ; applicativeZero = StateTIApplicativeZero S Mon } 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 { monad = StateTIMonad S monad ; alternative = StateTIAlternative S Mon } 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 f ⊤) open RawIMonad monad public modify : ∀ {i j} → (S i → S j) → M i j (Lift f ⊤) 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 Id.monad StateMonadState : ∀ {f} (S : Set f) → RawMonadState S (State S) StateMonadState S = StateTMonadState S Id.monad 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-1.1/src/Codata/000077500000000000000000000000001350553555600155245ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Cofin.agda000066400000000000000000000035131350553555600174020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- "Finite" sets indexed on coinductive "natural" numbers ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Cofin where open import Size open import Codata.Thunk open import Codata.Conat as Conat using (Conat; zero; suc; infinity; _ℕ<_; sℕ≤s; _ℕ≤infinity) open import Codata.Conat.Bisimilarity as Bisim using (_⊢_≲_ ; s≲s) open import Data.Nat open import Data.Fin as Fin hiding (fromℕ; fromℕ≤; toℕ) open import Function open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- The type -- Note that `Cofin infnity` is /not/ finite. Note also that this is not a -- coinductive type, but it is indexed on a coinductive type. data Cofin : Conat ∞ → Set where zero : ∀ {n} → Cofin (suc n) suc : ∀ {n} → Cofin (n .force) → Cofin (suc n) suc-injective : ∀ {n} {p q : Cofin (n .force)} → (Cofin (suc n) ∋ suc p) ≡ suc q → p ≡ q suc-injective refl = refl ------------------------------------------------------------------------ -- Some operations fromℕ< : ∀ {n k} → k ℕ< n → Cofin n fromℕ< {zero} () fromℕ< {suc n} {zero} (sℕ≤s p) = zero fromℕ< {suc n} {suc k} (sℕ≤s p) = suc (fromℕ< p) fromℕ : ℕ → Cofin infinity fromℕ k = fromℕ< (suc k ℕ≤infinity) toℕ : ∀ {n} → Cofin n → ℕ toℕ zero = zero toℕ (suc i) = suc (toℕ i) fromFin : ∀ {n} → Fin n → Cofin (Conat.fromℕ n) fromFin zero = zero fromFin (suc i) = suc (fromFin i) toFin : ∀ n → Cofin (Conat.fromℕ n) → Fin n toFin zero () toFin (suc n) zero = zero toFin (suc n) (suc i) = suc (toFin n i) agda-stdlib-1.1/src/Codata/Cofin/000077500000000000000000000000001350553555600165625ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Cofin/Literals.agda000066400000000000000000000011621350553555600211570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Conat Literals ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Cofin.Literals where open import Data.Nat open import Agda.Builtin.FromNat open import Codata.Conat open import Codata.Conat.Properties open import Codata.Cofin open import Relation.Nullary.Decidable number : ∀ n → Number (Cofin n) number n = record { Constraint = λ k → True (suc k ℕ≤? n) ; fromNat = λ n {{p}} → fromℕ< (toWitness p) } agda-stdlib-1.1/src/Codata/Colist.agda000066400000000000000000000133561350553555600176070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Colist type and some operations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Colist where open import Size open import Data.Unit open import Data.Nat.Base open import Data.Product using (_×_ ; _,_) open import Data.These using (These; this; that; these) open import Data.Maybe using (Maybe; nothing; just) open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty using (List⁺; _∷_) open import Data.Vec as Vec using (Vec; []; _∷_) open import Data.BoundedVec as BVec using (BoundedVec) open import Function open import Codata.Thunk using (Thunk; force) open import Codata.Conat as Conat using (Conat ; zero ; suc) open import Codata.Cowriter as CW using (Cowriter; _∷_) open import Codata.Delay as Delay using (Delay ; now ; later) open import Codata.Stream using (Stream ; _∷_) data Colist {a} (A : Set a) (i : Size) : Set a where [] : Colist A i _∷_ : A → Thunk (Colist A) i → Colist A i module _ {w a} {W : Set w} {A : Set a} where ------------------------------------------------------------------------ -- Relationship to Cowriter. fromCowriter : ∀ {i} → Cowriter W A i → Colist W i fromCowriter CW.[ _ ] = [] fromCowriter (w ∷ ca) = w ∷ λ where .force → fromCowriter (ca .force) module _ {a} {A : Set a} where toCowriter : ∀ {i} → Colist A i → Cowriter A ⊤ i toCowriter [] = CW.[ _ ] toCowriter (a ∷ as) = a ∷ λ where .force → toCowriter (as .force) ------------------------------------------------------------------------ -- Basic functions. [_] : A → Colist A ∞ [ a ] = a ∷ λ where .force → [] length : ∀ {i} → Colist A i → Conat i length [] = zero length (x ∷ xs) = suc λ where .force → length (xs .force) replicate : ∀ {i} → Conat i → A → Colist A i replicate zero a = [] replicate (suc n) a = a ∷ λ where .force → replicate (n .force) a infixr 5 _++_ _⁺++_ _++_ : ∀ {i} → Colist A i → Colist A i → Colist A i [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ λ where .force → xs .force ++ ys lookup : ℕ → Colist A ∞ → Maybe A lookup n [] = nothing lookup zero (a ∷ as) = just a lookup (suc n) (a ∷ as) = lookup n (as .force) colookup : ∀ {i} → Conat i → Colist A i → Delay (Maybe A) i colookup n [] = now nothing colookup zero (a ∷ as) = now (just a) colookup (suc n) (a ∷ as) = later λ where .force → colookup (n .force) (as .force) take : ∀ (n : ℕ) → Colist A ∞ → BoundedVec A n take zero xs = BVec.[] take n [] = BVec.[] take (suc n) (x ∷ xs) = x BVec.∷ take n (xs .force) cotake : ∀ {i} → Conat i → Stream A i → Colist A i cotake zero xs = [] cotake (suc n) (x ∷ xs) = x ∷ λ where .force → cotake (n .force) (xs .force) fromList : List A → Colist A ∞ fromList [] = [] fromList (x ∷ xs) = x ∷ λ where .force → fromList xs _⁺++_ : ∀ {i} → List⁺ A → Thunk (Colist A) i → Colist A i (x ∷ xs) ⁺++ ys = x ∷ λ where .force → fromList xs ++ ys .force fromStream : ∀ {i} → Stream A i → Colist A i fromStream = cotake Conat.infinity module _ {ℓ} {A : Set ℓ} where chunksOf : (n : ℕ) → Colist A ∞ → Cowriter (Vec A n) (BoundedVec A n) ∞ chunksOf n = chunksOfAcc n id id module ChunksOf where chunksOfAcc : ∀ {i} m → -- We have two continuations but we are only ever going to use one. -- If we had linear types, we would write the type using the & conjunction here. (k≤ : BoundedVec A m → BoundedVec A n) → (k≡ : Vec A m → Vec A n) → -- Finally we chop up the input stream. Colist A ∞ → Cowriter (Vec A n) (BoundedVec A n) i chunksOfAcc zero k≤ k≡ as = k≡ [] ∷ λ where .force → chunksOfAcc n id id as chunksOfAcc (suc k) k≤ k≡ [] = CW.[ k≤ BVec.[] ] chunksOfAcc (suc k) k≤ k≡ (a ∷ as) = chunksOfAcc k (k≤ ∘ (a BVec.∷_)) (k≡ ∘ (a ∷_)) (as .force) module _ {a b} {A : Set a} {B : Set b} where map : ∀ {i} (f : A → B) → Colist A i → Colist B i map f [] = [] map f (a ∷ as) = f a ∷ λ where .force → map f (as .force) unfold : ∀ {i} → (A → Maybe (A × B)) → A → Colist B i unfold next seed with next seed ... | nothing = [] ... | just (seed′ , b) = b ∷ λ where .force → unfold next seed′ scanl : ∀ {i} → (B → A → B) → B → Colist A i → Colist B i scanl c n [] = n ∷ λ where .force → [] scanl c n (a ∷ as) = n ∷ λ where .force → scanl c (c n a) (as .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where alignWith : ∀ {i} → (These A B → C) → Colist A i → Colist B i → Colist C i alignWith f [] bs = map (f ∘′ that) bs alignWith f as@(_ ∷ _) [] = map (f ∘′ this) as alignWith f (a ∷ as) (b ∷ bs) = f (these a b) ∷ λ where .force → alignWith f (as .force) (bs .force) zipWith : ∀ {i} → (A → B → C) → Colist A i → Colist B i → Colist C i zipWith f [] bs = [] zipWith f as [] = [] zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ λ where .force → zipWith f (as .force) (bs .force) module _ {a b} {A : Set a} {B : Set b} where align : ∀ {i} → Colist A i → Colist B i → Colist (These A B) i align = alignWith id zip : ∀ {i} → Colist A i → Colist B i → Colist (A × B) i zip = zipWith _,_ ap : ∀ {i} → Colist (A → B) i → Colist A i → Colist B i ap = zipWith _$′_ agda-stdlib-1.1/src/Codata/Colist/000077500000000000000000000000001350553555600167615ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Colist/Bisimilarity.agda000066400000000000000000000042331350553555600222420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Colists ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Colist.Bisimilarity where open import Level using (_⊔_) open import Size open import Codata.Thunk open import Codata.Colist open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) data Bisim {a b r} {A : Set a} {B : Set b} (R : A → B → Set r) (i : Size) : (xs : Colist A ∞) (ys : Colist B ∞) → Set (r ⊔ a ⊔ b) where [] : Bisim R i [] [] _∷_ : ∀ {x y xs ys} → R x y → Thunk^R (Bisim R) i xs ys → Bisim R i (x ∷ xs) (y ∷ ys) module _ {a r} {A : Set a} {R : A → A → Set r} where reflexive : Reflexive R → ∀ {i} → Reflexive (Bisim R i) reflexive refl^R {i} {[]} = [] reflexive refl^R {i} {r ∷ rs} = refl^R ∷ λ where .force → reflexive refl^R module _ {a b} {A : Set a} {B : Set b} {r} {P : A → B → Set r} {Q : B → A → Set r} where symmetric : Sym P Q → ∀ {i} → Sym (Bisim P i) (Bisim Q i) symmetric sym^PQ [] = [] symmetric sym^PQ (p ∷ ps) = sym^PQ p ∷ λ where .force → symmetric sym^PQ (ps .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {r} {P : A → B → Set r} {Q : B → C → Set r} {R : A → C → Set r} where transitive : Trans P Q R → ∀ {i} → Trans (Bisim P i) (Bisim Q i) (Bisim R i) transitive trans^PQR [] [] = [] transitive trans^PQR (p ∷ ps) (q ∷ qs) = trans^PQR p q ∷ λ where .force → transitive trans^PQR (ps .force) (qs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {ℓ} {A : Set ℓ} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Colist A ∞ → Colist A ∞ → Set ℓ _⊢_≈_ = Bisim _≡_ refl : ∀ {i} → Reflexive (i ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i} → Symmetric (i ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i} → Transitive (i ⊢_≈_) trans = transitive Eq.trans agda-stdlib-1.1/src/Codata/Colist/Categorical.agda000066400000000000000000000012431350553555600220140ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Colist ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Colist.Categorical where open import Codata.Conat using (infinity) open import Codata.Colist open import Category.Functor open import Category.Applicative functor : ∀ {ℓ i} → RawFunctor {ℓ} (λ A → Colist A i) functor = record { _<$>_ = map } applicative : ∀ {ℓ i} → RawApplicative {ℓ} (λ A → Colist A i) applicative = record { pure = replicate infinity ; _⊛_ = ap } agda-stdlib-1.1/src/Codata/Colist/Properties.agda000066400000000000000000000020631350553555600217340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Colist type ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Colist.Properties where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Colist open import Codata.Colist.Bisimilarity open import Function open import Relation.Binary.PropositionalEquality as Eq -- Functor laws module _ {a} {A : Set a} where map-identity : ∀ (as : Colist A ∞) {i} → i ⊢ map id as ≈ as map-identity [] = [] map-identity (a ∷ as) = Eq.refl ∷ λ where .force → map-identity (as .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where map-map-fusion : ∀ (f : A → B) (g : B → C) as {i} → i ⊢ map g (map f as) ≈ map (g ∘ f) as map-map-fusion f g [] = [] map-map-fusion f g (a ∷ as) = Eq.refl ∷ λ where .force → map-map-fusion f g (as .force) agda-stdlib-1.1/src/Codata/Conat.agda000066400000000000000000000053641350553555600174160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Conat type and some operations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Conat where open import Size open import Codata.Thunk open import Data.Nat.Base using (ℕ ; zero ; suc) open import Relation.Nullary ------------------------------------------------------------------------ -- Definition and first values data Conat (i : Size) : Set where zero : Conat i suc : Thunk Conat i → Conat i infinity : ∀ {i} → Conat i infinity = suc λ where .force → infinity fromℕ : ℕ → Conat ∞ fromℕ zero = zero fromℕ (suc n) = suc λ where .force → fromℕ n ------------------------------------------------------------------------ -- Arithmetic operations pred : ∀ {i} {j : Size< i} → Conat i → Conat j pred zero = zero pred (suc n) = n .force infixl 6 _∸_ _+_ infixl 7 _*_ _∸_ : Conat ∞ → ℕ → Conat ∞ m ∸ zero = m m ∸ suc n = pred m ∸ n _ℕ+_ : ℕ → ∀ {i} → Conat i → Conat i zero ℕ+ n = n suc m ℕ+ n = suc λ where .force → m ℕ+ n _+ℕ_ : ∀ {i} → Conat i → ℕ → Conat i zero +ℕ n = fromℕ n suc m +ℕ n = suc λ where .force → (m .force) +ℕ n _+_ : ∀ {i} → Conat i → Conat i → Conat i zero + n = n suc m + n = suc λ where .force → (m .force) + n _*_ : ∀ {i} → Conat i → Conat i → Conat i m * zero = zero zero * n = zero suc m * suc n = suc λ where .force → n .force + (m .force * suc n) -- Max and Min infixl 6 _⊔_ infixl 7 _⊓_ _⊔_ : ∀ {i} → Conat i → Conat i → Conat i zero ⊔ n = n m ⊔ zero = m suc m ⊔ suc n = suc λ where .force → m .force ⊔ n .force _⊓_ : ∀ {i} → Conat i → Conat i → Conat i zero ⊓ n = zero m ⊓ zero = zero suc m ⊓ suc n = suc λ where .force → m .force ⊔ n .force ------------------------------------------------------------------------ -- Finiteness data Finite : Conat ∞ → Set where zero : Finite zero suc : ∀ {n} → Finite (n .force) → Finite (suc n) toℕ : ∀ {n} → Finite n → ℕ toℕ zero = zero toℕ (suc n) = suc (toℕ n) ¬Finite∞ : ¬ (Finite infinity) ¬Finite∞ (suc p) = ¬Finite∞ p ------------------------------------------------------------------------ -- Order wrt to Nat data _ℕ≤_ : ℕ → Conat ∞ → Set where zℕ≤n : ∀ {n} → zero ℕ≤ n sℕ≤s : ∀ {k n} → k ℕ≤ n .force → suc k ℕ≤ suc n _ℕ<_ : ℕ → Conat ∞ → Set k ℕ< n = suc k ℕ≤ n _ℕ≤infinity : ∀ k → k ℕ≤ infinity zero ℕ≤infinity = zℕ≤n suc k ℕ≤infinity = sℕ≤s (k ℕ≤infinity) agda-stdlib-1.1/src/Codata/Conat/000077500000000000000000000000001350553555600165705ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Conat/Bisimilarity.agda000066400000000000000000000034761350553555600220610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Conats ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Conat.Bisimilarity where open import Size open import Codata.Thunk open import Codata.Conat open import Relation.Binary infix 1 _⊢_≈_ data _⊢_≈_ i : (m n : Conat ∞) → Set where zero : i ⊢ zero ≈ zero suc : ∀ {m n} → Thunk^R _⊢_≈_ i m n → i ⊢ suc m ≈ suc n refl : ∀ {i m} → i ⊢ m ≈ m refl {m = zero} = zero refl {m = suc m} = suc λ where .force → refl sym : ∀ {i m n} → i ⊢ m ≈ n → i ⊢ n ≈ m sym zero = zero sym (suc eq) = suc λ where .force → sym (eq .force) trans : ∀ {i m n p} → i ⊢ m ≈ n → i ⊢ n ≈ p → i ⊢ m ≈ p trans zero zero = zero trans (suc eq₁) (suc eq₂) = suc λ where .force → trans (eq₁ .force) (eq₂ .force) infix 1 _⊢_≲_ data _⊢_≲_ i : (m n : Conat ∞) → Set where z≲n : ∀ {n} → i ⊢ zero ≲ n s≲s : ∀ {m n} → Thunk^R _⊢_≲_ i m n → i ⊢ suc m ≲ suc n ≈⇒≲ : ∀ {i m n} → i ⊢ m ≈ n → i ⊢ m ≲ n ≈⇒≲ zero = z≲n ≈⇒≲ (suc eq) = s≲s λ where .force → ≈⇒≲ (eq .force) ≲-refl : ∀ {i m} → i ⊢ m ≲ m ≲-refl = ≈⇒≲ refl ≲-antisym : ∀ {i m n} → i ⊢ m ≲ n → i ⊢ n ≲ m → i ⊢ m ≈ n ≲-antisym z≲n z≲n = zero ≲-antisym (s≲s le) (s≲s ge) = suc λ where .force → ≲-antisym (le .force) (ge .force) ≲-trans : ∀ {i m n p} → i ⊢ m ≲ n → i ⊢ n ≲ p → i ⊢ m ≲ p ≲-trans z≲n _ = z≲n ≲-trans (s≲s le₁) (s≲s le₂) = s≲s λ where .force → ≲-trans (le₁ .force) (le₂ .force) agda-stdlib-1.1/src/Codata/Conat/Literals.agda000066400000000000000000000007501350553555600211670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Conat Literals ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Conat.Literals where open import Agda.Builtin.FromNat open import Data.Unit open import Codata.Conat number : ∀ {i} → Number (Conat i) number = record { Constraint = λ _ → ⊤ ; fromNat = λ n → fromℕ n } agda-stdlib-1.1/src/Codata/Conat/Properties.agda000066400000000000000000000020141350553555600215370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties for Conats ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Conat.Properties where open import Data.Nat open import Codata.Thunk open import Codata.Conat open import Codata.Conat.Bisimilarity open import Function open import Relation.Nullary open import Relation.Binary sℕ≤s⁻¹ : ∀ {m n} → suc m ℕ≤ suc n → m ℕ≤ n .force sℕ≤s⁻¹ (sℕ≤s p) = p _ℕ≤?_ : Decidable _ℕ≤_ zero ℕ≤? n = yes zℕ≤n suc m ℕ≤? zero = no (λ ()) suc m ℕ≤? suc n with m ℕ≤? n .force ... | yes p = yes (sℕ≤s p) ... | no ¬p = no (¬p ∘′ sℕ≤s⁻¹) 0ℕ+-identity : ∀ {i n} → i ⊢ 0 ℕ+ n ≈ n 0ℕ+-identity = refl +ℕ0-identity : ∀ {i n} → i ⊢ n +ℕ 0 ≈ n +ℕ0-identity {n = zero} = zero +ℕ0-identity {n = suc n} = suc λ where .force → +ℕ0-identity agda-stdlib-1.1/src/Codata/Covec.agda000066400000000000000000000062601350553555600174050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Covec type and some operations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Covec where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat as Conat open import Codata.Conat.Bisimilarity open import Codata.Conat.Properties open import Codata.Cofin as Cofin using (Cofin; zero; suc) open import Codata.Colist as Colist using (Colist ; [] ; _∷_) open import Codata.Stream as Stream using (Stream ; _∷_) open import Function data Covec {ℓ} (A : Set ℓ) (i : Size) : Conat ∞ → Set ℓ where [] : Covec A i zero _∷_ : ∀ {n} → A → Thunk (λ i → Covec A i (n .force)) i → Covec A i (suc n) module _ {ℓ} {A : Set ℓ} where head : ∀ {n i} → Covec A i (suc n) → A head (x ∷ _) = x tail : ∀ {n} → Covec A ∞ (suc n) → Covec A ∞ (n .force) tail (_ ∷ xs) = xs .force lookup : ∀ {n} → Cofin n → Covec A ∞ n → A lookup zero = head lookup (suc k) = lookup k ∘′ tail replicate : ∀ {i} → (n : Conat ∞) → A → Covec A i n replicate zero a = [] replicate (suc n) a = a ∷ λ where .force → replicate (n .force) a cotake : ∀ {i} → (n : Conat ∞) → Stream A i → Covec A i n cotake zero xs = [] cotake (suc n) (x ∷ xs) = x ∷ λ where .force → cotake (n .force) (xs .force) infixr 5 _++_ _++_ : ∀ {i m n} → Covec A i m → Covec A i n → Covec A i (m + n) [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ λ where .force → xs .force ++ ys fromColist : ∀ {i} → (xs : Colist A ∞) → Covec A i (Colist.length xs) fromColist [] = [] fromColist (x ∷ xs) = x ∷ λ where .force → fromColist (xs .force) toColist : ∀ {i n} → Covec A i n → Colist A i toColist [] = [] toColist (x ∷ xs) = x ∷ λ where .force → toColist (xs .force) fromStream : ∀ {i} → Stream A i → Covec A i infinity fromStream = cotake infinity cast : ∀ {i} {m n} → i ⊢ m ≈ n → Covec A i m → Covec A i n cast zero [] = [] cast (suc eq) (a ∷ as) = a ∷ λ where .force → cast (eq .force) (as .force) module _ {a b} {A : Set a} {B : Set b} where map : ∀ {i n} (f : A → B) → Covec A i n → Covec B i n map f [] = [] map f (a ∷ as) = f a ∷ λ where .force → map f (as .force) ap : ∀ {i n} → Covec (A → B) i n → Covec A i n → Covec B i n ap [] [] = [] ap (f ∷ fs) (a ∷ as) = (f a) ∷ λ where .force → ap (fs .force) (as .force) scanl : ∀ {i n} → (B → A → B) → B → Covec A i n → Covec B i (1 ℕ+ n) scanl c n [] = n ∷ λ where .force → [] scanl c n (a ∷ as) = n ∷ λ where .force → cast (suc λ where .force → 0ℕ+-identity) (scanl c (c n a) (as .force)) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where zipWith : ∀ {i n} → (A → B → C) → Covec A i n → Covec B i n → Covec C i n zipWith f [] [] = [] zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ λ where .force → zipWith f (as .force) (bs .force) agda-stdlib-1.1/src/Codata/Covec/000077500000000000000000000000001350553555600165635ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Covec/Bisimilarity.agda000066400000000000000000000045431350553555600220500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Covecs ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Covec.Bisimilarity where open import Level using (_⊔_) open import Size open import Codata.Thunk open import Codata.Conat hiding (_⊔_) open import Codata.Covec open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) data Bisim {a b r} {A : Set a} {B : Set b} (R : A → B → Set r) (i : Size) : ∀ m n (xs : Covec A ∞ m) (ys : Covec B ∞ n) → Set (r ⊔ a ⊔ b) where [] : Bisim R i zero zero [] [] _∷_ : ∀ {x y m n xs ys} → R x y → Thunk^R (λ i → Bisim R i (m .force) (n .force)) i xs ys → Bisim R i (suc m) (suc n) (x ∷ xs) (y ∷ ys) module _ {a r} {A : Set a} {R : A → A → Set r} where reflexive : Reflexive R → ∀ {i m} → Reflexive (Bisim R i m m) reflexive refl^R {i} {m} {[]} = [] reflexive refl^R {i} {m} {r ∷ rs} = refl^R ∷ λ where .force → reflexive refl^R module _ {a b} {A : Set a} {B : Set b} {r} {P : A → B → Set r} {Q : B → A → Set r} where symmetric : Sym P Q → ∀ {i m n} → Sym (Bisim P i m n) (Bisim Q i n m) symmetric sym^PQ [] = [] symmetric sym^PQ (p ∷ ps) = sym^PQ p ∷ λ where .force → symmetric sym^PQ (ps .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {r} {P : A → B → Set r} {Q : B → C → Set r} {R : A → C → Set r} where transitive : Trans P Q R → ∀ {i m n p} → Trans (Bisim P i m n) (Bisim Q i n p) (Bisim R i m p) transitive trans^PQR [] [] = [] transitive trans^PQR (p ∷ ps) (q ∷ qs) = trans^PQR p q ∷ λ where .force → transitive trans^PQR (ps .force) (qs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {ℓ} {A : Set ℓ} where infix 1 _,_⊢_≈_ _,_⊢_≈_ : ∀ i m → Covec A ∞ m → Covec A ∞ m → Set ℓ _,_⊢_≈_ i m = Bisim _≡_ i m m refl : ∀ {i m} → Reflexive (i , m ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i m} → Symmetric (i , m ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i m} → Transitive (i , m ⊢_≈_) trans = transitive Eq.trans agda-stdlib-1.1/src/Codata/Covec/Categorical.agda000066400000000000000000000012171350553555600216170ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Covec ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Covec.Categorical where open import Codata.Conat open import Codata.Covec open import Category.Functor open import Category.Applicative functor : ∀ {ℓ i n} → RawFunctor {ℓ} (λ A → Covec A n i) functor = record { _<$>_ = map } applicative : ∀ {ℓ i n} → RawApplicative {ℓ} (λ A → Covec A n i) applicative = record { pure = replicate _ ; _⊛_ = ap } agda-stdlib-1.1/src/Codata/Covec/Properties.agda000066400000000000000000000021001350553555600215260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Covec type ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Covec.Properties where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Covec open import Codata.Covec.Bisimilarity open import Function open import Relation.Binary.PropositionalEquality as Eq -- Functor laws module _ {a} {A : Set a} where map-identity : ∀ {m} (as : Covec A ∞ m) {i} → i , m ⊢ map id as ≈ as map-identity [] = [] map-identity (a ∷ as) = Eq.refl ∷ λ where .force → map-identity (as .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where map-map-fusion : ∀ (f : A → B) (g : B → C) {m} as {i} → i , m ⊢ map g (map f as) ≈ map (g ∘ f) as map-map-fusion f g [] = [] map-map-fusion f g (a ∷ as) = Eq.refl ∷ λ where .force → map-map-fusion f g (as .force) agda-stdlib-1.1/src/Codata/Cowriter.agda000066400000000000000000000103221350553555600201360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Cowriter type and some operations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Cowriter where open import Size import Level as L open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Delay using (Delay; later; now) open import Codata.Stream as Stream using (Stream; _∷_) open import Data.Unit open import Data.List using (List; []; _∷_) open import Data.List.NonEmpty using (List⁺; _∷_) open import Data.Nat.Base as Nat using (ℕ; zero; suc) open import Data.Product as Prod using (_×_; _,_) open import Data.Sum as Sum using (_⊎_; inj₁; inj₂) open import Data.Vec using (Vec; []; _∷_) open import Data.BoundedVec as BVec using (BoundedVec) open import Function data Cowriter {w a} (W : Set w) (A : Set a) (i : Size) : Set (a L.⊔ w) where [_] : A → Cowriter W A i _∷_ : W → Thunk (Cowriter W A) i → Cowriter W A i ------------------------------------------------------------------------ -- Relationship to Delay. module _ {a} {A : Set a} where fromDelay : ∀ {i} → Delay A i → Cowriter ⊤ A i fromDelay (now a) = [ a ] fromDelay (later da) = _ ∷ λ where .force → fromDelay (da .force) module _ {w a} {W : Set w} {A : Set a} where toDelay : ∀ {i} → Cowriter W A i → Delay A i toDelay [ a ] = now a toDelay (_ ∷ ca) = later λ where .force → toDelay (ca .force) ------------------------------------------------------------------------ -- Basic functions. fromStream : ∀ {i} → Stream W i → Cowriter W A i fromStream (w ∷ ws) = w ∷ λ where .force → fromStream (ws .force) repeat : W → Cowriter W A ∞ repeat = fromStream ∘′ Stream.repeat length : ∀ {i} → Cowriter W A i → Conat i length [ _ ] = zero length (w ∷ cw) = suc λ where .force → length (cw .force) splitAt : ∀ (n : ℕ) → Cowriter W A ∞ → (Vec W n × Cowriter W A ∞) ⊎ (BoundedVec W n × A) splitAt zero cw = inj₁ ([] , cw) splitAt (suc n) [ a ] = inj₂ (BVec.[] , a) splitAt (suc n) (w ∷ cw) = Sum.map (Prod.map₁ (w ∷_)) (Prod.map₁ (w BVec.∷_)) $ splitAt n (cw .force) take : ∀ (n : ℕ) → Cowriter W A ∞ → Vec W n ⊎ (BoundedVec W n × A) take n = Sum.map₁ Prod.proj₁ ∘′ splitAt n infixr 5 _++_ _⁺++_ _++_ : ∀ {i} → List W → Cowriter W A i → Cowriter W A i [] ++ ca = ca (w ∷ ws) ++ ca = w ∷ λ where .force → ws ++ ca _⁺++_ : ∀ {i} → List⁺ W → Thunk (Cowriter W A) i → Cowriter W A i (w ∷ ws) ⁺++ ca = w ∷ λ where .force → ws ++ ca .force concat : ∀ {i} → Cowriter (List⁺ W) A i → Cowriter W A i concat [ a ] = [ a ] concat (w ∷ ca) = w ⁺++ λ where .force → concat (ca .force) module _ {w x a b} {W : Set w} {X : Set x} {A : Set a} {B : Set b} where ------------------------------------------------------------------------ -- Functor, Applicative and Monad map : ∀ {i} → (W → X) → (A → B) → Cowriter W A i → Cowriter X B i map f g [ a ] = [ g a ] map f g (w ∷ cw) = f w ∷ λ where .force → map f g (cw .force) module _ {w a r} {W : Set w} {A : Set a} {R : Set r} where map₁ : ∀ {i} → (W → R) → Cowriter W A i → Cowriter R A i map₁ f = map f id map₂ : ∀ {i} → (A → R) → Cowriter W A i → Cowriter W R i map₂ = map id ap : ∀ {i} → Cowriter W (A → R) i → Cowriter W A i → Cowriter W R i ap [ f ] ca = map₂ f ca ap (w ∷ cf) ca = w ∷ λ where .force → ap (cf .force) ca _>>=_ : ∀ {i} → Cowriter W A i → (A → Cowriter W R i) → Cowriter W R i [ a ] >>= f = f a (w ∷ ca) >>= f = w ∷ λ where .force → ca .force >>= f ------------------------------------------------------------------------ -- Construction. module _ {w s a} {W : Set w} {S : Set s} {A : Set a} where unfold : ∀ {i} → (S → (W × S) ⊎ A) → S → Cowriter W A i unfold next seed with next seed ... | inj₁ (w , seed') = w ∷ λ where .force → unfold next seed' ... | inj₂ a = [ a ] agda-stdlib-1.1/src/Codata/Delay.agda000066400000000000000000000074011350553555600174020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Delay type and some operations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Delay where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat using (Conat; zero; suc; Finite) open import Data.Empty open import Relation.Nullary open import Data.Nat.Base open import Data.Maybe.Base hiding (map ; fromMaybe ; zipWith ; alignWith ; zip ; align) open import Data.Product as P hiding (map ; zip) open import Data.Sum as S hiding (map) open import Data.These as T using (These; this; that; these) open import Function ------------------------------------------------------------------------ -- Definition data Delay {ℓ} (A : Set ℓ) (i : Size) : Set ℓ where now : A → Delay A i later : Thunk (Delay A) i → Delay A i module _ {ℓ} {A : Set ℓ} where length : ∀ {i} → Delay A i → Conat i length (now _) = zero length (later d) = suc λ where .force → length (d .force) never : ∀ {i} → Delay A i never = later λ where .force → never fromMaybe : Maybe A → Delay A ∞ fromMaybe = maybe now never runFor : ℕ → Delay A ∞ → Maybe A runFor zero d = nothing runFor (suc n) (now a) = just a runFor (suc n) (later d) = runFor n (d .force) module _ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} where map : (A → B) → ∀ {i} → Delay A i → Delay B i map f (now a) = now (f a) map f (later d) = later λ where .force → map f (d .force) bind : ∀ {i} → Delay A i → (A → Delay B i) → Delay B i bind (now a) f = f a bind (later d) f = later λ where .force → bind (d .force) f unfold : (A → A ⊎ B) → A → ∀ {i} → Delay B i unfold next seed with next seed ... | inj₁ seed′ = later λ where .force → unfold next seed′ ... | inj₂ b = now b module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where zipWith : (A → B → C) → ∀ {i} → Delay A i → Delay B i → Delay C i zipWith f (now a) d = map (f a) d zipWith f d (now b) = map (λ a → f a b) d zipWith f (later a) (later b) = later λ where .force → zipWith f (a .force) (b .force) alignWith : (These A B → C) → ∀ {i} → Delay A i → Delay B i → Delay C i alignWith f (now a) (now b) = now (f (these a b)) alignWith f (now a) (later _) = now (f (this a)) alignWith f (later _) (now b) = now (f (that b)) alignWith f (later a) (later b) = later λ where .force → alignWith f (a .force) (b .force) module _ {a b} {A : Set a} {B : Set b} where zip : ∀ {i} → Delay A i → Delay B i → Delay (A × B) i zip = zipWith _,_ align : ∀ {i} → Delay A i → Delay B i → Delay (These A B) i align = alignWith id ------------------------------------------------------------------------ -- Finite Delays module _ {ℓ} {A : Set ℓ} where infix 3 _⇓ data _⇓ : Delay A ∞ → Set ℓ where now : ∀ a → now a ⇓ later : ∀ {d} → d .force ⇓ → later d ⇓ extract : ∀ {d} → d ⇓ → A extract (now a) = a extract (later d) = extract d ¬never⇓ : ¬ (never ⇓) ¬never⇓ (later p) = ¬never⇓ p length-⇓ : ∀ {d} → d ⇓ → Finite (length d) length-⇓ (now a) = zero length-⇓ (later d⇓) = suc (length-⇓ d⇓) module _ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} where map-⇓ : ∀ (f : A → B) {d} → d ⇓ → map f d ⇓ map-⇓ f (now a) = now (f a) map-⇓ f (later d) = later (map-⇓ f d) bind-⇓ : ∀ {m} (m⇓ : m ⇓) {f : A → Delay B ∞} → f (extract m⇓) ⇓ → bind m f ⇓ bind-⇓ (now a) fa⇓ = fa⇓ bind-⇓ (later p) fa⇓ = later (bind-⇓ p fa⇓) agda-stdlib-1.1/src/Codata/Delay/000077500000000000000000000000001350553555600165625ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Delay/Bisimilarity.agda000066400000000000000000000042601350553555600220430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for the Delay type ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Delay.Bisimilarity where open import Size open import Codata.Thunk open import Codata.Delay open import Level open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) data Bisim {a b r} {A : Set a} {B : Set b} (R : A → B → Set r) i : (xs : Delay A ∞) (ys : Delay B ∞) → Set (a ⊔ b ⊔ r) where now : ∀ {x y} → R x y → Bisim R i (now x) (now y) later : ∀ {xs ys} → Thunk^R (Bisim R) i xs ys → Bisim R i (later xs) (later ys) module _ {a r} {A : Set a} {R : A → A → Set r} where reflexive : Reflexive R → ∀ {i} → Reflexive (Bisim R i) reflexive refl^R {i} {now r} = now refl^R reflexive refl^R {i} {later rs} = later λ where .force → reflexive refl^R module _ {a b} {A : Set a} {B : Set b} {r} {P : A → B → Set r} {Q : B → A → Set r} where symmetric : Sym P Q → ∀ {i} → Sym (Bisim P i) (Bisim Q i) symmetric sym^PQ (now p) = now (sym^PQ p) symmetric sym^PQ (later ps) = later λ where .force → symmetric sym^PQ (ps .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {r} {P : A → B → Set r} {Q : B → C → Set r} {R : A → C → Set r} where transitive : Trans P Q R → ∀ {i} → Trans (Bisim P i) (Bisim Q i) (Bisim R i) transitive trans^PQR (now p) (now q) = now (trans^PQR p q) transitive trans^PQR (later ps) (later qs) = later λ where .force → transitive trans^PQR (ps .force) (qs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {ℓ} {A : Set ℓ} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Delay A ∞ → Delay A ∞ → Set ℓ _⊢_≈_ = Bisim _≡_ refl : ∀ {i} → Reflexive (i ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i} → Symmetric (i ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i} → Transitive (i ⊢_≈_) trans = transitive Eq.trans agda-stdlib-1.1/src/Codata/Delay/Categorical.agda000066400000000000000000000033721350553555600216220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Delay ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Delay.Categorical where open import Codata.Delay open import Function open import Category.Functor open import Category.Applicative open import Category.Monad open import Data.These using (leftMost) functor : ∀ {i ℓ} → RawFunctor {ℓ} (λ A → Delay A i) functor = record { _<$>_ = λ f → map f } module Sequential where applicative : ∀ {i ℓ} → RawApplicative {ℓ} (λ A → Delay A i) applicative = record { pure = now ; _⊛_ = λ df da → bind df (λ f → map f da) } applicativeZero : ∀ {i ℓ} → RawApplicativeZero {ℓ} (λ A → Delay A i) applicativeZero = record { applicative = applicative ; ∅ = never } monad : ∀ {i ℓ} → RawMonad {ℓ} (λ A → Delay A i) monad = record { return = now ; _>>=_ = bind } monadZero : ∀ {i ℓ} → RawMonadZero {ℓ} (λ A → Delay A i) monadZero = record { monad = monad ; applicativeZero = applicativeZero } module Zippy where applicative : ∀ {i ℓ} → RawApplicative {ℓ} (λ A → Delay A i) applicative = record { pure = now ; _⊛_ = zipWith id } applicativeZero : ∀ {i ℓ} → RawApplicativeZero {ℓ} (λ A → Delay A i) applicativeZero = record { applicative = applicative ; ∅ = never } alternative : ∀ {i ℓ} → RawAlternative {ℓ} (λ A → Delay A i) alternative = record { applicativeZero = applicativeZero ; _∣_ = alignWith leftMost } agda-stdlib-1.1/src/Codata/Delay/Properties.agda000066400000000000000000000037231350553555600215410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Delay type ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Delay.Properties where open import Size import Data.Sum as Sum open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Conat.Bisimilarity as Coℕ using (zero ; suc) open import Codata.Delay open import Codata.Delay.Bisimilarity open import Function open import Relation.Binary.PropositionalEquality as Eq using (_≡_) module _ {a} {A : Set a} where length-never : ∀ {i} → i Coℕ.⊢ length (never {A = A}) ≈ infinity length-never = suc λ where .force → length-never module _ {a b} {A : Set a} {B : Set b} where length-map : ∀ (f : A → B) da {i} → i Coℕ.⊢ length (map f da) ≈ length da length-map f (now a) = zero length-map f (later da) = suc λ where .force → length-map f (da .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where length-zipWith : ∀ (f : A → B → C) da db {i} → i Coℕ.⊢ length (zipWith f da db) ≈ length da ⊔ length db length-zipWith f (now a) db = length-map (f a) db length-zipWith f da@(later _) (now b) = length-map (λ a → f a b) da length-zipWith f (later da) (later db) = suc λ where .force → length-zipWith f (da .force) (db .force) map-map-fusion : ∀ (f : A → B) (g : B → C) da {i} → i ⊢ map g (map f da) ≈ map (g ∘′ f) da map-map-fusion f g (now a) = now Eq.refl map-map-fusion f g (later da) = later λ where .force → map-map-fusion f g (da .force) map-unfold-fusion : ∀ (f : B → C) n (s : A) {i} → i ⊢ map f (unfold n s) ≈ unfold (Sum.map id f ∘′ n) s map-unfold-fusion f n s with n s ... | Sum.inj₁ s′ = later λ where .force → map-unfold-fusion f n s′ ... | Sum.inj₂ b = now Eq.refl agda-stdlib-1.1/src/Codata/M.agda000066400000000000000000000024441350553555600165420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- M-types (the dual of W-types) ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.M where open import Size open import Level open import Codata.Thunk using (Thunk; force) open import Data.Product hiding (map) open import Data.Container.Core as C hiding (map) data M {s p} (C : Container s p) (i : Size) : Set (s ⊔ p) where inf : ⟦ C ⟧ (Thunk (M C) i) → M C i module _ {s p} {C : Container s p} where head : ∀ {i} → M C i → Shape C head (inf (x , f)) = x tail : (x : M C ∞) → Position C (head x) → M C ∞ tail (inf (x , f)) = λ p → f p .force -- map module _ {s₁ s₂ p₁ p₂} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} (m : C₁ ⇒ C₂) where map : ∀ {i} → M C₁ i → M C₂ i map (inf t) = inf (⟪ m ⟫ (C.map (λ t → λ where .force → map (t .force)) t)) -- unfold module _ {s p ℓ} {C : Container s p} (open Container C) {S : Set ℓ} (alg : S → ⟦ C ⟧ S) where unfold : S → ∀ {i} → M C i unfold seed = let (x , next) = alg seed in inf (x , λ p → λ where .force → unfold (next p)) agda-stdlib-1.1/src/Codata/M/000077500000000000000000000000001350553555600157205ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/M/Bisimilarity.agda000066400000000000000000000031101350553555600211720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for M-types ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.M.Bisimilarity where open import Level open import Size open import Codata.Thunk open import Codata.M open import Data.Container.Core open import Data.Container.Relation.Binary.Pointwise using (Pointwise; _,_) open import Data.Product using (_,_) open import Function open import Relation.Binary import Relation.Binary.PropositionalEquality as P data Bisim {s p} (C : Container s p) (i : Size) : Rel (M C ∞) (s ⊔ p) where inf : ∀ {t u} → Pointwise C (Thunk^R (Bisim C) i) t u → Bisim C i (inf t) (inf u) module _ {s p} {C : Container s p} where -- unfortunately the proofs are a lot nicer if we do not use the combinators -- C.refl, C.sym and C.trans refl : ∀ {i} → Reflexive (Bisim C i) refl {x = inf t} = inf (P.refl , λ where p .force → refl) sym : ∀ {i} → Symmetric (Bisim C i) sym (inf (P.refl , f)) = inf (P.refl , λ where p .force → sym (f p .force)) trans : ∀ {i} → Transitive (Bisim C i) trans (inf (P.refl , f)) (inf (P.refl , g)) = inf (P.refl , λ where p .force → trans (f p .force) (g p .force)) isEquivalence : ∀ {i} → IsEquivalence (Bisim C i) isEquivalence = record { refl = refl ; sym = sym ; trans = trans } setoid : {i : Size} → Setoid (s ⊔ p) (s ⊔ p) setoid {i} = record { isEquivalence = isEquivalence {i} } agda-stdlib-1.1/src/Codata/M/Properties.agda000066400000000000000000000046211350553555600206750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on M-types ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.M.Properties where open import Level open import Size open import Codata.Thunk using (Thunk; force) open import Codata.M open import Codata.M.Bisimilarity open import Data.Container.Core as C hiding (map) import Data.Container.Morphism as Mp open import Data.Product as Prod using (_,_) open import Data.Product.Properties open import Function import Relation.Binary.PropositionalEquality as P open import Data.Container.Relation.Binary.Pointwise using (_,_) import Data.Container.Relation.Binary.Equality.Setoid as EqSetoid private module Eq {a} (A : Set a) = EqSetoid (P.setoid A) open Eq using (Eq) module _ {s p} {C : Container s p} where map-id : ∀ {i} c → Bisim C i (map (Mp.id C) c) c map-id (inf (s , f)) = inf (P.refl , λ where p .force → map-id (f p .force)) module _ {s₁ s₂ p₁ p₂} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} where map-cong : ∀ {i} {f g : C₁ ⇒ C₂} → (∀ {X} t → Eq X C₂ (⟪ f ⟫ t) (⟪ g ⟫ t)) → ∀ c₁ → Bisim C₂ i (map f c₁) (map g c₁) map-cong {f = f} {g} f≗g (inf t@(s , n)) with f≗g t ... | eqs , eqf = inf (eqs , λ where p .force {j} → P.subst (λ t → Bisim C₂ j (map f (n (position f p) .force)) (map g (t .force))) (eqf p) (map-cong f≗g (n (position f p) .force))) module _ {s₁ s₂ s₃ p₁ p₂ p₃} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} {C₃ : Container s₃ p₃} where map-compose : ∀ {i} {g : C₂ ⇒ C₃} {f : C₁ ⇒ C₂} c₁ → Bisim C₃ i (map (g Mp.∘ f) c₁) (map g $′ map f c₁) map-compose (inf (s , f)) = inf (P.refl , λ where p .force → map-compose (f _ .force)) module _ {s₁ s₂ p₁ p₂ s} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} {S : Set s} {alg : S → ⟦ C₁ ⟧ S} {f : C₁ ⇒ C₂} where map-unfold : ∀ {i} s → Bisim C₂ i (map f (unfold alg s)) (unfold (⟪ f ⟫ ∘′ alg) s) map-unfold s = inf (P.refl , λ where p .force → map-unfold _) agda-stdlib-1.1/src/Codata/Musical/000077500000000000000000000000001350553555600171215ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Musical/Cofin.agda000066400000000000000000000035471350553555600210060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- "Finite" sets indexed on coinductive "natural" numbers ------------------------------------------------------------------------ {-# OPTIONS --without-K --sized-types --guardedness #-} module Codata.Musical.Cofin where open import Codata.Musical.Notation open import Codata.Musical.Conat as Conat using (Coℕ; suc; ∞ℕ) open import Data.Nat.Base using (ℕ; zero; suc) open import Data.Fin using (Fin; zero; suc) open import Relation.Binary.PropositionalEquality using (_≡_ ; refl) open import Function ------------------------------------------------------------------------ -- The type -- Note that Cofin ∞ℕ is /not/ finite. Note also that this is not a -- coinductive type, but it is indexed on a coinductive type. data Cofin : Coℕ → Set where zero : ∀ {n} → Cofin (suc n) suc : ∀ {n} (i : Cofin (♭ n)) → Cofin (suc n) suc-injective : ∀ {m} {p q : Cofin (♭ m)} → (Cofin (suc m) ∋ suc p) ≡ suc q → p ≡ q suc-injective refl = refl ------------------------------------------------------------------------ -- Some operations fromℕ : ℕ → Cofin ∞ℕ fromℕ zero = zero fromℕ (suc n) = suc (fromℕ n) toℕ : ∀ {n} → Cofin n → ℕ toℕ zero = zero toℕ (suc i) = suc (toℕ i) fromFin : ∀ {n} → Fin n → Cofin (Conat.fromℕ n) fromFin zero = zero fromFin (suc i) = suc (fromFin i) toFin : ∀ n → Cofin (Conat.fromℕ n) → Fin n toFin (suc n) zero = zero toFin (suc n) (suc i) = suc (toFin n i) import Codata.Cofin as C fromMusical : ∀ {n} → Cofin n → C.Cofin (Conat.fromMusical n) fromMusical zero = C.zero fromMusical (suc n) = C.suc (fromMusical n) toMusical : ∀ {n} → C.Cofin n → Cofin (Conat.toMusical n) toMusical C.zero = zero toMusical (C.suc n) = suc (toMusical n) agda-stdlib-1.1/src/Codata/Musical/Colist.agda000066400000000000000000000457111350553555600212040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive lists ------------------------------------------------------------------------ {-# OPTIONS --without-K --sized-types --guardedness #-} module Codata.Musical.Colist where open import Category.Monad open import Codata.Musical.Notation open import Codata.Musical.Conat using (Coℕ; zero; suc) open import Data.Bool.Base using (Bool; true; false) open import Data.BoundedVec.Inefficient as BVec using (BoundedVec; []; _∷_) open import Data.Empty using (⊥) open import Data.Maybe using (Maybe; nothing; just; Is-just) open import Data.Maybe.Relation.Unary.Any using (just) open import Data.Nat.Base using (ℕ; zero; suc; _≥′_; ≤′-refl; ≤′-step) open import Data.Nat.Properties using (s≤′s) open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty using (List⁺; _∷_) open import Data.Product as Prod using (∃; _×_; _,_) open import Data.Sum as Sum using (_⊎_; inj₁; inj₂; [_,_]′) open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Inverse as Inv using (_↔_; _↔̇_; Inverse; inverse) open import Level using (_⊔_) open import Relation.Binary import Relation.Binary.Construct.FromRel as Ind import Relation.Binary.Reasoning.Preorder as PreR import Relation.Binary.Reasoning.PartialOrder as POR open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary open import Relation.Nullary.Negation module ¬¬Monad {p} where open RawMonad (¬¬-Monad {p}) public open ¬¬Monad -- we don't want the RawMonad content to be opened publicly ------------------------------------------------------------------------ -- The type infixr 5 _∷_ data Colist {a} (A : Set a) : Set a where [] : Colist A _∷_ : (x : A) (xs : ∞ (Colist A)) → Colist A {-# FOREIGN GHC data AgdaColist a = Nil | Cons a (MAlonzo.RTE.Inf (AgdaColist a)) type AgdaColist' l a = AgdaColist a #-} {-# COMPILE GHC Colist = data AgdaColist' (Nil | Cons) #-} {-# COMPILE UHC Colist = data __LIST__ (__NIL__ | __CONS__) #-} module Colist-injective {a} {A : Set a} where ∷-injectiveˡ : ∀ {x y : A} {xs ys} → (Colist A ∋ x ∷ xs) ≡ y ∷ ys → x ≡ y ∷-injectiveˡ P.refl = P.refl ∷-injectiveʳ : ∀ {x y : A} {xs ys} → (Colist A ∋ x ∷ xs) ≡ y ∷ ys → xs ≡ ys ∷-injectiveʳ P.refl = P.refl data Any {a p} {A : Set a} (P : A → Set p) : Colist A → Set (a ⊔ p) where here : ∀ {x xs} (px : P x) → Any P (x ∷ xs) there : ∀ {x xs} (pxs : Any P (♭ xs)) → Any P (x ∷ xs) module _ {a p} {A : Set a} {P : A → Set p} where here-injective : ∀ {x xs p q} → (Any P (x ∷ xs) ∋ here p) ≡ here q → p ≡ q here-injective P.refl = P.refl there-injective : ∀ {x xs p q} → (Any P (x ∷ xs) ∋ there p) ≡ there q → p ≡ q there-injective P.refl = P.refl data All {a p} {A : Set a} (P : A → Set p) : Colist A → Set (a ⊔ p) where [] : All P [] _∷_ : ∀ {x xs} (px : P x) (pxs : ∞ (All P (♭ xs))) → All P (x ∷ xs) module All-injective {a p} {A : Set a} {P : A → Set p} where ∷-injectiveˡ : ∀ {x xs} {px qx pxs qxs} → (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → px ≡ qx ∷-injectiveˡ P.refl = P.refl ∷-injectiveʳ : ∀ {x xs} {px qx pxs qxs} → (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → pxs ≡ qxs ∷-injectiveʳ P.refl = P.refl ------------------------------------------------------------------------ -- Some operations null : ∀ {a} {A : Set a} → Colist A → Bool null [] = true null (_ ∷ _) = false length : ∀ {a} {A : Set a} → Colist A → Coℕ length [] = zero length (x ∷ xs) = suc (♯ length (♭ xs)) map : ∀ {a b} {A : Set a} {B : Set b} → (A → B) → Colist A → Colist B map f [] = [] map f (x ∷ xs) = f x ∷ ♯ map f (♭ xs) fromList : ∀ {a} {A : Set a} → List A → Colist A fromList [] = [] fromList (x ∷ xs) = x ∷ ♯ fromList xs take : ∀ {a} {A : Set a} (n : ℕ) → Colist A → BoundedVec A n take zero xs = [] take (suc n) [] = [] take (suc n) (x ∷ xs) = x ∷ take n (♭ xs) replicate : ∀ {a} {A : Set a} → Coℕ → A → Colist A replicate zero x = [] replicate (suc n) x = x ∷ ♯ replicate (♭ n) x lookup : ∀ {a} {A : Set a} → ℕ → Colist A → Maybe A lookup n [] = nothing lookup zero (x ∷ xs) = just x lookup (suc n) (x ∷ xs) = lookup n (♭ xs) infixr 5 _++_ _++_ : ∀ {a} {A : Set a} → Colist A → Colist A → Colist A [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ ♯ (♭ xs ++ ys) -- Interleaves the two colists (until the shorter one, if any, has -- been exhausted). infixr 5 _⋎_ _⋎_ : ∀ {a} {A : Set a} → Colist A → Colist A → Colist A [] ⋎ ys = ys (x ∷ xs) ⋎ ys = x ∷ ♯ (ys ⋎ ♭ xs) concat : ∀ {a} {A : Set a} → Colist (List⁺ A) → Colist A concat [] = [] concat ((x ∷ []) ∷ xss) = x ∷ ♯ concat (♭ xss) concat ((x ∷ (y ∷ xs)) ∷ xss) = x ∷ ♯ concat ((y ∷ xs) ∷ xss) [_] : ∀ {a} {A : Set a} → A → Colist A [ x ] = x ∷ ♯ [] ------------------------------------------------------------------------ -- Any lemmas -- Any lemma for map. Any-map : ∀ {a b p} {A : Set a} {B : Set b} {P : B → Set p} {f : A → B} {xs} → Any P (map f xs) ↔ Any (P ∘ f) xs Any-map {P = P} {f} {xs} = inverse to from from∘to to∘from where to : ∀ {xs} → Any P (map f xs) → Any (P ∘ f) xs to {x ∷ xs} (here px) = here px to {x ∷ xs} (there p) = there (to p) from : ∀ {xs} → Any (P ∘ f) xs → Any P (map f xs) from (here px) = here px from (there p) = there (from p) from∘to : ∀ {xs} (p : Any P (map f xs)) → from (to p) ≡ p from∘to {x ∷ xs} (here px) = P.refl from∘to {x ∷ xs} (there p) = P.cong there (from∘to p) to∘from : ∀ {xs} (p : Any (P ∘ f) xs) → to (from p) ≡ p to∘from (here px) = P.refl to∘from (there p) = P.cong there (to∘from p) -- Any lemma for _⋎_. This lemma implies that every member of xs or ys -- is a member of xs ⋎ ys, and vice versa. Any-⋎ : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} → Any P (xs ⋎ ys) ↔ (Any P xs ⊎ Any P ys) Any-⋎ {P = P} = λ xs → record { to = P.→-to-⟶ (to xs) ; from = P.→-to-⟶ (from xs) ; inverse-of = record { left-inverse-of = from∘to xs ; right-inverse-of = to∘from xs } } where to : ∀ xs {ys} → Any P (xs ⋎ ys) → Any P xs ⊎ Any P ys to [] p = inj₂ p to (x ∷ xs) (here px) = inj₁ (here px) to (x ∷ xs) (there p) = [ inj₂ , inj₁ ∘ there ]′ (to _ p) mutual from-left : ∀ {xs ys} → Any P xs → Any P (xs ⋎ ys) from-left (here px) = here px from-left {ys = ys} (there p) = there (from-right ys p) from-right : ∀ xs {ys} → Any P ys → Any P (xs ⋎ ys) from-right [] p = p from-right (x ∷ xs) p = there (from-left p) from : ∀ xs {ys} → Any P xs ⊎ Any P ys → Any P (xs ⋎ ys) from xs = Sum.[ from-left , from-right xs ] from∘to : ∀ xs {ys} (p : Any P (xs ⋎ ys)) → from xs (to xs p) ≡ p from∘to [] p = P.refl from∘to (x ∷ xs) (here px) = P.refl from∘to (x ∷ xs) {ys = ys} (there p) with to ys p | from∘to ys p from∘to (x ∷ xs) {ys = ys} (there .(from-left q)) | inj₁ q | P.refl = P.refl from∘to (x ∷ xs) {ys = ys} (there .(from-right ys q)) | inj₂ q | P.refl = P.refl mutual to∘from-left : ∀ {xs ys} (p : Any P xs) → to xs {ys = ys} (from-left p) ≡ inj₁ p to∘from-left (here px) = P.refl to∘from-left {ys = ys} (there p) rewrite to∘from-right ys p = P.refl to∘from-right : ∀ xs {ys} (p : Any P ys) → to xs (from-right xs p) ≡ inj₂ p to∘from-right [] p = P.refl to∘from-right (x ∷ xs) {ys = ys} p rewrite to∘from-left {xs = ys} {ys = ♭ xs} p = P.refl to∘from : ∀ xs {ys} (p : Any P xs ⊎ Any P ys) → to xs (from xs p) ≡ p to∘from xs = Sum.[ to∘from-left , to∘from-right xs ] ------------------------------------------------------------------------ -- Equality -- xs ≈ ys means that xs and ys are equal. infix 4 _≈_ data _≈_ {a} {A : Set a} : (xs ys : Colist A) → Set a where [] : [] ≈ [] _∷_ : ∀ x {xs ys} (xs≈ : ∞ (♭ xs ≈ ♭ ys)) → x ∷ xs ≈ x ∷ ys -- The equality relation forms a setoid. setoid : ∀ {ℓ} → Set ℓ → Setoid _ _ setoid A = record { Carrier = Colist A ; _≈_ = _≈_ ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : Reflexive _≈_ refl {[]} = [] refl {x ∷ xs} = x ∷ ♯ refl sym : Symmetric _≈_ sym [] = [] sym (x ∷ xs≈) = x ∷ ♯ sym (♭ xs≈) trans : Transitive _≈_ trans [] [] = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) module ≈-Reasoning where import Relation.Binary.Reasoning.Setoid as EqR private open module R {a} {A : Set a} = EqR (setoid A) public -- map preserves equality. map-cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) → _≈_ =[ map f ]⇒ _≈_ map-cong f [] = [] map-cong f (x ∷ xs≈) = f x ∷ ♯ map-cong f (♭ xs≈) -- Any respects pointwise implication (for the predicate) and equality -- (for the colist). Any-resp : ∀ {a p q} {A : Set a} {P : A → Set p} {Q : A → Set q} {xs ys} → (∀ {x} → P x → Q x) → xs ≈ ys → Any P xs → Any Q ys Any-resp f (x ∷ xs≈) (here px) = here (f px) Any-resp f (x ∷ xs≈) (there p) = there (Any-resp f (♭ xs≈) p) -- Any maps pointwise isomorphic predicates and equal colists to -- isomorphic types. Any-cong : ∀ {a p q} {A : Set a} {P : A → Set p} {Q : A → Set q} {xs ys} → P ↔̇ Q → xs ≈ ys → Any P xs ↔ Any Q ys Any-cong {A = A} {P} {Q} {xs} {ys} P↔Q = λ xs≈ys → record { to = P.→-to-⟶ (to xs≈ys) ; from = P.→-to-⟶ (from xs≈ys) ; inverse-of = record { left-inverse-of = from∘to _ ; right-inverse-of = to∘from _ } } where open Setoid (setoid _) using (sym) to : ∀ {xs ys} → xs ≈ ys → Any P xs → Any Q ys to xs≈ys = Any-resp (Inverse.to P↔Q ⟨$⟩_) xs≈ys from : ∀ {xs ys} → xs ≈ ys → Any Q ys → Any P xs from xs≈ys = Any-resp (Inverse.from P↔Q ⟨$⟩_) (sym xs≈ys) to∘from : ∀ {xs ys} (xs≈ys : xs ≈ ys) (q : Any Q ys) → to xs≈ys (from xs≈ys q) ≡ q to∘from (x ∷ xs≈) (there q) = P.cong there (to∘from (♭ xs≈) q) to∘from (x ∷ xs≈) (here qx) = P.cong here (Inverse.right-inverse-of P↔Q qx) from∘to : ∀ {xs ys} (xs≈ys : xs ≈ ys) (p : Any P xs) → from xs≈ys (to xs≈ys p) ≡ p from∘to (x ∷ xs≈) (there p) = P.cong there (from∘to (♭ xs≈) p) from∘to (x ∷ xs≈) (here px) = P.cong here (Inverse.left-inverse-of P↔Q px) ------------------------------------------------------------------------ -- Indices -- Converts Any proofs to indices into the colist. The index can also -- be seen as the size of the proof. index : ∀ {a p} {A : Set a} {P : A → Set p} {xs} → Any P xs → ℕ index (here px) = zero index (there p) = suc (index p) -- The position returned by index is guaranteed to be within bounds. lookup-index : ∀ {a p} {A : Set a} {P : A → Set p} {xs} (p : Any P xs) → Is-just (lookup (index p) xs) lookup-index (here px) = just _ lookup-index (there p) = lookup-index p -- Any-resp preserves the index. index-Any-resp : ∀ {a p q} {A : Set a} {P : A → Set p} {Q : A → Set q} {f : ∀ {x} → P x → Q x} {xs ys} (xs≈ys : xs ≈ ys) (p : Any P xs) → index (Any-resp f xs≈ys p) ≡ index p index-Any-resp (x ∷ xs≈) (here px) = P.refl index-Any-resp (x ∷ xs≈) (there p) = P.cong suc (index-Any-resp (♭ xs≈) p) -- The left-to-right direction of Any-⋎ returns a proof whose size is -- no larger than that of the input proof. index-Any-⋎ : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} (p : Any P (xs ⋎ ys)) → index p ≥′ [ index , index ]′ (Inverse.to (Any-⋎ xs) ⟨$⟩ p) index-Any-⋎ [] p = ≤′-refl index-Any-⋎ (x ∷ xs) (here px) = ≤′-refl index-Any-⋎ (x ∷ xs) {ys = ys} (there p) with Inverse.to (Any-⋎ ys) ⟨$⟩ p | index-Any-⋎ ys p ... | inj₁ q | q≤p = ≤′-step q≤p ... | inj₂ q | q≤p = s≤′s q≤p ------------------------------------------------------------------------ -- Memberships, subsets, prefixes -- x ∈ xs means that x is a member of xs. infix 4 _∈_ _∈_ : ∀ {a} → {A : Set a} → A → Colist A → Set a x ∈ xs = Any (_≡_ x) xs -- xs ⊆ ys means that xs is a subset of ys. infix 4 _⊆_ _⊆_ : ∀ {a} → {A : Set a} → Colist A → Colist A → Set a xs ⊆ ys = ∀ {x} → x ∈ xs → x ∈ ys -- xs ⊑ ys means that xs is a prefix of ys. infix 4 _⊑_ data _⊑_ {a} {A : Set a} : Colist A → Colist A → Set a where [] : ∀ {ys} → [] ⊑ ys _∷_ : ∀ x {xs ys} (p : ∞ (♭ xs ⊑ ♭ ys)) → x ∷ xs ⊑ x ∷ ys -- Any can be expressed using _∈_ (and vice versa). Any-∈ : ∀ {a p} {A : Set a} {P : A → Set p} {xs} → Any P xs ↔ ∃ λ x → x ∈ xs × P x Any-∈ {P = P} = record { to = P.→-to-⟶ to ; from = P.→-to-⟶ (λ { (x , x∈xs , p) → from x∈xs p }) ; inverse-of = record { left-inverse-of = from∘to ; right-inverse-of = λ { (x , x∈xs , p) → to∘from x∈xs p } } } where to : ∀ {xs} → Any P xs → ∃ λ x → x ∈ xs × P x to (here p) = _ , here P.refl , p to (there p) = Prod.map id (Prod.map there id) (to p) from : ∀ {x xs} → x ∈ xs → P x → Any P xs from (here P.refl) p = here p from (there x∈xs) p = there (from x∈xs p) to∘from : ∀ {x xs} (x∈xs : x ∈ xs) (p : P x) → to (from x∈xs p) ≡ (x , x∈xs , p) to∘from (here P.refl) p = P.refl to∘from (there x∈xs) p = P.cong (Prod.map id (Prod.map there id)) (to∘from x∈xs p) from∘to : ∀ {xs} (p : Any P xs) → let (x , x∈xs , px) = to p in from x∈xs px ≡ p from∘to (here _) = P.refl from∘to (there p) = P.cong there (from∘to p) -- Prefixes are subsets. ⊑⇒⊆ : ∀ {a} → {A : Set a} → _⊑_ {A = A} ⇒ _⊆_ ⊑⇒⊆ (x ∷ xs⊑ys) (here ≡x) = here ≡x ⊑⇒⊆ (_ ∷ xs⊑ys) (there x∈xs) = there (⊑⇒⊆ (♭ xs⊑ys) x∈xs) -- The prefix relation forms a poset. ⊑-Poset : ∀ {ℓ} → Set ℓ → Poset _ _ _ ⊑-Poset A = record { Carrier = Colist A ; _≈_ = _≈_ ; _≤_ = _⊑_ ; isPartialOrder = record { isPreorder = record { isEquivalence = Setoid.isEquivalence (setoid A) ; reflexive = reflexive ; trans = trans } ; antisym = antisym } } where reflexive : _≈_ ⇒ _⊑_ reflexive [] = [] reflexive (x ∷ xs≈) = x ∷ ♯ reflexive (♭ xs≈) trans : Transitive _⊑_ trans [] _ = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) tail : ∀ {x xs y ys} → x ∷ xs ⊑ y ∷ ys → ♭ xs ⊑ ♭ ys tail (_ ∷ p) = ♭ p antisym : Antisymmetric _≈_ _⊑_ antisym [] [] = [] antisym (x ∷ p₁) p₂ = x ∷ ♯ antisym (♭ p₁) (tail p₂) module ⊑-Reasoning where private open module R {a} {A : Set a} = POR (⊑-Poset A) public renaming (_≤⟨_⟩_ to _⊑⟨_⟩_) -- The subset relation forms a preorder. ⊆-Preorder : ∀ {ℓ} → Set ℓ → Preorder _ _ _ ⊆-Preorder A = Ind.preorder (setoid A) _∈_ (λ xs≈ys → ⊑⇒⊆ (⊑P.reflexive xs≈ys)) where module ⊑P = Poset (⊑-Poset A) module ⊆-Reasoning where private open module R {a} {A : Set a} = PreR (⊆-Preorder A) public renaming (_∼⟨_⟩_ to _⊆⟨_⟩_) infix 1 _∈⟨_⟩_ _∈⟨_⟩_ : ∀ {a} {A : Set a} (x : A) {xs ys} → x ∈ xs → xs IsRelatedTo ys → x ∈ ys x ∈⟨ x∈xs ⟩ xs⊆ys = (begin xs⊆ys) x∈xs -- take returns a prefix. take-⊑ : ∀ {a} {A : Set a} n (xs : Colist A) → let toColist = fromList {a} ∘ BVec.toList in toColist (take n xs) ⊑ xs take-⊑ zero xs = [] take-⊑ (suc n) [] = [] take-⊑ (suc n) (x ∷ xs) = x ∷ ♯ take-⊑ n (♭ xs) ------------------------------------------------------------------------ -- Finiteness and infiniteness -- Finite xs means that xs has finite length. data Finite {a} {A : Set a} : Colist A → Set a where [] : Finite [] _∷_ : ∀ x {xs} (fin : Finite (♭ xs)) → Finite (x ∷ xs) module Finite-injective {a} {A : Set a} where ∷-injective : ∀ {x : A} {xs p q} → (Finite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ∷-injective P.refl = P.refl -- Infinite xs means that xs has infinite length. data Infinite {a} {A : Set a} : Colist A → Set a where _∷_ : ∀ x {xs} (inf : ∞ (Infinite (♭ xs))) → Infinite (x ∷ xs) module Infinite-injective {a} {A : Set a} where ∷-injective : ∀ {x : A} {xs p q} → (Infinite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ∷-injective P.refl = P.refl -- Colists which are not finite are infinite. not-finite-is-infinite : ∀ {a} {A : Set a} (xs : Colist A) → ¬ Finite xs → Infinite xs not-finite-is-infinite [] hyp = contradiction [] hyp not-finite-is-infinite (x ∷ xs) hyp = x ∷ ♯ not-finite-is-infinite (♭ xs) (hyp ∘ _∷_ x) -- Colists are either finite or infinite (classically). finite-or-infinite : ∀ {a} {A : Set a} (xs : Colist A) → ¬ ¬ (Finite xs ⊎ Infinite xs) finite-or-infinite xs = helper <$> excluded-middle where helper : Dec (Finite xs) → Finite xs ⊎ Infinite xs helper (yes fin) = inj₁ fin helper (no ¬fin) = inj₂ $ not-finite-is-infinite xs ¬fin -- Colists are not both finite and infinite. not-finite-and-infinite : ∀ {a} {A : Set a} {xs : Colist A} → Finite xs → Infinite xs → ⊥ not-finite-and-infinite (x ∷ fin) (.x ∷ inf) = not-finite-and-infinite fin (♭ inf) ------------------------------------------------------------------------ -- Legacy import Codata.Colist as C open import Codata.Thunk import Size module _ {a} {A : Set a} where fromMusical : ∀ {i} → Colist A → C.Colist A i fromMusical [] = C.[] fromMusical (x ∷ xs) = x C.∷ λ where .force → fromMusical (♭ xs) toMusical : C.Colist A Size.∞ → Colist A toMusical C.[] = [] toMusical (x C.∷ xs) = x ∷ ♯ toMusical (xs .force) agda-stdlib-1.1/src/Codata/Musical/Colist/000077500000000000000000000000001350553555600203565ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Musical/Colist/Infinite-merge.agda000066400000000000000000000202541350553555600240410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Infinite merge operation for coinductive lists ------------------------------------------------------------------------ {-# OPTIONS --without-K --guardedness #-} module Codata.Musical.Colist.Infinite-merge where open import Codata.Musical.Notation open import Codata.Musical.Colist as Colist hiding (_⋎_) open import Data.Nat open import Data.Nat.Induction using (<′-wellFounded) open import Data.Nat.Properties open import Data.Product as Prod open import Data.Sum open import Data.Sum.Properties open import Data.Sum.Function.Propositional using (_⊎-cong_) open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Inverse as Inv using (_↔_; Inverse; inverse) import Function.Related as Related open import Function.Related.TypeIsomorphisms import Induction.WellFounded as WF open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Some code that is used to work around Agda's syntactic guardedness -- checker. private infixr 5 _∷_ _⋎_ data ColistP {a} (A : Set a) : Set a where [] : ColistP A _∷_ : A → ∞ (ColistP A) → ColistP A _⋎_ : ColistP A → ColistP A → ColistP A data ColistW {a} (A : Set a) : Set a where [] : ColistW A _∷_ : A → ColistP A → ColistW A program : ∀ {a} {A : Set a} → Colist A → ColistP A program [] = [] program (x ∷ xs) = x ∷ ♯ program (♭ xs) mutual _⋎W_ : ∀ {a} {A : Set a} → ColistW A → ColistP A → ColistW A [] ⋎W ys = whnf ys (x ∷ xs) ⋎W ys = x ∷ (ys ⋎ xs) whnf : ∀ {a} {A : Set a} → ColistP A → ColistW A whnf [] = [] whnf (x ∷ xs) = x ∷ ♭ xs whnf (xs ⋎ ys) = whnf xs ⋎W ys mutual ⟦_⟧P : ∀ {a} {A : Set a} → ColistP A → Colist A ⟦ xs ⟧P = ⟦ whnf xs ⟧W ⟦_⟧W : ∀ {a} {A : Set a} → ColistW A → Colist A ⟦ [] ⟧W = [] ⟦ x ∷ xs ⟧W = x ∷ ♯ ⟦ xs ⟧P mutual ⋎-homP : ∀ {a} {A : Set a} (xs : ColistP A) {ys} → ⟦ xs ⋎ ys ⟧P ≈ ⟦ xs ⟧P Colist.⋎ ⟦ ys ⟧P ⋎-homP xs = ⋎-homW (whnf xs) _ ⋎-homW : ∀ {a} {A : Set a} (xs : ColistW A) ys → ⟦ xs ⋎W ys ⟧W ≈ ⟦ xs ⟧W Colist.⋎ ⟦ ys ⟧P ⋎-homW (x ∷ xs) ys = x ∷ ♯ ⋎-homP ys ⋎-homW [] ys = begin ⟦ ys ⟧P ∎ where open ≈-Reasoning ⟦program⟧P : ∀ {a} {A : Set a} (xs : Colist A) → ⟦ program xs ⟧P ≈ xs ⟦program⟧P [] = [] ⟦program⟧P (x ∷ xs) = x ∷ ♯ ⟦program⟧P (♭ xs) Any-⋎P : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} → Any P ⟦ program xs ⋎ ys ⟧P ↔ (Any P xs ⊎ Any P ⟦ ys ⟧P) Any-⋎P {P = P} xs {ys} = Any P ⟦ program xs ⋎ ys ⟧P ↔⟨ Any-cong Inv.id (⋎-homP (program xs)) ⟩ Any P (⟦ program xs ⟧P Colist.⋎ ⟦ ys ⟧P) ↔⟨ Any-⋎ _ ⟩ (Any P ⟦ program xs ⟧P ⊎ Any P ⟦ ys ⟧P) ↔⟨ Any-cong Inv.id (⟦program⟧P _) ⊎-cong (_ ∎) ⟩ (Any P xs ⊎ Any P ⟦ ys ⟧P) ∎ where open Related.EquationalReasoning index-Any-⋎P : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} (p : Any P ⟦ program xs ⋎ ys ⟧P) → index p ≥′ [ index , index ]′ (Inverse.to (Any-⋎P xs) ⟨$⟩ p) index-Any-⋎P xs p with Any-resp id (⋎-homW (whnf (program xs)) _) p | index-Any-resp {f = id} (⋎-homW (whnf (program xs)) _) p index-Any-⋎P xs p | q | q≡p with Inverse.to (Any-⋎ ⟦ program xs ⟧P) ⟨$⟩ q | index-Any-⋎ ⟦ program xs ⟧P q index-Any-⋎P xs p | q | q≡p | inj₂ r | r≤q rewrite q≡p = r≤q index-Any-⋎P xs p | q | q≡p | inj₁ r | r≤q with Any-resp id (⟦program⟧P xs) r | index-Any-resp {f = id} (⟦program⟧P xs) r index-Any-⋎P xs p | q | q≡p | inj₁ r | r≤q | s | s≡r rewrite s≡r | q≡p = r≤q ------------------------------------------------------------------------ -- Infinite variant of _⋎_. private merge′ : ∀ {a} {A : Set a} → Colist (A × Colist A) → ColistP A merge′ [] = [] merge′ ((x , xs) ∷ xss) = x ∷ ♯ (program xs ⋎ merge′ (♭ xss)) merge : ∀ {a} {A : Set a} → Colist (A × Colist A) → Colist A merge xss = ⟦ merge′ xss ⟧P ------------------------------------------------------------------------ -- Any lemma for merge. module _ {a p} {A : Set a} {P : A → Set p} where Any-merge : ∀ xss → Any P (merge xss) ↔ Any (λ { (x , xs) → P x ⊎ Any P xs }) xss Any-merge xss = inverse (proj₁ ∘ to xss) from (proj₂ ∘ to xss) to∘from where open P.≡-Reasoning -- The from function. Q = λ { (x , xs) → P x ⊎ Any P xs } from : ∀ {xss} → Any Q xss → Any P (merge xss) from (here (inj₁ p)) = here p from (here (inj₂ p)) = there (Inverse.from (Any-⋎P _) ⟨$⟩ inj₁ p) from (there {x = _ , xs} p) = there (Inverse.from (Any-⋎P xs) ⟨$⟩ inj₂ (from p)) -- The from function is injective. from-injective : ∀ {xss} (p₁ p₂ : Any Q xss) → from p₁ ≡ from p₂ → p₁ ≡ p₂ from-injective (here (inj₁ p)) (here (inj₁ .p)) P.refl = P.refl from-injective (here (inj₂ p₁)) (here (inj₂ p₂)) eq = P.cong (here ∘ inj₂) $ inj₁-injective $ Inverse.injective (Inv.sym (Any-⋎P _)) {x = inj₁ p₁} {y = inj₁ p₂} $ there-injective eq from-injective (here (inj₂ p₁)) (there p₂) eq with Inverse.injective (Inv.sym (Any-⋎P _)) {x = inj₁ p₁} {y = inj₂ (from p₂)} (there-injective eq) ... | () from-injective (there p₁) (here (inj₂ p₂)) eq with Inverse.injective (Inv.sym (Any-⋎P _)) {x = inj₂ (from p₁)} {y = inj₁ p₂} (there-injective eq) ... | () from-injective (there {x = _ , xs} p₁) (there p₂) eq = P.cong there $ from-injective p₁ p₂ $ inj₂-injective $ Inverse.injective (Inv.sym (Any-⋎P xs)) {x = inj₂ (from p₁)} {y = inj₂ (from p₂)} $ there-injective eq -- The to function (defined as a right inverse of from). Input = ∃ λ xss → Any P (merge xss) Pred : Input → Set _ Pred (xss , p) = ∃ λ (q : Any Q xss) → from q ≡ p to : ∀ xss p → Pred (xss , p) to = λ xss p → WF.All.wfRec (WF.InverseImage.wellFounded size <′-wellFounded) _ Pred step (xss , p) where size : Input → ℕ size (_ , p) = index p step : ∀ p → WF.WfRec (_<′_ on size) Pred p → Pred p step ([] , ()) rec step ((x , xs) ∷ xss , here p) rec = here (inj₁ p) , P.refl step ((x , xs) ∷ xss , there p) rec with Inverse.to (Any-⋎P xs) ⟨$⟩ p | Inverse.left-inverse-of (Any-⋎P xs) p | index-Any-⋎P xs p ... | inj₁ q | P.refl | _ = here (inj₂ q) , P.refl ... | inj₂ q | P.refl | q≤p = Prod.map there (P.cong (there ∘ _⟨$⟩_ (Inverse.from (Any-⋎P xs)) ∘ inj₂)) (rec (♭ xss , q) (s≤′s q≤p)) to∘from = λ p → from-injective _ _ (proj₂ (to xss (from p))) -- Every member of xss is a member of merge xss, and vice versa (with -- equal multiplicities). ∈-merge : ∀ {a} {A : Set a} {y : A} xss → y ∈ merge xss ↔ ∃₂ λ x xs → (x , xs) ∈ xss × (y ≡ x ⊎ y ∈ xs) ∈-merge {y = y} xss = y ∈ merge xss ↔⟨ Any-merge _ ⟩ Any (λ { (x , xs) → y ≡ x ⊎ y ∈ xs }) xss ↔⟨ Any-∈ ⟩ (∃ λ { (x , xs) → (x , xs) ∈ xss × (y ≡ x ⊎ y ∈ xs) }) ↔⟨ Σ-assoc ⟩ (∃₂ λ x xs → (x , xs) ∈ xss × (y ≡ x ⊎ y ∈ xs)) ∎ where open Related.EquationalReasoning agda-stdlib-1.1/src/Codata/Musical/Conat.agda000066400000000000000000000052151350553555600210060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive "natural" numbers ------------------------------------------------------------------------ {-# OPTIONS --without-K --guardedness --sized-types #-} module Codata.Musical.Conat where open import Codata.Musical.Notation open import Data.Nat.Base using (ℕ; zero; suc) open import Function open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- The type data Coℕ : Set where zero : Coℕ suc : (n : ∞ Coℕ) → Coℕ module Coℕ-injective where suc-injective : ∀ {m n} → (Coℕ ∋ suc m) ≡ suc n → m ≡ n suc-injective P.refl = P.refl ------------------------------------------------------------------------ -- Some operations pred : Coℕ → Coℕ pred zero = zero pred (suc n) = ♭ n fromℕ : ℕ → Coℕ fromℕ zero = zero fromℕ (suc n) = suc (♯ fromℕ n) fromℕ-injective : ∀ {m n} → fromℕ m ≡ fromℕ n → m ≡ n fromℕ-injective {zero} {zero} eq = P.refl fromℕ-injective {suc m} {suc n} eq = P.cong suc (fromℕ-injective (P.cong pred eq)) ∞ℕ : Coℕ ∞ℕ = suc (♯ ∞ℕ) infixl 6 _+_ _+_ : Coℕ → Coℕ → Coℕ zero + n = n suc m + n = suc (♯ (♭ m + n)) ------------------------------------------------------------------------ -- Equality data _≈_ : Coℕ → Coℕ → Set where zero : zero ≈ zero suc : ∀ {m n} (m≈n : ∞ (♭ m ≈ ♭ n)) → suc m ≈ suc n module ≈-injective where suc-injective : ∀ {m n p q} → (suc m ≈ suc n ∋ suc p) ≡ suc q → p ≡ q suc-injective P.refl = P.refl setoid : Setoid _ _ setoid = record { Carrier = Coℕ ; _≈_ = _≈_ ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : Reflexive _≈_ refl {zero} = zero refl {suc n} = suc (♯ refl) sym : Symmetric _≈_ sym zero = zero sym (suc m≈n) = suc (♯ sym (♭ m≈n)) trans : Transitive _≈_ trans zero zero = zero trans (suc m≈n) (suc n≈k) = suc (♯ trans (♭ m≈n) (♭ n≈k)) ------------------------------------------------------------------------ -- Legacy import Codata.Conat as C open import Codata.Thunk import Size fromMusical : ∀ {i} → Coℕ → C.Conat i fromMusical zero = C.zero fromMusical (suc n) = C.suc λ where .force → fromMusical (♭ n) toMusical : C.Conat Size.∞ → Coℕ toMusical C.zero = zero toMusical (C.suc n) = suc (♯ toMusical (n .force)) agda-stdlib-1.1/src/Codata/Musical/Costring.agda000066400000000000000000000011301350553555600215220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Costrings ------------------------------------------------------------------------ {-# OPTIONS --without-K #-} module Codata.Musical.Costring where open import Codata.Musical.Colist as Colist using (Colist) open import Data.Char using (Char) open import Data.String as String using (String) open import Function using (_∘_) -- Possibly infinite strings. Costring : Set Costring = Colist Char -- Methods toCostring : String → Costring toCostring = Colist.fromList ∘ String.toList agda-stdlib-1.1/src/Codata/Musical/Covec.agda000066400000000000000000000140431350553555600210000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive vectors ------------------------------------------------------------------------ {-# OPTIONS --without-K --guardedness --sized-types #-} module Codata.Musical.Covec where open import Codata.Musical.Notation open import Codata.Musical.Conat as Coℕ using (Coℕ; zero; suc; _+_) open import Codata.Musical.Cofin using (Cofin; zero; suc) open import Codata.Musical.Colist as Colist using (Colist; []; _∷_) open import Data.Nat.Base using (ℕ; zero; suc) open import Data.Vec using (Vec; []; _∷_) open import Data.Product using (_,_) open import Function using (_∋_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- The type infixr 5 _∷_ data Covec {a} (A : Set a) : Coℕ → Set a where [] : Covec A zero _∷_ : ∀ {n} (x : A) (xs : ∞ (Covec A (♭ n))) → Covec A (suc n) module _ {a} {A : Set a} where ∷-injectiveˡ : ∀ {a b} {n} {as bs} → (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → a ≡ b ∷-injectiveˡ P.refl = P.refl ∷-injectiveʳ : ∀ {a b} {n} {as bs} → (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → as ≡ bs ∷-injectiveʳ P.refl = P.refl ------------------------------------------------------------------------ -- Some operations map : ∀ {a b} {A : Set a} {B : Set b} {n} → (A → B) → Covec A n → Covec B n map f [] = [] map f (x ∷ xs) = f x ∷ ♯ map f (♭ xs) module _ {a} {A : Set a} where fromVec : ∀ {n} → Vec A n → Covec A (Coℕ.fromℕ n) fromVec [] = [] fromVec (x ∷ xs) = x ∷ ♯ fromVec xs fromColist : (xs : Colist A) → Covec A (Colist.length xs) fromColist [] = [] fromColist (x ∷ xs) = x ∷ ♯ fromColist (♭ xs) take : ∀ m {n} → Covec A (m + n) → Covec A m take zero xs = [] take (suc n) (x ∷ xs) = x ∷ ♯ take (♭ n) (♭ xs) drop : ∀ m {n} → Covec A (Coℕ.fromℕ m + n) → Covec A n drop zero xs = xs drop (suc n) (x ∷ xs) = drop n (♭ xs) replicate : ∀ n → A → Covec A n replicate zero x = [] replicate (suc n) x = x ∷ ♯ replicate (♭ n) x lookup : ∀ {n} → Cofin n → Covec A n → A lookup zero (x ∷ xs) = x lookup (suc n) (x ∷ xs) = lookup n (♭ xs) infixr 5 _++_ _++_ : ∀ {m n} → Covec A m → Covec A n → Covec A (m + n) [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ ♯ (♭ xs ++ ys) [_] : A → Covec A (suc (♯ zero)) [ x ] = x ∷ ♯ [] ------------------------------------------------------------------------ -- Equality and other relations -- xs ≈ ys means that xs and ys are equal. infix 4 _≈_ data _≈_ : ∀ {n} (xs ys : Covec A n) → Set a where [] : [] ≈ [] _∷_ : ∀ {n} x {xs ys} (xs≈ : ∞ (♭ xs ≈ ♭ ys)) → _≈_ {n = suc n} (x ∷ xs) (x ∷ ys) -- x ∈ xs means that x is a member of xs. infix 4 _∈_ data _∈_ : ∀ {n} → A → Covec A n → Set a where here : ∀ {n x } {xs} → _∈_ {n = suc n} x (x ∷ xs) there : ∀ {n x y} {xs} (x∈xs : x ∈ ♭ xs) → _∈_ {n = suc n} x (y ∷ xs) -- xs ⊑ ys means that xs is a prefix of ys. infix 4 _⊑_ data _⊑_ : ∀ {m n} → Covec A m → Covec A n → Set a where [] : ∀ {n} {ys : Covec A n} → [] ⊑ ys _∷_ : ∀ {m n} x {xs ys} (p : ∞ (♭ xs ⊑ ♭ ys)) → _⊑_ {m = suc m} {suc n} (x ∷ xs) (x ∷ ys) ------------------------------------------------------------------------ -- Some proofs setoid : ∀ {a} → Set a → Coℕ → Setoid _ _ setoid A n = record { Carrier = Covec A n ; _≈_ = _≈_ ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : ∀ {n} → Reflexive (_≈_ {n = n}) refl {x = []} = [] refl {x = x ∷ xs} = x ∷ ♯ refl sym : ∀ {n} → Symmetric (_≈_ {A = A} {n}) sym [] = [] sym (x ∷ xs≈) = x ∷ ♯ sym (♭ xs≈) trans : ∀ {n} → Transitive (_≈_ {A = A} {n}) trans [] [] = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) poset : ∀ {a} → Set a → Coℕ → Poset _ _ _ poset A n = record { Carrier = Covec A n ; _≈_ = _≈_ ; _≤_ = _⊑_ ; isPartialOrder = record { isPreorder = record { isEquivalence = Setoid.isEquivalence (setoid A n) ; reflexive = reflexive ; trans = trans } ; antisym = antisym } } where reflexive : ∀ {n} → _≈_ {n = n} ⇒ _⊑_ reflexive [] = [] reflexive (x ∷ xs≈) = x ∷ ♯ reflexive (♭ xs≈) trans : ∀ {n} → Transitive (_⊑_ {n = n}) trans [] _ = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) tail : ∀ {n x y xs ys} → _∷_ {n = n} x xs ⊑ _∷_ {n = n} y ys → ♭ xs ⊑ ♭ ys tail (_ ∷ p) = ♭ p antisym : ∀ {n} → Antisymmetric (_≈_ {n = n}) _⊑_ antisym [] [] = [] antisym (x ∷ p₁) p₂ = x ∷ ♯ antisym (♭ p₁) (tail p₂) map-cong : ∀ {a b} {A : Set a} {B : Set b} {n} (f : A → B) → _≈_ {n = n} =[ map f ]⇒ _≈_ map-cong f [] = [] map-cong f (x ∷ xs≈) = f x ∷ ♯ map-cong f (♭ xs≈) take-⊑ : ∀ {a} {A : Set a} m {n} (xs : Covec A (m + n)) → take m xs ⊑ xs take-⊑ zero xs = [] take-⊑ (suc n) (x ∷ xs) = x ∷ ♯ take-⊑ (♭ n) (♭ xs) ------------------------------------------------------------------------ -- Legacy import Codata.Covec as C open import Codata.Thunk import Size module _ {a} {A : Set a} where fromMusical : ∀ {i n} → Covec A n → C.Covec A i (Coℕ.fromMusical n) fromMusical [] = C.[] fromMusical (x ∷ xs) = x C.∷ λ where .force → fromMusical (♭ xs) toMusical : ∀ {n} → C.Covec A Size.∞ n → Covec A (Coℕ.toMusical n) toMusical C.[] = [] toMusical (x C.∷ xs) = x ∷ ♯ toMusical (xs .force) agda-stdlib-1.1/src/Codata/Musical/M.agda000066400000000000000000000032411350553555600201330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- M-types (the dual of W-types) ------------------------------------------------------------------------ {-# OPTIONS --without-K --guardedness --sized-types #-} module Codata.Musical.M where open import Codata.Musical.Notation open import Level open import Data.Product hiding (map) open import Data.Container.Core as C hiding (map) -- The family of M-types. data M {s p} (C : Container s p) : Set (s ⊔ p) where inf : ⟦ C ⟧ (∞ (M C)) → M C -- Projections. module _ {s p} (C : Container s p) where head : M C → Shape C head (inf (x , _)) = x tail : (x : M C) → Position C (head x) → M C tail (inf (x , f)) b = ♭ (f b) -- map module _ {s₁ s₂ p₁ p₂} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} (m : C₁ ⇒ C₂) where map : M C₁ → M C₂ map (inf (x , f)) = inf (shape m x , λ p → ♯ map (♭ (f (position m p)))) -- unfold module _ {s p ℓ} {C : Container s p} (open Container C) {S : Set ℓ} (alg : S → ⟦ C ⟧ S) where unfold : S → M C unfold seed = let (x , f) = alg seed in inf (x , λ p → ♯ unfold (f p)) ------------------------------------------------------------------------ -- Legacy import Codata.M as M open import Codata.Thunk import Size module _ {s p} {C : Container s p} where fromMusical : ∀ {i} → M C → M.M C i fromMusical (inf t) = M.inf (C.map rec t) where rec = λ x → λ where .force → fromMusical (♭ x) toMusical : M.M C Size.∞ → M C toMusical (M.inf (s , f)) = inf (s , λ p → ♯ toMusical (f p .force)) agda-stdlib-1.1/src/Codata/Musical/M/000077500000000000000000000000001350553555600173155ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Musical/M/Indexed.agda000066400000000000000000000022111350553555600215070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed M-types (the dual of indexed W-types aka Petersson-Synek -- trees). ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --guardedness #-} module Codata.Musical.M.Indexed where open import Level open import Codata.Musical.Notation open import Data.Product open import Data.Container.Indexed.Core open import Function open import Relation.Unary -- The family of indexed M-types. module _ {ℓ c r} {O : Set ℓ} (C : Container O O c r) where data M (o : O) : Set (ℓ ⊔ c ⊔ r) where inf : ⟦ C ⟧ (∞ ∘ M) o → M o open Container C -- Projections. head : M ⊆ Command head (inf (c , _)) = c tail : ∀ {o} (m : M o) (r : Response (head m)) → M (next (head m) r) tail (inf (_ , k)) r = ♭ (k r) force : M ⊆ ⟦ C ⟧ M force (inf (c , k)) = c , λ r → ♭ (k r) -- Coiteration. coit : ∀ {ℓ} {X : Pred O ℓ} → X ⊆ ⟦ C ⟧ X → X ⊆ M coit ψ x = inf (proj₁ cs , λ r → ♯ coit ψ (proj₂ cs r)) where cs = ψ x agda-stdlib-1.1/src/Codata/Musical/Notation.agda000066400000000000000000000005171350553555600215350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic types related to coinduction ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Codata.Musical.Notation where open import Agda.Builtin.Coinduction public agda-stdlib-1.1/src/Codata/Musical/Stream.agda000066400000000000000000000132721350553555600211770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Streams ------------------------------------------------------------------------ {-# OPTIONS --without-K --sized-types --guardedness #-} module Codata.Musical.Stream where open import Codata.Musical.Notation open import Codata.Musical.Colist using (Colist; []; _∷_) open import Data.Vec using (Vec; []; _∷_) open import Data.Nat.Base using (ℕ; zero; suc) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- The type infixr 5 _∷_ data Stream {a} (A : Set a) : Set a where _∷_ : (x : A) (xs : ∞ (Stream A)) → Stream A {-# FOREIGN GHC data AgdaStream a = Cons a (MAlonzo.RTE.Inf (AgdaStream a)) type AgdaStream' l a = AgdaStream a #-} {-# COMPILE GHC Stream = data AgdaStream' (Cons) #-} ------------------------------------------------------------------------ -- Some operations head : ∀ {a} {A : Set a} → Stream A → A head (x ∷ xs) = x tail : ∀ {a} {A : Set a} → Stream A → Stream A tail (x ∷ xs) = ♭ xs map : ∀ {a b} {A : Set a} {B : Set b} → (A → B) → Stream A → Stream B map f (x ∷ xs) = f x ∷ ♯ map f (♭ xs) zipWith : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} → (A → B → C) → Stream A → Stream B → Stream C zipWith _∙_ (x ∷ xs) (y ∷ ys) = (x ∙ y) ∷ ♯ zipWith _∙_ (♭ xs) (♭ ys) take : ∀ {a} {A : Set a} n → Stream A → Vec A n take zero xs = [] take (suc n) (x ∷ xs) = x ∷ take n (♭ xs) drop : ∀ {a} {A : Set a} → ℕ → Stream A → Stream A drop zero xs = xs drop (suc n) (x ∷ xs) = drop n (♭ xs) repeat : ∀ {a} {A : Set a} → A → Stream A repeat x = x ∷ ♯ repeat x iterate : ∀ {a} {A : Set a} → (A → A) → A → Stream A iterate f x = x ∷ ♯ iterate f (f x) -- Interleaves the two streams. infixr 5 _⋎_ _⋎_ : ∀ {a} {A : Set a} → Stream A → Stream A → Stream A (x ∷ xs) ⋎ ys = x ∷ ♯ (ys ⋎ ♭ xs) mutual -- Takes every other element from the stream, starting with the -- first one. evens : ∀ {a} {A : Set a} → Stream A → Stream A evens (x ∷ xs) = x ∷ ♯ odds (♭ xs) -- Takes every other element from the stream, starting with the -- second one. odds : ∀ {a} {A : Set a} → Stream A → Stream A odds (x ∷ xs) = evens (♭ xs) toColist : ∀ {a} {A : Set a} → Stream A → Colist A toColist (x ∷ xs) = x ∷ ♯ toColist (♭ xs) lookup : ∀ {a} {A : Set a} → ℕ → Stream A → A lookup zero (x ∷ xs) = x lookup (suc n) (x ∷ xs) = lookup n (♭ xs) infixr 5 _++_ _++_ : ∀ {a} {A : Set a} → Colist A → Stream A → Stream A [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ ♯ (♭ xs ++ ys) ------------------------------------------------------------------------ -- Equality and other relations -- xs ≈ ys means that xs and ys are equal. infix 4 _≈_ data _≈_ {a} {A : Set a} : Stream A → Stream A → Set a where _∷_ : ∀ {x y xs ys} (x≡ : x ≡ y) (xs≈ : ∞ (♭ xs ≈ ♭ ys)) → x ∷ xs ≈ y ∷ ys -- x ∈ xs means that x is a member of xs. infix 4 _∈_ data _∈_ {a} {A : Set a} : A → Stream A → Set a where here : ∀ {x xs} → x ∈ x ∷ xs there : ∀ {x y xs} (x∈xs : x ∈ ♭ xs) → x ∈ y ∷ xs -- xs ⊑ ys means that xs is a prefix of ys. infix 4 _⊑_ data _⊑_ {a} {A : Set a} : Colist A → Stream A → Set a where [] : ∀ {ys} → [] ⊑ ys _∷_ : ∀ x {xs ys} (p : ∞ (♭ xs ⊑ ♭ ys)) → x ∷ xs ⊑ x ∷ ys ------------------------------------------------------------------------ -- Some proofs setoid : ∀ {a} → Set a → Setoid _ _ setoid A = record { Carrier = Stream A ; _≈_ = _≈_ {A = A} ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : Reflexive _≈_ refl {_ ∷ _} = P.refl ∷ ♯ refl sym : Symmetric _≈_ sym (x≡ ∷ xs≈) = P.sym x≡ ∷ ♯ sym (♭ xs≈) trans : Transitive _≈_ trans (x≡ ∷ xs≈) (y≡ ∷ ys≈) = P.trans x≡ y≡ ∷ ♯ trans (♭ xs≈) (♭ ys≈) head-cong : ∀ {a} {A : Set a} {xs ys : Stream A} → xs ≈ ys → head xs ≡ head ys head-cong (x≡ ∷ _) = x≡ tail-cong : ∀ {a} {A : Set a} {xs ys : Stream A} → xs ≈ ys → tail xs ≈ tail ys tail-cong (_ ∷ xs≈) = ♭ xs≈ map-cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {xs ys} → xs ≈ ys → map f xs ≈ map f ys map-cong f (x≡ ∷ xs≈) = P.cong f x≡ ∷ ♯ map-cong f (♭ xs≈) zipWith-cong : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} (_∙_ : A → B → C) {xs xs′ ys ys′} → xs ≈ xs′ → ys ≈ ys′ → zipWith _∙_ xs ys ≈ zipWith _∙_ xs′ ys′ zipWith-cong _∙_ (x≡ ∷ xs≈) (y≡ ∷ ys≈) = P.cong₂ _∙_ x≡ y≡ ∷ ♯ zipWith-cong _∙_ (♭ xs≈) (♭ ys≈) infixr 5 _⋎-cong_ _⋎-cong_ : ∀ {a} {A : Set a} {xs xs′ ys ys′ : Stream A} → xs ≈ xs′ → ys ≈ ys′ → xs ⋎ ys ≈ xs′ ⋎ ys′ (x ∷ xs≈) ⋎-cong ys≈ = x ∷ ♯ (ys≈ ⋎-cong ♭ xs≈) ------------------------------------------------------------------------ -- Legacy import Codata.Stream as S open import Codata.Thunk import Size module _ {a} {A : Set a} where fromMusical : ∀ {i} → Stream A → S.Stream A i fromMusical (x ∷ xs) = x S.∷ λ where .force → fromMusical (♭ xs) toMusical : S.Stream A Size.∞ → Stream A toMusical (x S.∷ xs) = x ∷ ♯ toMusical (xs .force) agda-stdlib-1.1/src/Codata/Stream.agda000066400000000000000000000070431350553555600176010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Stream type and some operations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Stream where open import Size open import Codata.Thunk as Thunk using (Thunk; force) open import Data.Nat.Base open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty using (List⁺; _∷_) open import Data.Vec using (Vec; []; _∷_) open import Data.Product as P hiding (map) open import Function ------------------------------------------------------------------------ -- Definition data Stream {ℓ} (A : Set ℓ) (i : Size) : Set ℓ where _∷_ : A → Thunk (Stream A) i → Stream A i module _ {ℓ} {A : Set ℓ} where repeat : ∀ {i} → A → Stream A i repeat a = a ∷ λ where .force → repeat a head : ∀ {i} → Stream A i → A head (x ∷ xs) = x tail : Stream A ∞ → Stream A ∞ tail (x ∷ xs) = xs .force lookup : ℕ → Stream A ∞ → A lookup zero xs = head xs lookup (suc k) xs = lookup k (tail xs) splitAt : (n : ℕ) → Stream A ∞ → Vec A n × Stream A ∞ splitAt zero xs = [] , xs splitAt (suc n) (x ∷ xs) = P.map₁ (x ∷_) (splitAt n (xs .force)) take : (n : ℕ) → Stream A ∞ → Vec A n take n xs = proj₁ (splitAt n xs) drop : ℕ → Stream A ∞ → Stream A ∞ drop n xs = proj₂ (splitAt n xs) infixr 5 _++_ _⁺++_ _++_ : ∀ {i} → List A → Stream A i → Stream A i [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ λ where .force → xs ++ ys _⁺++_ : ∀ {i} → List⁺ A → Thunk (Stream A) i → Stream A i (x ∷ xs) ⁺++ ys = x ∷ λ where .force → xs ++ ys .force cycle : ∀ {i} → List⁺ A → Stream A i cycle xs = xs ⁺++ λ where .force → cycle xs concat : ∀ {i} → Stream (List⁺ A) i → Stream A i concat (xs ∷ xss) = xs ⁺++ λ where .force → concat (xss .force) interleave : ∀ {i} → Stream A i → Thunk (Stream A) i → Stream A i interleave (x ∷ xs) ys = x ∷ λ where .force → interleave (ys .force) xs chunksOf : (n : ℕ) → Stream A ∞ → Stream (Vec A n) ∞ chunksOf n = chunksOfAcc n id module ChunksOf where chunksOfAcc : ∀ {i} k (acc : Vec A k → Vec A n) → Stream A ∞ → Stream (Vec A n) i chunksOfAcc zero acc xs = acc [] ∷ λ where .force → chunksOfAcc n id xs chunksOfAcc (suc k) acc (x ∷ xs) = chunksOfAcc k (acc ∘ (x ∷_)) (xs .force) module _ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} where map : ∀ {i} → (A → B) → Stream A i → Stream B i map f (x ∷ xs) = f x ∷ λ where .force → map f (xs .force) ap : ∀ {i} → Stream (A → B) i → Stream A i → Stream B i ap (f ∷ fs) (x ∷ xs) = f x ∷ λ where .force → ap (fs .force) (xs .force) unfold : ∀ {i} → (A → A × B) → A → Stream B i unfold next seed = let (seed′ , b) = next seed in b ∷ λ where .force → unfold next seed′ scanl : ∀ {i} → (B → A → B) → B → Stream A i → Stream B i scanl c n (x ∷ xs) = n ∷ λ where .force → scanl c (c n x) (xs .force) module _ {ℓ ℓ₁ ℓ₂} {A : Set ℓ} {B : Set ℓ₁} {C : Set ℓ₂} where zipWith : ∀ {i} → (A → B → C) → Stream A i → Stream B i → Stream C i zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ λ where .force → zipWith f (as .force) (bs .force) module _ {a} {A : Set a} where iterate : (A → A) → A → Stream A ∞ iterate f = unfold < f , id > agda-stdlib-1.1/src/Codata/Stream/000077500000000000000000000000001350553555600167575ustar00rootroot00000000000000agda-stdlib-1.1/src/Codata/Stream/Bisimilarity.agda000066400000000000000000000063201350553555600222370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Streams ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Stream.Bisimilarity where open import Size open import Codata.Thunk open import Codata.Stream open import Level open import Data.List.NonEmpty as List⁺ using (_∷_) open import Data.List.Relation.Binary.Pointwise using (Pointwise; []; _∷_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) data Bisim {a b r} {A : Set a} {B : Set b} (R : REL A B r) i : REL (Stream A ∞) (Stream B ∞) (a ⊔ b ⊔ r) where _∷_ : ∀ {x y xs ys} → R x y → Thunk^R (Bisim R) i xs ys → Bisim R i (x ∷ xs) (y ∷ ys) module _ {a r} {A : Set a} {R : Rel A r} where reflexive : Reflexive R → ∀ {i} → Reflexive (Bisim R i) reflexive refl^R {i} {r ∷ rs} = refl^R ∷ λ where .force → reflexive refl^R module _ {a b} {A : Set a} {B : Set b} {r} {P : A → B → Set r} {Q : B → A → Set r} where symmetric : Sym P Q → ∀ {i} → Sym (Bisim P i) (Bisim Q i) symmetric sym^PQ (p ∷ ps) = sym^PQ p ∷ λ where .force → symmetric sym^PQ (ps .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {r} {P : A → B → Set r} {Q : B → C → Set r} {R : A → C → Set r} where transitive : Trans P Q R → ∀ {i} → Trans (Bisim P i) (Bisim Q i) (Bisim R i) transitive trans^PQR (p ∷ ps) (q ∷ qs) = trans^PQR p q ∷ λ where .force → transitive trans^PQR (ps .force) (qs .force) module _ {a r} {A : Set a} {R : Rel A r} where isEquivalence : ∀ {i} → IsEquivalence R → IsEquivalence (Bisim R i) isEquivalence equiv^R = record { refl = reflexive equiv^R.refl ; sym = symmetric equiv^R.sym ; trans = transitive equiv^R.trans } where module equiv^R = IsEquivalence equiv^R module _ {a r} (S : Setoid a r) where setoid : ∀ i → Setoid a (a ⊔ r) setoid i = record { isEquivalence = isEquivalence {i = i} (Setoid.isEquivalence S) } module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where ++⁺ : ∀ {as bs xs ys i} → Pointwise R as bs → Bisim R i xs ys → Bisim R i (as ++ xs) (bs ++ ys) ++⁺ [] rs = rs ++⁺ (r ∷ pw) rs = r ∷ λ where .force → ++⁺ pw rs ⁺++⁺ : ∀ {as bs xs ys i} → Pointwise R (List⁺.toList as) (List⁺.toList bs) → Thunk^R (Bisim R) i xs ys → Bisim R i (as ⁺++ xs) (bs ⁺++ ys) ⁺++⁺ (r ∷ pw) rs = r ∷ λ where .force → ++⁺ pw (rs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {ℓ} {A : Set ℓ} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Stream A ∞ → Stream A ∞ → Set ℓ _⊢_≈_ = Bisim _≡_ refl : ∀ {i} → Reflexive (i ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i} → Symmetric (i ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i} → Transitive (i ⊢_≈_) trans = transitive Eq.trans module ≈-Reasoning {a} {A : Set a} {i} where open import Relation.Binary.Reasoning.Setoid (setoid (Eq.setoid A) i) public agda-stdlib-1.1/src/Codata/Stream/Categorical.agda000066400000000000000000000015401350553555600220120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Stream ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Stream.Categorical where open import Data.Product using (<_,_>) open import Codata.Stream open import Function open import Category.Functor open import Category.Applicative open import Category.Comonad functor : ∀ {ℓ i} → RawFunctor {ℓ} (λ A → Stream A i) functor = record { _<$>_ = λ f → map f } applicative : ∀ {ℓ i} → RawApplicative {ℓ} (λ A → Stream A i) applicative = record { pure = repeat ; _⊛_ = ap } comonad : ∀ {ℓ} → RawComonad {ℓ} (λ A → Stream A _) comonad = record { extract = head ; extend = unfold ∘′ < tail ,_> } agda-stdlib-1.1/src/Codata/Stream/Properties.agda000066400000000000000000000143641350553555600217410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Stream type ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Stream.Properties where open import Size open import Codata.Thunk as Thunk using (Thunk; force) open import Codata.Stream open import Codata.Stream.Bisimilarity open import Data.Nat.Base open import Data.Nat.GeneralisedArithmetic using (fold; fold-pull) open import Data.List.Base as List using ([]; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) import Data.List.Relation.Binary.Equality.Propositional as Eq open import Data.Product as Prod using (_,_) open import Data.Vec as Vec using (_∷_) open import Function open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_) ------------------------------------------------------------------------ -- repeat module _ {a} {A : Set a} where lookup-repeat-identity : (n : ℕ) (a : A) → lookup n (repeat a) ≡ a lookup-repeat-identity zero a = P.refl lookup-repeat-identity (suc n) a = lookup-repeat-identity n a take-repeat-identity : (n : ℕ) (a : A) → take n (repeat a) ≡ Vec.replicate a take-repeat-identity zero a = P.refl take-repeat-identity (suc n) a = P.cong (a Vec.∷_) (take-repeat-identity n a) splitAt-repeat-identity : (n : ℕ) (a : A) → splitAt n (repeat a) ≡ (Vec.replicate a , repeat a) splitAt-repeat-identity zero a = P.refl splitAt-repeat-identity (suc n) a = P.cong (Prod.map₁ (a ∷_)) (splitAt-repeat-identity n a) replicate-repeat : ∀ {i} (n : ℕ) (a : A) → i ⊢ List.replicate n a ++ repeat a ≈ repeat a replicate-repeat zero a = refl replicate-repeat (suc n) a = P.refl ∷ λ where .force → replicate-repeat n a cycle-replicate : ∀ {i} (n : ℕ) (n≢0 : n ≢ 0) (a : A) → i ⊢ cycle (List⁺.replicate n n≢0 a) ≈ repeat a cycle-replicate {i} n n≢0 a = let as = List⁺.replicate n n≢0 a in begin cycle as ≡⟨⟩ as ⁺++ _ ≈⟨ ⁺++⁺ Eq.≋-refl (λ where .force → cycle-replicate n n≢0 a) ⟩ as ⁺++ (λ where .force → repeat a) ≈⟨ P.refl ∷ (λ where .force → replicate-repeat (pred n) a) ⟩ repeat a ∎ where open ≈-Reasoning module _ {a b} {A : Set a} {B : Set b} where map-repeat : ∀ (f : A → B) a {i} → i ⊢ map f (repeat a) ≈ repeat (f a) map-repeat f a = P.refl ∷ λ where .force → map-repeat f a ap-repeat : ∀ (f : A → B) a {i} → i ⊢ ap (repeat f) (repeat a) ≈ repeat (f a) ap-repeat f a = P.refl ∷ λ where .force → ap-repeat f a ap-repeatˡ : ∀ (f : A → B) as {i} → i ⊢ ap (repeat f) as ≈ map f as ap-repeatˡ f (a ∷ as) = P.refl ∷ λ where .force → ap-repeatˡ f (as .force) ap-repeatʳ : ∀ (fs : Stream (A → B) ∞) (a : A) {i} → i ⊢ ap fs (repeat a) ≈ map (_$ a) fs ap-repeatʳ (f ∷ fs) a = P.refl ∷ λ where .force → ap-repeatʳ (fs .force) a map-++ : ∀ {i} (f : A → B) as xs → i ⊢ map f (as ++ xs) ≈ List.map f as ++ map f xs map-++ f [] xs = refl map-++ f (a ∷ as) xs = P.refl ∷ λ where .force → map-++ f as xs map-⁺++ : ∀ {i} (f : A → B) as xs → i ⊢ map f (as ⁺++ xs) ≈ List⁺.map f as ⁺++ Thunk.map (map f) xs map-⁺++ f (a ∷ as) xs = P.refl ∷ (λ where .force → map-++ f as (xs .force)) map-cycle : ∀ {i} (f : A → B) as → i ⊢ map f (cycle as) ≈ cycle (List⁺.map f as) map-cycle f as = begin map f (cycle as) ≈⟨ map-⁺++ f as _ ⟩ List⁺.map f as ⁺++ _ ≈⟨ ⁺++⁺ Eq.≋-refl (λ where .force → map-cycle f as) ⟩ cycle (List⁺.map f as) ∎ where open ≈-Reasoning ------------------------------------------------------------------------ -- Functor laws module _ {a} {A : Set a} where map-identity : ∀ (as : Stream A ∞) {i} → i ⊢ map id as ≈ as map-identity (a ∷ as) = P.refl ∷ λ where .force → map-identity (as .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where map-map-fusion : ∀ (f : A → B) (g : B → C) as {i} → i ⊢ map g (map f as) ≈ map (g ∘ f) as map-map-fusion f g (a ∷ as) = P.refl ∷ λ where .force → map-map-fusion f g (as .force) ------------------------------------------------------------------------ -- splitAt module _ {a b} {A : Set a} {B : Set b} where splitAt-map : ∀ n (f : A → B) xs → splitAt n (map f xs) ≡ Prod.map (Vec.map f) (map f) (splitAt n xs) splitAt-map zero f xs = P.refl splitAt-map (suc n) f (x ∷ xs) = P.cong (Prod.map₁ (f x Vec.∷_)) (splitAt-map n f (xs .force)) ------------------------------------------------------------------------ -- iterate module _ {a} {A : Set a} where lookup-iterate-identity : ∀ n f (a : A) → lookup n (iterate f a) ≡ fold a f n lookup-iterate-identity zero f a = P.refl lookup-iterate-identity (suc n) f a = begin lookup (suc n) (iterate f a) ≡⟨⟩ lookup n (iterate f (f a)) ≡⟨ lookup-iterate-identity n f (f a) ⟩ fold (f a) f n ≡⟨ fold-pull (const ∘′ f) (f a) P.refl (λ _ → P.refl) n ⟩ f (fold a f n) ≡⟨⟩ fold a f (suc n) ∎ where open P.≡-Reasoning ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 repeat-ap-identity = ap-repeatˡ {-# WARNING_ON_USAGE repeat-ap-identity "Warning: repeat-ap-identity was deprecated in v1.1. Please use ap-repeatˡ instead." #-} ap-repeat-identity = ap-repeatʳ {-# WARNING_ON_USAGE ap-repeat-identity "Warning: ap-repeat-identity was deprecated in v1.1. Please use ap-repeatʳ instead." #-} ap-repeat-commute = ap-repeat {-# WARNING_ON_USAGE ap-repeat-commute "Warning: ap-repeat-commute was deprecated in v1.1. Please use ap-repeat instead." #-} map-repeat-commute = map-repeat {-# WARNING_ON_USAGE map-repeat-commute "Warning: map-repeat-commute was deprecated in v1.1. Please use map-repeat instead." #-} agda-stdlib-1.1/src/Codata/Thunk.agda000066400000000000000000000041101350553555600174270ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Thunk wrappers for sized codata, copredicates and corelations ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe --sized-types #-} module Codata.Thunk where open import Size open import Relation.Unary ------------------------------------------------------------------------ -- Basic types. record Thunk {ℓ} (F : Size → Set ℓ) (i : Size) : Set ℓ where coinductive field force : {j : Size< i} → F j open Thunk public Thunk^P : ∀ {f p} {F : Size → Set f} (P : Size → F ∞ → Set p) (i : Size) (tf : Thunk F ∞) → Set p Thunk^P P i tf = Thunk (λ i → P i (tf .force)) i Thunk^R : ∀ {f g r} {F : Size → Set f} {G : Size → Set g} (R : Size → F ∞ → G ∞ → Set r) (i : Size) (tf : Thunk F ∞) (tg : Thunk G ∞) → Set r Thunk^R R i tf tg = Thunk (λ i → R i (tf .force) (tg .force)) i ------------------------------------------------------------------------ -- Syntax Thunk-syntax : ∀ {ℓ} → (Size → Set ℓ) → Size → Set ℓ Thunk-syntax = Thunk syntax Thunk-syntax (λ j → e) i = Thunk[ j < i ] e ------------------------------------------------------------------------ -- Basic functions. -- Thunk is a functor module _ {p q} {P : Size → Set p} {Q : Size → Set q} where map : ∀[ P ⇒ Q ] → ∀[ Thunk P ⇒ Thunk Q ] map f p .force = f (p .force) -- Thunk is a comonad module _ {p} {P : Size → Set p} where extract : ∀[ Thunk P ] → P ∞ extract p = p .force duplicate : ∀[ Thunk P ⇒ Thunk (Thunk P) ] duplicate p .force .force = p .force module _ {p q} {P : Size → Set p} {Q : Size → Set q} where infixl 1 _<*>_ _<*>_ : ∀[ Thunk (P ⇒ Q) ⇒ Thunk P ⇒ Thunk Q ] (f <*> p) .force = f .force (p .force) -- We can take cofixpoints of functions only making Thunk'd recursive calls module _ {p} (P : Size → Set p) where cofix : ∀[ Thunk P ⇒ P ] → ∀[ P ] cofix f = f λ where .force → cofix f agda-stdlib-1.1/src/Data/000077500000000000000000000000001350553555600152025ustar00rootroot00000000000000agda-stdlib-1.1/src/Data/AVL.agda000066400000000000000000000101701350553555600164410ustar00rootroot00000000000000------------------------------------------------------------------------ -- 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". {-# OPTIONS --without-K --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where open import Data.Bool.Base using (Bool) import Data.DifferenceList as DiffList open import Data.List.Base as List using (List) open import Data.Maybe using (Maybe; nothing; just; is-just) open import Data.Nat.Base using (suc) open import Data.Product hiding (map) open import Function as F open import Level using (_⊔_) open import Relation.Unary open StrictTotalOrder strictTotalOrder renaming (Carrier to Key) import Data.AVL.Indexed strictTotalOrder as Indexed open Indexed using (K&_ ; ⊥⁺ ; ⊤⁺; ⊥⁺<⊤⁺; ⊥⁺<[_]<⊤⁺; ⊥⁺<[_]; [_]<⊤⁺) ------------------------------------------------------------------------ -- Re-export some core definitions publically open Indexed using (Value; MkValue; const) public ------------------------------------------------------------------------ -- Types and functions with hidden indices data Tree {v} (V : Value v) : Set (a ⊔ v ⊔ ℓ₂) where tree : ∀ {h} → Indexed.Tree V ⊥⁺ ⊤⁺ h → Tree V module _ {v} {V : Value v} where private Val = Value.family V empty : Tree V empty = tree $′ Indexed.empty ⊥⁺<⊤⁺ singleton : (k : Key) → Val k → Tree V singleton k v = tree (Indexed.singleton k v ⊥⁺<[ k ]<⊤⁺) insert : (k : Key) → Val k → Tree V → Tree V insert k v (tree t) = tree $′ proj₂ $ Indexed.insert k v t ⊥⁺<[ k ]<⊤⁺ insertWith : (k : Key) → (Maybe (Val k) → Val k) → Tree V → Tree V insertWith k f (tree t) = tree $′ proj₂ $ Indexed.insertWith k f t ⊥⁺<[ k ]<⊤⁺ delete : Key → Tree V → Tree V delete k (tree t) = tree $′ proj₂ $ Indexed.delete k t ⊥⁺<[ k ]<⊤⁺ lookup : (k : Key) → Tree V → Maybe (Val k) lookup k (tree t) = Indexed.lookup k t ⊥⁺<[ k ]<⊤⁺ module _ {v w} {V : Value v} {W : Value w} where private Val = Value.family V Wal = Value.family W map : ∀[ Val ⇒ Wal ] → Tree V → Tree W map f (tree t) = tree $ Indexed.map f t module _ {v} {V : Value v} where private Val = Value.family V infix 4 _∈?_ _∈?_ : Key → Tree V → Bool k ∈? t = is-just (lookup k t) headTail : Tree V → Maybe ((K& V) × Tree V) headTail (tree (Indexed.leaf _)) = nothing headTail (tree {h = suc _} t) with Indexed.headTail t ... | (k , _ , _ , t′) = just (k , tree (Indexed.castˡ ⊥⁺<[ _ ] t′)) initLast : Tree V → Maybe (Tree V × (K& V)) initLast (tree (Indexed.leaf _)) = nothing initLast (tree {h = suc _} t) with Indexed.initLast t ... | (k , _ , _ , t′) = just (tree (Indexed.castʳ t′ [ _ ]<⊤⁺) , k) -- The input does not need to be ordered. fromList : List (K& V) → Tree V fromList = List.foldr (uncurry insert) empty -- Returns an ordered list. toList : Tree V → List (K& V) toList (tree t) = DiffList.toList (Indexed.toDiffList t) -- Naive implementations of union. module _ {v w} {V : Value v} {W : Value w} where private Val = Value.family V Wal = Value.family W unionWith : (∀ {k} → Val k → Maybe (Wal k) → Wal k) → -- Left → right → result. Tree V → Tree W → Tree W unionWith f t₁ t₂ = List.foldr (uncurry $ λ k v → insertWith k (f v)) t₂ (toList t₁) -- Left-biased. module _ {v} {V : Value v} where private Val = Value.family V union : Tree V → Tree V → Tree V union = unionWith F.const unionsWith : (∀ {k} → Val k → Maybe (Val k) → Val k) → List (Tree V) → Tree V unionsWith f ts = List.foldr (unionWith f) empty ts -- Left-biased. unions : List (Tree V) → Tree V unions = unionsWith F.const agda-stdlib-1.1/src/Data/AVL/000077500000000000000000000000001350553555600156245ustar00rootroot00000000000000agda-stdlib-1.1/src/Data/AVL/Height.agda000066400000000000000000000026251350553555600176570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Types and functions which are used to keep track of height -- invariants in AVL Trees ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} module Data.AVL.Height where open import Data.Nat.Base open import Data.Fin using (Fin; zero; suc) ℕ₂ = Fin 2 pattern 0# = zero pattern 1# = suc zero pattern ## = suc (suc ()) -- Addition. infixl 6 _⊕_ _⊕_ : ℕ₂ → ℕ → ℕ 0# ⊕ n = n 1# ⊕ n = 1 + n -- pred[ i ⊕ n ] = pred (i ⊕ n). pred[_⊕_] : ℕ₂ → ℕ → ℕ pred[ i ⊕ zero ] = 0 pred[ i ⊕ suc n ] = i ⊕ n infix 4 _∼_⊔_ -- If i ∼ j ⊔ m, then the difference between i and j is at most 1, -- and the maximum of i and j is m. _∼_⊔_ is used to record the -- balance factor of the AVL trees, and also to ensure that the -- absolute value of the balance factor is never more than 1. data _∼_⊔_ : ℕ → ℕ → ℕ → Set where ∼+ : ∀ {n} → n ∼ 1 + n ⊔ 1 + n ∼0 : ∀ {n} → n ∼ n ⊔ n ∼- : ∀ {n} → 1 + n ∼ n ⊔ 1 + n -- Some lemmas. max∼ : ∀ {i j m} → i ∼ j ⊔ m → m ∼ i ⊔ m max∼ ∼+ = ∼- max∼ ∼0 = ∼0 max∼ ∼- = ∼0 ∼max : ∀ {i j m} → i ∼ j ⊔ m → j ∼ m ⊔ m ∼max ∼+ = ∼0 ∼max ∼0 = ∼0 ∼max ∼- = ∼+ agda-stdlib-1.1/src/Data/AVL/Indexed.agda000066400000000000000000000304061350553555600200250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- AVL trees where the stored values may depend on their key ------------------------------------------------------------------------ {-# OPTIONS --without-K --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL.Indexed {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where open import Level using (_⊔_) open import Data.Nat.Base using (ℕ; zero; suc; _+_) open import Data.Product using (Σ; ∃; _×_; _,_; proj₁) open import Data.Maybe using (Maybe; just; nothing) open import Data.List.Base as List using (List) open import Data.DifferenceList using (DiffList; []; _∷_; _++_) open import Function as F hiding (const) open import Relation.Unary open import Relation.Binary using (_Respects_; Tri; tri<; tri≈; tri>) open import Relation.Binary.PropositionalEquality using (_≡_; refl) open StrictTotalOrder strictTotalOrder renaming (Carrier to Key) ------------------------------------------------------------------------ -- Re-export core definitions publicly open import Data.AVL.Key strictTotalOrder public open import Data.AVL.Value Eq.setoid public open import Data.AVL.Height public ------------------------------------------------------------------------ -- Definitions of the tree K&_ : ∀ {v} (V : Value v) → Set (a ⊔ v) K& V = Σ Key (Value.family V) -- The trees have three parameters/indices: a lower bound on the -- keys, an upper bound, and a height. -- -- (The bal argument is the balance factor.) data Tree {v} (V : Value v) (l u : Key⁺) : ℕ → Set (a ⊔ v ⊔ ℓ₂) where leaf : (l _ _ k′ _ _ k′>k = joinˡ⁻ _ p (delete k lp (lk ]ᴿ)) pu bal ... | tri≈ _ k′≡k _ = 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 V l u h → l < k < u → Maybe (Val k) lookup k (leaf _) l _ _ k′>k = lookup k lk′ (lk ]ᴿ) ... | tri≈ _ k′≡k _ = just (V≈ k′≡k v) -- Converts the tree to an ordered list. Linear in the size of the -- tree. toDiffList : ∀ {l u h} → Tree V l u h → DiffList (K& V) toDiffList (leaf _) = [] toDiffList (node k l r _) = toDiffList l ++ k ∷ toDiffList r toList : ∀ {l u h} → Tree V l u h → List (K& V) toList t = toDiffList t List.[] module _ {v w} {V : Value v} {W : Value w} where private Val = Value.family V Wal = Value.family W -- Maps a function over all values in the tree. map : ∀[ Val ⇒ Wal ] → ∀ {l u h} → Tree V l u h → Tree W l u h map f (leaf l