pax_global_header00006660000000000000000000000064127045104700014512gustar00rootroot0000000000000052 comment=7cc77a7360dee40d286fb5acee2bcaa7359a7bfc agda-stdlib-0.12/000077500000000000000000000000001270451047000136075ustar00rootroot00000000000000agda-stdlib-0.12/.boring000066400000000000000000000001221270451047000150630ustar00rootroot00000000000000\.l?agda\.el$ \.agdai$ (^|/)MAlonzo($|/) ^dist($|/) ^html($|/) ^Everything\.agda$ agda-stdlib-0.12/.dropbox_uploader.enc000066400000000000000000000002401270451047000177200ustar00rootroot00000000000000$%7 ö"6©µ¾•»_T™XðNݤÉPp¶~ *¯Ü'‘ØüO^6<µW›)aQ¦ AÁk¦Ñ_½9þc ÿ-£ß)h‰û•fF£¶×”Ö9™C>_›[Œ›AYo@o¡â¡ù%6¡7±ÙÐâ4‚ôÖñ“´uÀg¾¦üõßÚTû%¬–"ÙÔ;¾Bùv`ÚRf’ÂíÊoagda-stdlib-0.12/.gitignore000066400000000000000000000002041270451047000155730ustar00rootroot00000000000000# Keep this file in alphabetic order please! *~ .*.swp *.agdai *.agda.el *.lagda.el *.hi *.o *.tix *.vim dist Everything.agda html agda-stdlib-0.12/.mailmap000066400000000000000000000020611270451047000152270ustar00rootroot00000000000000# The information from some Git commands, e.g. git shortlog -nse, is # better by using this file. # Please keep this file in alphabetic order! ############################################################################## Alan Jeffrey ajeffrey Andreas Abel andreas.abel Darin Morrison dwm Dominique Devriese Evgeny Kotelnikov aztek GergÅ‘ Érdi gergo Jean-Philippe Bernardy jeanphilippe.bernardy Noam Zeilberger noam.zeilberger Patrik Jansson patrikj Shin-Cheng Mu scm Ulf Norell ulf.norell Ulf Norell ulfn Ulf Norell ulfn agda-stdlib-0.12/.travis.yml000066400000000000000000000033311270451047000157200ustar00rootroot00000000000000language: haskell branches: only: - master before_install: # Decrypting the dropbox credentials - openssl aes-256-cbc -K $encrypted_3f6e0f4132ed_key -iv $encrypted_3f6e0f4132ed_iv -in .dropbox_uploader.enc -out .dropbox_uploader -d - cp .dropbox_uploader $HOME/ install: # Installing the dropbox download script - cd $HOME - curl "https://raw.githubusercontent.com/andreafabrizi/Dropbox-Uploader/master/dropbox_uploader.sh" -o dropbox_uploader.sh - chmod +x dropbox_uploader.sh # downloading the last (latest?) tarball and installing agda - AGDATAR=$(./dropbox_uploader.sh list | tail -n 1 | sed 's/^.*\(Agda.*\)$/\1/') - ./dropbox_uploader.sh download $AGDATAR . - tar -xzvf $AGDATAR - cd $( basename $AGDATAR .tar.gz ) - sudo ./deploy.sh # generating Everything.agda - cabal install filemanip - cd $HOME/build/agda/agda-stdlib - runghc GenerateEverything.hs script: # generating index.agda - ./index.sh # building the docs - agda -i . -i src/ --html src/index.agda # moving everything at the root - mv html/* . after_success: # uploading to gh-pages - git init - git config --global user.name "Travis CI bot" - git config --global user.email "travis-ci-bot@travis.fake" - git remote add upstream https://$GH_TOKEN@github.com/agda/agda-stdlib.git &>/dev/null - git fetch upstream && git reset upstream/gh-pages - git add -f \*.html - git commit -m "Automatic HTML update via Travis" - git push -q upstream HEAD:gh-pages &>/dev/null notifications: email: false # Github token env: global: secure: f0GRSKTlAw6FdrvkI8LjP5ZhwcGBltJ1t5+nxipqfoR3VczMxcNgXD7bdwtUojFYR48jMs2W+LxEoJcuSH4bsdCeoSfpZ0nU424MDajGh0wuhAbSYKQXPWjFOxwMgC23sCySKhDAZiqN/Wd6orwV1p5JhuJkSCHdVeyUp+hLvIw= agda-stdlib-0.12/AllNonAsciiChars.hs000066400000000000000000000020721270451047000172610ustar00rootroot00000000000000-- | This module extracts all the non-ASCII characters used by the -- library code (along with how many times they are used). module Main where import qualified Data.List as L import Data.Char import Data.Function import Control.Applicative import Numeric ( showHex ) import System.FilePath.Find import System.IO readUTF8File :: FilePath -> IO String readUTF8File f = do h <- openFile f ReadMode hSetEncoding h utf8 hGetContents h main :: IO () main = do agdaFiles <- find always (extension ==? ".agda" ||? extension ==? ".lagda") "src" nonAsciiChars <- filter (not . isAscii) . concat <$> mapM readUTF8File agdaFiles let table = reverse $ L.sortBy (compare `on` snd) $ map (\cs -> (head cs, length cs)) $ L.group $ L.sort $ nonAsciiChars let codePoint :: Char -> String codePoint c = showHex (ord c) "" uPlus :: Char -> String uPlus c = "(U+" ++ codePoint c ++ ")" mapM_ (\(c, count) -> putStrLn (c : " " ++ uPlus c ++ ": " ++ show count)) table agda-stdlib-0.12/CHANGELOG000066400000000000000000000240361270451047000150260ustar00rootroot00000000000000------------------------------------------------------------------------ -- Release notes for Agda standard library version 0.12 ------------------------------------------------------------------------ The library has been tested using Agda version 2.5.1. Important changes since 0.11: * Added support for GHC 8.0.1. ------------------------------------------------------------------------ -- Release notes for Agda standard library version 0.11 ------------------------------------------------------------------------ The library has been tested using Agda version 2.4.2.4. Important changes since 0.10: * Relation.Binary.PropositionalEquality.TrustMe.erase was added. * Added Data.Nat.Base.{_≤″_,_≥″_,_<″_,_>″_,erase}, Data.Nat.Properties.{≤⇒≤″,≤″⇒≤}, Data.Fin.fromℕ≤″, and Data.Fin.Properties.fromℕ≤≡fromℕ≤″. * The functions in Data.Nat.DivMod have been optimised. * Turned on η-equality for Record.Record, removed Record.Signature′ and Record.Record′. * Renamed Data/AVL.agda._⊕_sub1 to pred[_⊕_]. ------------------------------------------------------------------------ -- Release notes for Agda standard library version 0.10 ------------------------------------------------------------------------ The library has been tested using Agda version 2.4.2.3. Important changes since 0.9: * Renamed Data.Unit.Core to Data.Unit.NonEta * Removed Data.String.Core. The module Data.String.Base now contains these definitions. * Removed Relation.Nullary.Core. The module Relation.Nullary now contains these definitions directly. * Inspect on steroids has been simplified (see Relation.Binary.PropositionalEquality and Relation.Binary.HeterogeneousEquality). The old version has been deprecated (see the above modules) and it will be removed in the next release. * Using Data.X.Base modules. The Data.X.Base modules are used for cheaply importing a data type and the most common definitions. The use of these modules reduce type-checking and compilation times. At the moment, the modules added are: 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: 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: gfilter-just : ... → gfilter just xs ≡ xs gfilter-nothing : ... → gfilter (λ _ → nothing) xs ≡ [] gfilter-concatMap : ... → gfilter f ≗ concatMap (fromMaybe ∘ f) * New in Data.Nat.Properties: <⇒≤pred : ∀ {m n} → m < n → m ≤ pred n * New in Data.Fin: strengthen : ∀ {n} (i : Fin n) → Fin′ (suc i) * New in Data.Fin.Properties: 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: 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. * Turned on η-equality for Record.Record, removed Record.Signature′ and Record.Record′. ------------------------------------------------------------------------ -- Release notes for Agda standard library version 0.9 ------------------------------------------------------------------------ The library has been tested using Agda version 2.4.2.1. Important changes since 0.8.1: * Data.List.NonEmpty Non-empty lists are no longer defined in terms of Data.Product._×_, instead, now they are defined as record with fields head and tail. * Reflection API ** Quoting levels was fixed. This fix could break some code (see Agda issue 1207). ** 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). ** The primitive function for showing names, primShowQName, is now exposed as Reflection.showName. * Removed compatibility modules for Props -> Properties rename Use Foo.Properties.Bar instead of Foo.Props.Bar. ------------------------------------------------------------------------ -- Version 0.8.1 ------------------------------------------------------------------------ The library has been tested using Agda version 2.4.2. Important changes since 0.8: * Reflection API Agda 2.4.2 added support for literals, function definitions, pattern matching lambdas and absurd clause/patterns (see Agda release notes). The new supported entities were added to the Reflection.agda module. * Modules renamed Foo.Props.Bar -> Foo.Properties.Bar The current compatibility modules Foo.Props.Bar will be removed in the next release. ------------------------------------------------------------------------ Version 0.8 ------------------------------------------------------------------------ Version 0.8 of the standard library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.4.0. ------------------------------------------------------------------------ Version 0.7 ------------------------------------------------------------------------ Version 0.7 of the standard library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.3.2. ------------------------------------------------------------------------ Version 0.6 ------------------------------------------------------------------------ Version 0.6 of the standard library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.3.0. ------------------------------------------------------------------------ Version 0.5 ------------------------------------------------------------------------ Version 0.5 of the standard library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.2.10. ------------------------------------------------------------------------ Version 0.4 ------------------------------------------------------------------------ Version 0.4 of the standard library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.2.8. ------------------------------------------------------------------------ Version 0.3 ------------------------------------------------------------------------ Version 0.3 of the standard library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.2.6. ------------------------------------------------------------------------ Version 0.2 ------------------------------------------------------------------------ Version 0.2 of the "standard" library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.2.4. Note that the library sources are now located in the sub-directory lib-/src of the installation tarball. ------------------------------------------------------------------------ Version 0.1 ------------------------------------------------------------------------ Version 0.1 of the "standard" library has now been released, see http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary. The library has been tested using Agda version 2.2.2. agda-stdlib-0.12/GNUmakefile000066400000000000000000000005301270451047000156570ustar00rootroot00000000000000AGDA=agda test: Everything.agda fix-agda-whitespace --check $(AGDA) -i. -isrc README.agda setup: Everything.agda .PHONY: Everything.agda Everything.agda: cabal clean && cabal install GenerateEverything .PHONY: listings listings: Everything.agda $(AGDA) -i. -isrc --html README.agda -v0 clean : find . -type f -name '*.agdai' -delete agda-stdlib-0.12/GenerateEverything.hs000066400000000000000000000055651270451047000177550ustar00rootroot00000000000000{-# LANGUAGE PatternGuards #-} import qualified Data.List as List import Control.Applicative import System.Environment import System.IO import System.Exit import System.FilePath import System.FilePath.Find headerFile = "Header" outputFile = "Everything.agda" srcDir = "src" main = do args <- getArgs case args of [] -> return () _ -> hPutStr stderr usage >> exitFailure header <- readFileUTF8 headerFile modules <- filter isLibraryModule . List.sort <$> find always (extension ==? ".agda" ||? extension ==? ".lagda") srcDir headers <- mapM extractHeader modules writeFileUTF8 outputFile $ header ++ format (zip modules headers) -- | Usage info. usage :: String usage = unlines [ "GenerateEverything: A utility program for Agda's standard library." , "" , "Usage: GenerateEverything" , "" , "This program should be run in the base directory of a clean checkout of" , "the library." , "" , "The program generates documentation for the library by extracting" , "headers from library modules. The output is written to " ++ outputFile , "with the file " ++ headerFile ++ " inserted verbatim at the beginning." ] -- | Returns 'True' for all Agda files except for core modules. isLibraryModule :: FilePath -> Bool isLibraryModule f = takeExtension f `elem` [".agda", ".lagda"] && dropExtension (takeFileName f) /= "Core" && dropExtension (takeFileName f) /= "index" -- | Reads a module and extracts the header. extractHeader :: FilePath -> IO [String] extractHeader mod = fmap (extract . lines) $ readFileUTF8 mod where delimiter = all (== '-') extract (d1 : "-- The Agda standard library" : "--" : ss) | delimiter d1 , (info, d2 : rest) <- span ("-- " `List.isPrefixOf`) ss , delimiter d2 = info extract _ = error $ mod ++ " is malformed." -- | Formats the extracted module information. format :: [(FilePath, [String])] -- ^ Pairs of module names and headers. All lines in the -- headers are already prefixed with \"-- \". -> String format = unlines . concat . map fmt where fmt (mod, header) = "" : header ++ ["import " ++ fileToMod mod] -- | Translates a file name to the corresponding module name. It is -- assumed that the file name corresponds to an Agda module under -- 'srcDir'. fileToMod :: FilePath -> String fileToMod = map slashToDot . dropExtension . makeRelative srcDir where slashToDot c | isPathSeparator c = '.' | otherwise = c -- | A variant of 'readFile' which uses the 'utf8' encoding. readFileUTF8 :: FilePath -> IO String readFileUTF8 f = do h <- openFile f ReadMode hSetEncoding h utf8 hGetContents h -- | A variant of 'writeFile' which uses the 'utf8' encoding. writeFileUTF8 :: FilePath -> String -> IO () writeFileUTF8 f s = withFile f WriteMode $ \h -> do hSetEncoding h utf8 hPutStr h s agda-stdlib-0.12/HACKING000066400000000000000000000016661270451047000146070ustar00rootroot00000000000000 * Where to commit changes: CURRENT_AGDA = current released Agda version, e.g. 2.4.2.5 AGDA_MAINT = Agda maintenance version, e.g. 2.4.2.6 A. Your change is independent of Agda 1. Push your commit in the CURRENT_AGDA branch 2. Merge the CURRENT_AGDA branch into the AGDA_MAINT branch 3. Merge the AGDA_MAINT branch into the master branch B. Your change is due to a change in the AGDA_MAINT version of Agda 1. Push your commit in the AGDA_MAINT branch 2. Merge the AGDA_MAINT branch into the master branch C. Your change is due to a change in the master version of Agda 1. Push your commit in the master branch This scheme should guarantee that: a. the stdlib CURRENT_AGDA branch always builds with the current released Agda version, b. the stdlib AGDA_MAINT branch always build with the Agda maint branch and c. the stdlib master branch always builds with the Agda master branch. agda-stdlib-0.12/Header000066400000000000000000000004561270451047000147270ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- All library modules, along with short descriptions ------------------------------------------------------------------------ -- Note that core modules are not included. module Everything where agda-stdlib-0.12/LICENCE000066400000000000000000000030231270451047000145720ustar00rootroot00000000000000Copyright (c) 2007-2016 Nils Anders Danielsson, Ulf Norell, Shin-Cheng Mu, Samuel Bronson, Dan Doel, Patrik Jansson, Liang-Ting Chen, Jean-Philippe Bernardy, Andrés Sicard-Ramírez, Nicolas Pouillard, Darin Morrison, Peter Berry, Daniel Brown, Simon Foster, Dominique Devriese, Andreas Abel, Alcatel-Lucent, Eric Mertens, Joachim Breitner, Liyang Hu, Noam Zeilberger, Érdi GergÅ‘, Stevan Andjelkovic, Helmut Grohne, Guilhem Moulin, Noriyuki OHKAWA, Evgeny Kotelnikov, James Chapman, Pepijn Kokke and some anonymous contributors. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. agda-stdlib-0.12/README.agda000066400000000000000000000237771270451047000154020ustar00rootroot00000000000000module README where ------------------------------------------------------------------------ -- The Agda standard library, version 0.12 -- -- Author: Nils Anders Danielsson, with contributions from Andreas -- Abel, Stevan Andjelkovic, Jean-Philippe Bernardy, Peter Berry, -- Joachim Breitner, Samuel Bronson, Daniel Brown, James Chapman, -- Liang-Ting Chen, Dominique Devriese, Dan Doel, Érdi GergÅ‘, Helmut -- Grohne, Simon Foster, Liyang Hu, Patrik Jansson, Alan Jeffrey, -- Pepijn Kokke, Evgeny Kotelnikov, Eric Mertens, Darin Morrison, -- Guilhem Moulin, Shin-Cheng Mu, Ulf Norell, Noriyuki OHKAWA, Nicolas -- Pouillard, Andrés Sicard-Ramírez, Noam Zeilberger and some -- anonymous contributors. -- ---------------------------------------------------------------------- -- This version of the library has been tested using Agda 2.5.1. -- Note that no guarantees are currently made about forwards or -- backwards compatibility, the library is still at an experimental -- stage. -- The library comes with a .agda-lib file, for use with the library -- management system. -- Currently the library does not support the JavaScript compiler -- backend. -- Contributions to this library are welcome (but to avoid wasted work -- it is suggested that you discuss large changes before implementing -- them). Please send contributions in the form of git pull requests, -- patch bundles or ask for commmit rights to the repository. It is -- appreciated if every patch contains a single, complete change, and -- if the coding style used in the library is adhered to. ------------------------------------------------------------------------ -- Module hierarchy ------------------------------------------------------------------------ -- The top-level module names of the library are currently allocated -- as follows: -- -- • Algebra -- Abstract algebra (monoids, groups, rings etc.), along with -- properties needed to specify these structures (associativity, -- commutativity, etc.), and operations on and proofs about the -- structures. -- • Category -- Category theory-inspired idioms used to structure functional -- programs (functors and monads, for instance). -- • Coinduction -- Support for coinduction. -- • Data -- Data types and properties about data types. -- • Function -- Combinators and properties related to functions. -- • Foreign -- Related to the foreign function interface. -- • Induction -- A general framework for induction (includes lexicographic and -- well-founded induction). -- • IO -- Input/output-related functions. -- • Irrelevance -- Definitions related to (proscriptive) irrelevance. -- • Level -- Universe levels. -- • Record -- An encoding of record types with manifest fields and "with". -- • Reflection -- Support for reflection. -- • Relation -- Properties of and proofs about relations (mostly homogeneous -- binary relations). -- • Size -- Sizes used by the sized types mechanism. -- • Universe -- A definition of universes. ------------------------------------------------------------------------ -- A selection of useful library modules ------------------------------------------------------------------------ -- Note that module names in source code are often hyperlinked to the -- corresponding module. In the Emacs mode you can follow these -- hyperlinks by typing M-. or clicking with the middle mouse button. -- • Some data types import Data.Bool -- Booleans. import Data.Char -- Characters. import Data.Empty -- The empty type. import Data.Fin -- Finite sets. import Data.List -- Lists. import Data.Maybe -- The maybe type. import Data.Nat -- Natural numbers. import Data.Product -- Products. import Data.Stream -- Streams. import Data.String -- Strings. import Data.Sum -- Disjoint sums. import Data.Unit -- The unit type. import Data.Vec -- Fixed-length vectors. -- • Some types used to structure computations import Category.Functor -- Functors. import Category.Applicative -- Applicative functors. import Category.Monad -- Monads. -- • Equality -- Propositional equality: import Relation.Binary.PropositionalEquality -- Convenient syntax for "equational reasoning" using a preorder: import Relation.Binary.PreorderReasoning -- Solver for commutative ring or semiring equalities: import Algebra.RingSolver -- • Properties of functions, sets and relations -- Monoids, rings and similar algebraic structures: import Algebra -- Negation, decidability, and similar operations on sets: import Relation.Nullary -- Properties of homogeneous binary relations: import Relation.Binary -- • Induction -- An abstraction of various forms of recursion/induction: import Induction -- Well-founded induction: import Induction.WellFounded -- Various forms of induction for natural numbers: import Induction.Nat -- • Support for coinduction import Coinduction -- • IO import IO ------------------------------------------------------------------------ -- Record hierarchies ------------------------------------------------------------------------ -- When an abstract hierarchy of some sort (for instance semigroup → -- monoid → group) is included in the library the basic approach is to -- specify the properties of every concept in terms of a record -- containing just properties, parameterised on the underlying -- operations, sets etc.: -- -- record IsSemigroup {A} (≈ : Rel A) (∙ : Opâ‚‚ A) : Set where -- open FunctionProperties ≈ -- field -- isEquivalence : IsEquivalence ≈ -- assoc : Associative ∙ -- ∙-cong : ∙ Preservesâ‚‚ ≈ ⟶ ≈ ⟶ ≈ -- -- More specific concepts are then specified in terms of the simpler -- ones: -- -- record IsMonoid {A} (≈ : Rel A) (∙ : Opâ‚‚ A) (ε : A) : Set where -- open FunctionProperties ≈ -- field -- isSemigroup : IsSemigroup ≈ ∙ -- identity : Identity ε ∙ -- -- open IsSemigroup isSemigroup public -- -- Note here that open IsSemigroup isSemigroup public ensures that the -- fields of the isSemigroup record can be accessed directly; this -- technique enables the user of an IsMonoid record to use underlying -- records without having to manually open an entire record hierarchy. -- This is not always possible, though. Consider the following definition -- of preorders: -- -- record IsPreorder {A : Set} -- (_≈_ : Rel A) -- The underlying equality. -- (_∼_ : Rel A) -- The relation. -- : Set where -- field -- isEquivalence : IsEquivalence _≈_ -- -- Reflexivity is expressed in terms of an underlying equality: -- reflexive : _≈_ ⇒ _∼_ -- trans : Transitive _∼_ -- -- module Eq = IsEquivalence isEquivalence -- -- ... -- -- The Eq module in IsPreorder is not opened publicly, because it -- contains some fields which clash with fields or other definitions -- in IsPreorder. -- Records packing up properties with the corresponding operations, -- sets, etc. are sometimes also defined: -- -- record Semigroup : Setâ‚ where -- infixl 7 _∙_ -- infix 4 _≈_ -- field -- Carrier : Set -- _≈_ : Rel Carrier -- _∙_ : Opâ‚‚ Carrier -- isSemigroup : IsSemigroup _≈_ _∙_ -- -- open IsSemigroup isSemigroup public -- -- setoid : Setoid -- setoid = record { isEquivalence = isEquivalence } -- -- record Monoid : Setâ‚ where -- infixl 7 _∙_ -- infix 4 _≈_ -- field -- Carrier : Set -- _≈_ : Rel Carrier -- _∙_ : Opâ‚‚ Carrier -- ε : Carrier -- isMonoid : IsMonoid _≈_ _∙_ ε -- -- open IsMonoid isMonoid public -- -- semigroup : Semigroup -- semigroup = record { isSemigroup = isSemigroup } -- -- open Semigroup semigroup public using (setoid) -- -- Note that the Monoid record does not include a Semigroup field. -- Instead the Monoid /module/ includes a "repackaging function" -- semigroup which converts a Monoid to a Semigroup. -- The above setup may seem a bit complicated, but we think it makes the -- library quite easy to work with, while also providing enough -- flexibility. ------------------------------------------------------------------------ -- More documentation ------------------------------------------------------------------------ -- Some examples showing where the natural numbers/integers and some -- related operations and properties are defined, and how they can be -- used: import README.Nat import README.Integer -- Some examples showing how the AVL tree module can be used. import README.AVL -- An example showing how the Record module can be used. import README.Record -- An example showing how the case expression can be used. import README.Case -- An example showing how the free monad construction on containers can be -- used import README.Container.FreeMonad ------------------------------------------------------------------------ -- Core modules ------------------------------------------------------------------------ -- Some modules have names ending in ".Core". These modules are -- internal, and have (mostly) been created to avoid mutual recursion -- between modules. They should not be imported directly; their -- contents are reexported by other modules. ------------------------------------------------------------------------ -- All library modules ------------------------------------------------------------------------ -- For short descriptions of every library module, see Everything: import Everything -- Note that the Everything module is generated automatically. If you -- have downloaded the library from its Git repository and want to -- type check README then you can (try to) construct Everything by -- running "cabal install && GenerateEverything". -- Note that all library sources are located under src or ffi. The -- modules README, README.* and Everything are not really part of the -- library, so these modules are located in the top-level directory -- instead. agda-stdlib-0.12/README.md000066400000000000000000000002371270451047000150700ustar00rootroot00000000000000agda-stdlib =========== The Agda standard library. You can browse the source in glorious clickable html here: https://agda.github.io/agda-stdlib/README.html agda-stdlib-0.12/README/000077500000000000000000000000001270451047000145445ustar00rootroot00000000000000agda-stdlib-0.12/README/AVL.agda000066400000000000000000000062651270451047000160150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing how the AVL tree module can be used ------------------------------------------------------------------------ module README.AVL where ------------------------------------------------------------------------ -- Setup -- AVL trees are defined in Data.AVL. import Data.AVL -- This module is parametrised by keys, which have to form a (strict) -- total order, and values, which are indexed by keys. Let us use -- natural numbers as keys and vectors of strings as values. import Data.Nat.Properties as â„• open import Data.String using (String) open import Data.Vec using (Vec; _∷_; []) open import Relation.Binary using (module StrictTotalOrder) open Data.AVL (Vec String) (StrictTotalOrder.isStrictTotalOrder â„•.strictTotalOrder) ------------------------------------------------------------------------ -- Construction of trees -- Some values. vâ‚ = "cepa" ∷ [] vâ‚′ = "depa" ∷ [] vâ‚‚ = "apa" ∷ "bepa" ∷ [] -- Empty and singleton trees. tâ‚€ : Tree tâ‚€ = empty tâ‚ : Tree tâ‚ = singleton 2 vâ‚‚ -- Insertion of a key-value pair into a tree. tâ‚‚ = insert 1 vâ‚ tâ‚ -- If you insert a key-value pair and the key already exists in the -- tree, then the old value is thrown away. t₂′ = insert 1 vâ‚′ tâ‚‚ -- Deletion of the mapping for a certain key. t₃ = delete 2 tâ‚‚ -- Conversion of a list of key-value mappings to a tree. open import Data.List using (_∷_; []) open import Data.Product as Prod using (_,_; _,′_) tâ‚„ = fromList ((2 , vâ‚‚) ∷ (1 , vâ‚) ∷ []) ------------------------------------------------------------------------ -- Queries -- Let us formulate queries as unit tests. open import Relation.Binary.PropositionalEquality using (_≡_; refl) -- Searching for a key. open import Data.Bool.Base using (true; false) open import Data.Maybe.Base as Maybe using (just; nothing) qâ‚€ : lookup 2 tâ‚‚ ≡ just vâ‚‚ qâ‚€ = refl qâ‚ : lookup 2 t₃ ≡ nothing qâ‚ = refl qâ‚‚ : (3 ∈? tâ‚‚) ≡ false qâ‚‚ = refl q₃ : (1 ∈? tâ‚„) ≡ true q₃ = refl -- Turning a tree into a sorted list of key-value pairs. qâ‚„ : toList t₠≡ (2 , vâ‚‚) ∷ [] qâ‚„ = refl qâ‚… : toList tâ‚‚ ≡ (1 , vâ‚) ∷ (2 , vâ‚‚) ∷ [] qâ‚… = refl q₅′ : toList t₂′ ≡ (1 , vâ‚′) ∷ (2 , vâ‚‚) ∷ [] q₅′ = refl ------------------------------------------------------------------------ -- Views -- Partitioning a tree into the smallest element plus the rest, or the -- largest element plus the rest. open import Function using (id) v₆ : headTail tâ‚€ ≡ nothing v₆ = refl v₇ : Maybe.map (Prod.map id toList) (headTail tâ‚‚) ≡ just ((1 , vâ‚) , ((2 , vâ‚‚) ∷ [])) v₇ = refl v₈ : initLast tâ‚€ ≡ nothing v₈ = refl v₉ : Maybe.map (Prod.map toList id) (initLast tâ‚„) ≡ just (((1 , vâ‚) ∷ []) ,′ (2 , vâ‚‚)) v₉ = refl ------------------------------------------------------------------------ -- Further reading -- Variations of the AVL tree module are available: -- • Finite maps with indexed keys and values. import Data.AVL.IndexedMap -- • Finite sets. import Data.AVL.Sets agda-stdlib-0.12/README/Case.agda000066400000000000000000000016531270451047000162420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the case expressions can be used ------------------------------------------------------------------------ module README.Case where open import Data.Fin hiding (pred) open import Data.Maybe hiding (from-just) open import Data.Nat hiding (pred) open import Function -- Some simple examples. empty : ∀ {a} {A : Set a} → Fin 0 → A empty i = case i of λ() pred : â„• → â„• pred n = case n of λ { zero → zero ; (suc n) → n } from-just : ∀ {a} {A : Set a} (x : Maybe A) → From-just A x from-just x = case x return From-just _ of λ { (just x) → x ; nothing → _ } -- Note that some natural uses of case are rejected by the termination -- checker: -- -- plus : â„• → â„• → â„• -- plus m n = case m of λ -- { zero → n -- ; (suc m) → suc (plus m n) -- } agda-stdlib-0.12/README/Container/000077500000000000000000000000001270451047000164665ustar00rootroot00000000000000agda-stdlib-0.12/README/Container/FreeMonad.agda000066400000000000000000000036321270451047000211500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example showing how the free monad construction on containers can be -- used ------------------------------------------------------------------------ module README.Container.FreeMonad where open import Category.Monad open import Data.Empty open import Data.Unit open import Data.Bool.Base using (Bool; true) open import Data.Nat open import Data.Sum using (injâ‚; injâ‚‚) open import Data.Product renaming (_×_ to _⟨×⟩_) open import Data.Container open import Data.Container.Combinator open import Data.Container.FreeMonad open import Data.W open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- The signature of state and its (generic) operations. State : Set → Container _ State S = ⊤ ⟶ S ⊎ S ⟶ ⊤ where _⟶_ : Set → Set → Container _ I ⟶ O = I â–· λ _ → O get : ∀ {S} → State S ⋆ S get = do (injâ‚ _ , return) where open RawMonad rawMonad put : ∀ {S} → S → State S ⋆ ⊤ put s = do (injâ‚‚ s , return) where open RawMonad rawMonad -- Using the above we can, for example, write a stateful program that -- delivers a boolean. prog : State â„• ⋆ Bool prog = get >>= λ n → put (suc n) >> return true where open RawMonad rawMonad runState : ∀ {S X} → State S ⋆ X → (S → X ⟨×⟩ S) runState (sup (injâ‚ x) _) = λ s → x , s runState (sup (injâ‚‚ (injâ‚ _)) k) = λ s → runState (k s) s runState (sup (injâ‚‚ (injâ‚‚ s)) k) = λ _ → runState (k _) s test : runState prog 0 ≡ (true , 1) test = refl -- It should be noted that @State S ⋆ X@ is not the state monad. If we -- could quotient @State S ⋆ X@ by the seven axioms of state (see -- Plotkin and Power's "Notions of Computation Determine Monads", 2002) -- then we would get the state monad. agda-stdlib-0.12/README/Integer.agda000066400000000000000000000037341270451047000167660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing where the integers and some related -- operations and properties are defined, and how they can be used ------------------------------------------------------------------------ module README.Integer where -- The integers and various arithmetic operations are defined in -- Data.Integer. open import Data.Integer -- The +_ function converts natural numbers into integers. exâ‚ : ℤ exâ‚ = + 2 -- The -_ function negates an integer. exâ‚‚ : ℤ exâ‚‚ = - + 4 -- Some binary operators are also defined, including addition, -- subtraction and multiplication. ex₃ : ℤ ex₃ = + 1 + + 3 * - + 2 - + 4 -- Propositional equality and some related properties can be found -- in Relation.Binary.PropositionalEquality. open import Relation.Binary.PropositionalEquality as P using (_≡_) exâ‚„ : ex₃ ≡ - + 9 exâ‚„ = P.refl -- Data.Integer.Properties contains a number of properties related to -- integers. Algebra defines what a commutative ring is, among other -- things. open import Algebra import Data.Integer.Properties as Integer private module CR = CommutativeRing Integer.commutativeRing exâ‚… : ∀ i j → i * j ≡ j * i exâ‚… i j = CR.*-comm i j -- The module ≡-Reasoning in Relation.Binary.PropositionalEquality -- provides some combinators for equational reasoning. open P.≡-Reasoning open import Data.Product ex₆ : ∀ i j → i * (j + + 0) ≡ j * i ex₆ i j = begin i * (j + + 0) ≡⟨ P.cong (_*_ i) (projâ‚‚ CR.+-identity j) ⟩ i * j ≡⟨ CR.*-comm i j ⟩ j * i ∎ -- The module RingSolver in Data.Integer.Properties contains a solver -- for integer equalities involving variables, constants, _+_, _*_, -_ -- and _-_. ex₇ : ∀ i j → i * - j - j * i ≡ - + 2 * i * j ex₇ = solve 2 (λ i j → i :* :- j :- j :* i := :- con (+ 2) :* i :* j) P.refl where open Integer.RingSolver agda-stdlib-0.12/README/Nat.agda000066400000000000000000000031631270451047000161070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing where the natural numbers and some related -- operations and properties are defined, and how they can be used ------------------------------------------------------------------------ module README.Nat where -- The natural numbers and various arithmetic operations are defined -- in Data.Nat. open import Data.Nat exâ‚ : â„• exâ‚ = 1 + 3 -- Propositional equality and some related properties can be found -- in Relation.Binary.PropositionalEquality. open import Relation.Binary.PropositionalEquality exâ‚‚ : 3 + 5 ≡ 2 * 4 exâ‚‚ = refl -- Data.Nat.Properties contains a number of properties about natural -- numbers. Algebra defines what a commutative semiring is, among -- other things. open import Algebra import Data.Nat.Properties as Nat private module CS = CommutativeSemiring Nat.commutativeSemiring ex₃ : ∀ m n → m * n ≡ n * m ex₃ m n = CS.*-comm m n -- The module ≡-Reasoning in Relation.Binary.PropositionalEquality -- provides some combinators for equational reasoning. open ≡-Reasoning open import Data.Product exâ‚„ : ∀ m n → m * (n + 0) ≡ n * m exâ‚„ m n = begin m * (n + 0) ≡⟨ cong (_*_ m) (projâ‚‚ CS.+-identity n) ⟩ m * n ≡⟨ CS.*-comm m n ⟩ n * m ∎ -- The module SemiringSolver in Data.Nat.Properties contains a solver -- for natural number equalities involving variables, constants, _+_ -- and _*_. open Nat.SemiringSolver exâ‚… : ∀ m n → m * (n + 0) ≡ n * m exâ‚… = solve 2 (λ m n → m :* (n :+ con 0) := n :* m) refl agda-stdlib-0.12/README/Record.agda000066400000000000000000000022071270451047000166010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how the Record module can be used ------------------------------------------------------------------------ -- Taken from Randy Pollack's paper "Dependently Typed Records in Type -- Theory". module README.Record where open import Data.Product open import Data.String open import Function using (flip) open import Level import Record open import Relation.Binary -- Let us use strings as labels. open Record String _≟_ -- Partial equivalence relations. PER : Signature _ PER = ∅ , "S" ∶ (λ _ → Set) , "R" ∶ (λ r → r · "S" → r · "S" → Set) , "sym" ∶ (λ r → Lift (Symmetric (r · "R"))) , "trans" ∶ (λ r → Lift (Transitive (r · "R"))) -- Given a PER the converse relation is also a PER. converse : (P : Record PER) → Record (PER With "S" ≔ (λ _ → P · "S") With "R" ≔ (λ _ → flip (P · "R"))) converse P = rec (rec (_ , lift λ {_} → lower (P · "sym")) , lift λ {_} yRx zRy → lower (P · "trans") zRy yRx) agda-stdlib-0.12/Setup.hs000066400000000000000000000000571270451047000152450ustar00rootroot00000000000000import Distribution.Simple main = defaultMain agda-stdlib-0.12/doc/000077500000000000000000000000001270451047000143545ustar00rootroot00000000000000agda-stdlib-0.12/doc/release-notes/000077500000000000000000000000001270451047000171225ustar00rootroot00000000000000agda-stdlib-0.12/doc/release-notes/future.txt000066400000000000000000000020441270451047000211750ustar00rootroot00000000000000NOTE: Put drafts of release notes here that might be included in some future release. Don't remove this message please! ------------------------------------------------------------------------------ * Support for the UHC backend has been added. * The tri⟶irr function has been made more general. * The field <-resp-≈ has been removed from the IsStrictTotalOrder record. The property can be derived (see the new lemma Relation.Binary.Consequences.trans∧tri⟶resp≈), and is available from the IsStrictTotalOrder record module. * Various changes required by changes in Agda (see Agda CHANGELOG): ** Hiding some modules in import directives after fixing #836. ** Removed COMPILED_DATA for Bool.Base.agda. ** Removed the IRRAXIOM built-in from Irrelevance.agda ** Added BUILTIN bindings in Data/Integer.agda ** IO FFI calls work with the now Data.Text-backed String builtins. ** Added parentheses for fixing operators and sections parsing. ** Added BUILTIN binding in Data/Unit.agda. ** Various changes in Reflection.agda agda-stdlib-0.12/index.sh000077500000000000000000000002451270451047000152560ustar00rootroot00000000000000for i in $( find src -name "*.agda" | grep -v "index.agda" | sed 's/src\/\(.*\)\.agda/\1/' | sed 's/\//\./g' | sort ); do echo "import $i" >> src/index.agda; done agda-stdlib-0.12/lib.cabal000066400000000000000000000011461270451047000153430ustar00rootroot00000000000000name: lib version: 0.12 cabal-version: >= 1.8 build-type: Simple description: Helper programs. license: MIT tested-with: GHC == 7.10.3 executable GenerateEverything hs-source-dirs: . main-is: GenerateEverything.hs build-depends: base >= 4.6.0.1 && < 4.10 , filemanip >= 0.3.6.2 && < 0.4 , filepath >= 1.3.0.1 && < 1.5 executable AllNonAsciiChars hs-source-dirs: . main-is: AllNonAsciiChars.hs build-depends: base >= 4.6.0.1 && < 4.10 , filemanip >= 0.3.6.2 && < 0.4 agda-stdlib-0.12/notes/000077500000000000000000000000001270451047000147375ustar00rootroot00000000000000agda-stdlib-0.12/notes/stdlib-releases.txt000066400000000000000000000024121270451047000205610ustar00rootroot00000000000000When releasing a new version of Agda standard library, the following procedure can be followed: * Update README.agda: ** Replace 'development version' by 'version X.Y' in the title. ** After the list of authors, replace -- The development version of the library often requires the latest -- development version of Agda. by -- This version of the library has been tested using Agda A.B.C. * Update the lib.cabal version to X.Y. * Ensure that the library type-checks using Agda A.B.C: make test * If necessary, copy the contents of notes/future-version.txt to CHANGELOG. Remove the contents from notes/future-version.txt * Finish the CHANGELOG. * Update the copyright year range in the LICENSE file, if necessary. * Tag version X.Y (do not forget to record the changes above first): VERSION=X.Y git tag -a v$VERSION -m "Agda standard library v$VERSION" * Removed release-specific information from README.agda. * Add a new header to CHANGELOG (do not forget to record the changes). * Push all the changes and the new tag (requires Git >= 1.8.3): git push --follow-tags * Update the Agda wiki: ** News section on the main page. ** The standard library page. * Announce the release of the new version on the Agda mailing list. agda-stdlib-0.12/publish-listings.sh000077500000000000000000000007031270451047000174460ustar00rootroot00000000000000#!/bin/bash cd /tmp git clone git@github.com:agda/agda-stdlib.git cd agda-stdlib git checkout gh-pages git merge master -m "[auto] merge master into gh-pages" make listings if [ "`git status --porcelain`" != "" ]; then echo "Updates:" git status --porcelain changed=`git status --porcelain | cut -c4-` git add --all -- $changed git commit -m "[auto] updated html listings" git push else echo "No changes!" fi cd .. rm -rf agda-stdlib agda-stdlib-0.12/src/000077500000000000000000000000001270451047000143765ustar00rootroot00000000000000agda-stdlib-0.12/src/Algebra.agda000066400000000000000000000325461270451047000165630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of algebraic structures like monoids and rings -- (packed in records together with sets, operations, etc.) ------------------------------------------------------------------------ module Algebra where open import Relation.Binary open import Algebra.FunctionProperties open import Algebra.Structures open import Function open import Level ------------------------------------------------------------------------ -- Semigroups, (commutative) monoids and (abelian) groups record Semigroup c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∙_ : Opâ‚‚ Carrier isSemigroup : IsSemigroup _≈_ _∙_ open IsSemigroup isSemigroup public setoid : Setoid _ _ setoid = record { isEquivalence = isEquivalence } -- A raw monoid is a monoid without any laws. record RawMonoid c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∙_ : Opâ‚‚ Carrier ε : Carrier record Monoid c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∙_ : Opâ‚‚ Carrier ε : Carrier isMonoid : IsMonoid _≈_ _∙_ ε open IsMonoid isMonoid public semigroup : Semigroup _ _ semigroup = record { isSemigroup = isSemigroup } open Semigroup semigroup public using (setoid) rawMonoid : RawMonoid _ _ rawMonoid = record { _≈_ = _≈_ ; _∙_ = _∙_ ; ε = ε } record CommutativeMonoid c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∙_ : Opâ‚‚ Carrier ε : Carrier isCommutativeMonoid : IsCommutativeMonoid _≈_ _∙_ ε open IsCommutativeMonoid isCommutativeMonoid public monoid : Monoid _ _ monoid = record { isMonoid = isMonoid } open Monoid monoid public using (setoid; semigroup; rawMonoid) record Group c â„“ : Set (suc (c ⊔ â„“)) where infix 8 _â»Â¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∙_ : Opâ‚‚ Carrier ε : Carrier _â»Â¹ : Opâ‚ Carrier isGroup : IsGroup _≈_ _∙_ ε _â»Â¹ open IsGroup isGroup public monoid : Monoid _ _ monoid = record { isMonoid = isMonoid } open Monoid monoid public using (setoid; semigroup; rawMonoid) record AbelianGroup c â„“ : Set (suc (c ⊔ â„“)) where infix 8 _â»Â¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∙_ : Opâ‚‚ Carrier ε : Carrier _â»Â¹ : Opâ‚ Carrier isAbelianGroup : IsAbelianGroup _≈_ _∙_ ε _â»Â¹ open IsAbelianGroup isAbelianGroup public group : Group _ _ group = record { isGroup = isGroup } open Group group public using (setoid; semigroup; monoid; rawMonoid) commutativeMonoid : CommutativeMonoid _ _ commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } ------------------------------------------------------------------------ -- Various kinds of semirings record NearSemiring c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier 0# : Carrier isNearSemiring : IsNearSemiring _≈_ _+_ _*_ 0# open IsNearSemiring isNearSemiring public +-monoid : Monoid _ _ +-monoid = record { isMonoid = +-isMonoid } open Monoid +-monoid public using (setoid) renaming ( semigroup to +-semigroup ; rawMonoid to +-rawMonoid) *-semigroup : Semigroup _ _ *-semigroup = record { isSemigroup = *-isSemigroup } record SemiringWithoutOne c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier 0# : Carrier isSemiringWithoutOne : IsSemiringWithoutOne _≈_ _+_ _*_ 0# open IsSemiringWithoutOne isSemiringWithoutOne public nearSemiring : NearSemiring _ _ nearSemiring = record { isNearSemiring = isNearSemiring } open NearSemiring nearSemiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; *-semigroup ) +-commutativeMonoid : CommutativeMonoid _ _ +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } record SemiringWithoutAnnihilatingZero c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier 0# : Carrier 1# : Carrier isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero _≈_ _+_ _*_ 0# 1# open IsSemiringWithoutAnnihilatingZero isSemiringWithoutAnnihilatingZero public +-commutativeMonoid : CommutativeMonoid _ _ +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } open CommutativeMonoid +-commutativeMonoid public using (setoid) renaming ( semigroup to +-semigroup ; rawMonoid to +-rawMonoid ; monoid to +-monoid ) *-monoid : Monoid _ _ *-monoid = record { isMonoid = *-isMonoid } open Monoid *-monoid public using () renaming ( semigroup to *-semigroup ; rawMonoid to *-rawMonoid ) record Semiring c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier 0# : Carrier 1# : Carrier isSemiring : IsSemiring _≈_ _+_ _*_ 0# 1# open IsSemiring isSemiring public semiringWithoutAnnihilatingZero : SemiringWithoutAnnihilatingZero _ _ semiringWithoutAnnihilatingZero = record { isSemiringWithoutAnnihilatingZero = isSemiringWithoutAnnihilatingZero } open SemiringWithoutAnnihilatingZero semiringWithoutAnnihilatingZero public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid ) semiringWithoutOne : SemiringWithoutOne _ _ semiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne } open SemiringWithoutOne semiringWithoutOne public using (nearSemiring) record CommutativeSemiringWithoutOne c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier 0# : Carrier isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne _≈_ _+_ _*_ 0# open IsCommutativeSemiringWithoutOne isCommutativeSemiringWithoutOne public semiringWithoutOne : SemiringWithoutOne _ _ semiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne } open SemiringWithoutOne semiringWithoutOne public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup ; nearSemiring ) record CommutativeSemiring c â„“ : Set (suc (c ⊔ â„“)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier 0# : Carrier 1# : Carrier isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# open IsCommutativeSemiring isCommutativeSemiring public semiring : Semiring _ _ semiring = record { isSemiring = isSemiring } open Semiring semiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ) *-commutativeMonoid : CommutativeMonoid _ _ *-commutativeMonoid = record { isCommutativeMonoid = *-isCommutativeMonoid } commutativeSemiringWithoutOne : CommutativeSemiringWithoutOne _ _ commutativeSemiringWithoutOne = record { isCommutativeSemiringWithoutOne = isCommutativeSemiringWithoutOne } ------------------------------------------------------------------------ -- (Commutative) rings -- A raw ring is a ring without any laws. record RawRing c : Set (suc c) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ field Carrier : Set c _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier -_ : Opâ‚ Carrier 0# : Carrier 1# : Carrier record Ring c â„“ : Set (suc (c ⊔ â„“)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier -_ : Opâ‚ Carrier 0# : Carrier 1# : Carrier isRing : IsRing _≈_ _+_ _*_ -_ 0# 1# open IsRing isRing public +-abelianGroup : AbelianGroup _ _ +-abelianGroup = record { isAbelianGroup = +-isAbelianGroup } semiring : Semiring _ _ semiring = record { isSemiring = isSemiring } open Semiring semiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ) open AbelianGroup +-abelianGroup public using () renaming (group to +-group) rawRing : RawRing _ rawRing = record { _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0# ; 1# = 1# } record CommutativeRing c â„“ : Set (suc (c ⊔ â„“)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier -_ : Opâ‚ Carrier 0# : Carrier 1# : Carrier isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ 0# 1# open IsCommutativeRing isCommutativeRing public ring : Ring _ _ ring = record { isRing = isRing } commutativeSemiring : CommutativeSemiring _ _ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open Ring ring public using (rawRing; +-group; +-abelianGroup) open CommutativeSemiring commutativeSemiring public using ( setoid ; +-semigroup; +-rawMonoid; +-monoid; +-commutativeMonoid ; *-semigroup; *-rawMonoid; *-monoid; *-commutativeMonoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero; semiring ; commutativeSemiringWithoutOne ) ------------------------------------------------------------------------ -- (Distributive) lattices and boolean algebras record Lattice c â„“ : Set (suc (c ⊔ â„“)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∨_ : Opâ‚‚ Carrier _∧_ : Opâ‚‚ Carrier isLattice : IsLattice _≈_ _∨_ _∧_ open IsLattice isLattice public setoid : Setoid _ _ setoid = record { isEquivalence = isEquivalence } record DistributiveLattice c â„“ : Set (suc (c ⊔ â„“)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∨_ : Opâ‚‚ Carrier _∧_ : Opâ‚‚ Carrier isDistributiveLattice : IsDistributiveLattice _≈_ _∨_ _∧_ open IsDistributiveLattice isDistributiveLattice public lattice : Lattice _ _ lattice = record { isLattice = isLattice } open Lattice lattice public using (setoid) record BooleanAlgebra c â„“ : Set (suc (c ⊔ â„“)) where infix 8 ¬_ infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _∨_ : Opâ‚‚ Carrier _∧_ : Opâ‚‚ Carrier ¬_ : Opâ‚ Carrier ⊤ : Carrier ⊥ : Carrier isBooleanAlgebra : IsBooleanAlgebra _≈_ _∨_ _∧_ ¬_ ⊤ ⊥ open IsBooleanAlgebra isBooleanAlgebra public distributiveLattice : DistributiveLattice _ _ distributiveLattice = record { isDistributiveLattice = isDistributiveLattice } open DistributiveLattice distributiveLattice public using (setoid; lattice) agda-stdlib-0.12/src/Algebra/000077500000000000000000000000001270451047000157335ustar00rootroot00000000000000agda-stdlib-0.12/src/Algebra/FunctionProperties.agda000066400000000000000000000053641270451047000224230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of functions, such as associativity and commutativity ------------------------------------------------------------------------ -- These properties can (for instance) be used to define algebraic -- structures. open import Level open import Relation.Binary -- The properties are specified using the following relation as -- "equality". module Algebra.FunctionProperties {a â„“} {A : Set a} (_≈_ : Rel A â„“) where open import Data.Product ------------------------------------------------------------------------ -- Unary and binary operations open import Algebra.FunctionProperties.Core public ------------------------------------------------------------------------ -- Properties of operations Associative : Opâ‚‚ A → Set _ Associative _∙_ = ∀ x y z → ((x ∙ y) ∙ z) ≈ (x ∙ (y ∙ z)) Commutative : Opâ‚‚ A → Set _ Commutative _∙_ = ∀ x y → (x ∙ y) ≈ (y ∙ x) LeftIdentity : A → Opâ‚‚ A → Set _ LeftIdentity e _∙_ = ∀ x → (e ∙ x) ≈ x RightIdentity : A → Opâ‚‚ A → Set _ RightIdentity e _∙_ = ∀ x → (x ∙ e) ≈ x Identity : A → Opâ‚‚ A → Set _ Identity e ∙ = LeftIdentity e ∙ × RightIdentity e ∙ LeftZero : A → Opâ‚‚ A → Set _ LeftZero z _∙_ = ∀ x → (z ∙ x) ≈ z RightZero : A → Opâ‚‚ A → Set _ RightZero z _∙_ = ∀ x → (x ∙ z) ≈ z Zero : A → Opâ‚‚ A → Set _ Zero z ∙ = LeftZero z ∙ × RightZero z ∙ LeftInverse : A → Opâ‚ A → Opâ‚‚ A → Set _ LeftInverse e _â»Â¹ _∙_ = ∀ x → ((x â»Â¹) ∙ x) ≈ e RightInverse : A → Opâ‚ A → Opâ‚‚ A → Set _ RightInverse e _â»Â¹ _∙_ = ∀ x → (x ∙ (x â»Â¹)) ≈ e Inverse : A → Opâ‚ A → Opâ‚‚ A → Set _ Inverse e â»Â¹ ∙ = LeftInverse e â»Â¹ ∙ × RightInverse e â»Â¹ ∙ _DistributesOverË¡_ : Opâ‚‚ A → Opâ‚‚ A → Set _ _*_ DistributesOverË¡ _+_ = ∀ x y z → (x * (y + z)) ≈ ((x * y) + (x * z)) _DistributesOverʳ_ : Opâ‚‚ A → Opâ‚‚ A → Set _ _*_ DistributesOverʳ _+_ = ∀ x y z → ((y + z) * x) ≈ ((y * x) + (z * x)) _DistributesOver_ : Opâ‚‚ A → Opâ‚‚ A → Set _ * DistributesOver + = (* DistributesOverË¡ +) × (* DistributesOverʳ +) _IdempotentOn_ : Opâ‚‚ A → A → Set _ _∙_ IdempotentOn x = (x ∙ x) ≈ x Idempotent : Opâ‚‚ A → Set _ Idempotent ∙ = ∀ x → ∙ IdempotentOn x IdempotentFun : Opâ‚ A → Set _ IdempotentFun f = ∀ x → f (f x) ≈ f x _Absorbs_ : Opâ‚‚ A → Opâ‚‚ A → Set _ _∙_ Absorbs _∘_ = ∀ x y → (x ∙ (x ∘ y)) ≈ x Absorptive : Opâ‚‚ A → Opâ‚‚ A → Set _ Absorptive ∙ ∘ = (∙ Absorbs ∘) × (∘ Absorbs ∙) Involutive : Opâ‚ A → Set _ Involutive f = ∀ x → f (f x) ≈ x agda-stdlib-0.12/src/Algebra/FunctionProperties/000077500000000000000000000000001270451047000215755ustar00rootroot00000000000000agda-stdlib-0.12/src/Algebra/FunctionProperties/Core.agda000066400000000000000000000014361270451047000233070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of functions, such as associativity and commutativity ------------------------------------------------------------------------ -- This file contains some core definitions which are reexported by -- Algebra.FunctionProperties. They are placed here because -- Algebra.FunctionProperties is a parameterised module, and some of -- the parameters are irrelevant for these definitions. module Algebra.FunctionProperties.Core where open import Level ------------------------------------------------------------------------ -- Unary and binary operations Opâ‚ : ∀ {â„“} → Set â„“ → Set â„“ Opâ‚ A = A → A Opâ‚‚ : ∀ {â„“} → Set â„“ → Set â„“ Opâ‚‚ A = A → A → A agda-stdlib-0.12/src/Algebra/Monoid-solver.agda000066400000000000000000000113721270451047000213120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for monoid equalities ------------------------------------------------------------------------ open import Algebra module Algebra.Monoid-solver {mâ‚ mâ‚‚} (M : Monoid mâ‚ mâ‚‚) where open import Data.Fin import Data.Fin.Properties as Fin open import Data.List.Base open import Data.Maybe as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat.Base using (â„•) open import Data.Product open import Data.Vec using (Vec; lookup) open import Function using (_∘_; _$_) import Relation.Binary.EqReasoning import Relation.Binary.List.Pointwise as Pointwise open import Relation.Binary.PropositionalEquality as P using (_≡_) import Relation.Binary.Reflection open import Relation.Nullary import Relation.Nullary.Decidable as Dec open Monoid M open Relation.Binary.EqReasoning setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ data Expr (n : â„•) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : â„• → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ Ï = lookup x Ï âŸ¦ id ⟧ Ï = ε ⟦ e₠⊕ eâ‚‚ ⟧ Ï = ⟦ e₠⟧ Ï âˆ™ ⟦ eâ‚‚ ⟧ Ï ------------------------------------------------------------------------ -- Normal forms -- A normal form is a list of variables. Normal : â„• → Set Normal n = List (Fin n) -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ Ï = ε ⟦ x ∷ nf ⟧⇓ Ï = lookup x Ï âˆ™ ⟦ nf ⟧⇓ Ï -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = x ∷ [] normalise id = [] normalise (e₠⊕ eâ‚‚) = normalise eâ‚ ++ normalise eâ‚‚ -- The normaliser is homomorphic with respect to _++_/_∙_. homomorphic : ∀ {n} (nfâ‚ nfâ‚‚ : Normal n) (Ï : Env n) → ⟦ nfâ‚ ++ nfâ‚‚ ⟧⇓ Ï â‰ˆ (⟦ nf₠⟧⇓ Ï âˆ™ ⟦ nfâ‚‚ ⟧⇓ Ï) homomorphic [] nfâ‚‚ Ï = begin ⟦ nfâ‚‚ ⟧⇓ Ï â‰ˆâŸ¨ sym $ projâ‚ identity _ ⟩ ε ∙ ⟦ nfâ‚‚ ⟧⇓ Ï âˆŽ homomorphic (x ∷ nfâ‚) nfâ‚‚ Ï = begin lookup x Ï âˆ™ ⟦ nfâ‚ ++ nfâ‚‚ ⟧⇓ Ï â‰ˆâŸ¨ ∙-cong refl (homomorphic nfâ‚ nfâ‚‚ Ï) ⟩ lookup x Ï âˆ™ (⟦ nf₠⟧⇓ Ï âˆ™ ⟦ nfâ‚‚ ⟧⇓ Ï) ≈⟨ sym $ assoc _ _ _ ⟩ lookup x Ï âˆ™ ⟦ nf₠⟧⇓ Ï âˆ™ ⟦ nfâ‚‚ ⟧⇓ Ï âˆŽ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (Ï : Env n) → ⟦ normalise e ⟧⇓ Ï â‰ˆ ⟦ e ⟧ Ï normalise-correct (var x) Ï = begin lookup x Ï âˆ™ ε ≈⟨ projâ‚‚ identity _ ⟩ lookup x Ï âˆŽ normalise-correct id Ï = begin ε ∎ normalise-correct (e₠⊕ eâ‚‚) Ï = begin ⟦ normalise eâ‚ ++ normalise eâ‚‚ ⟧⇓ Ï â‰ˆâŸ¨ homomorphic (normalise eâ‚) (normalise eâ‚‚) Ï âŸ© ⟦ normalise e₠⟧⇓ Ï âˆ™ ⟦ normalise eâ‚‚ ⟧⇓ Ï â‰ˆâŸ¨ ∙-cong (normalise-correct eâ‚ Ï) (normalise-correct eâ‚‚ Ï) ⟩ ⟦ e₠⟧ Ï âˆ™ ⟦ eâ‚‚ ⟧ Ï âˆŽ ------------------------------------------------------------------------ -- "Tactics" open module R = Relation.Binary.Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} (nfâ‚ nfâ‚‚ : Normal n) → Dec (nf₠≡ nfâ‚‚) nf₠≟ nfâ‚‚ = Dec.map′ Rel≡⇒≡ ≡⇒Rel≡ (decidable Fin._≟_ nfâ‚ nfâ‚‚) where open Pointwise -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (eâ‚ eâ‚‚ : Expr n) → Maybe (∀ Ï â†’ ⟦ e₠⟧ Ï â‰ˆ ⟦ eâ‚‚ ⟧ Ï) prove′ eâ‚ eâ‚‚ = Maybe.map lemma $ decToMaybe (normalise e₠≟ normalise eâ‚‚) where lemma : normalise e₠≡ normalise eâ‚‚ → ∀ Ï â†’ ⟦ e₠⟧ Ï â‰ˆ ⟦ eâ‚‚ ⟧ Ï lemma eq Ï = R.prove Ï eâ‚ eâ‚‚ (begin ⟦ normalise e₠⟧⇓ Ï â‰¡âŸ¨ P.cong (λ e → ⟦ e ⟧⇓ Ï) eq ⟩ ⟦ normalise eâ‚‚ ⟧⇓ Ï âˆŽ) -- This procedure can be combined with from-just. prove : ∀ n (es : Expr n × Expr n) → From-just (∀ Ï â†’ ⟦ projâ‚ es ⟧ Ï â‰ˆ ⟦ projâ‚‚ es ⟧ Ï) (uncurry prove′ es) prove _ = from-just ∘ uncurry prove′ agda-stdlib-0.12/src/Algebra/Morphism.agda000066400000000000000000000047671270451047000203650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Morphisms between algebraic structures ------------------------------------------------------------------------ module Algebra.Morphism where open import Relation.Binary open import Algebra open import Algebra.FunctionProperties import Algebra.Properties.Group as GroupP open import Function open import Data.Product open import Level import Relation.Binary.EqReasoning as EqR ------------------------------------------------------------------------ -- Basic definitions module Definitions {f t â„“} (From : Set f) (To : Set t) (_≈_ : Rel To â„“) where Morphism : Set _ Morphism = From → To Homomorphicâ‚€ : Morphism → From → To → Set _ Homomorphicâ‚€ ⟦_⟧ ∙ ∘ = ⟦ ∙ ⟧ ≈ ∘ Homomorphicâ‚ : Morphism → Funâ‚ From → Opâ‚ To → Set _ Homomorphic₠⟦_⟧ ∙_ ∘_ = ∀ x → ⟦ ∙ x ⟧ ≈ (∘ ⟦ x ⟧) Homomorphicâ‚‚ : Morphism → Funâ‚‚ From → Opâ‚‚ To → Set _ Homomorphicâ‚‚ ⟦_⟧ _∙_ _∘_ = ∀ x y → ⟦ x ∙ y ⟧ ≈ (⟦ x ⟧ ∘ ⟦ y ⟧) ------------------------------------------------------------------------ -- An example showing how a morphism type can be defined -- Ring homomorphisms. record _-Ring⟶_ {râ‚ râ‚‚ r₃ râ‚„} (From : Ring râ‚ râ‚‚) (To : Ring r₃ râ‚„) : Set (r₠⊔ râ‚‚ ⊔ r₃ ⊔ râ‚„) where private module F = Ring From module T = Ring To open Definitions F.Carrier T.Carrier T._≈_ field ⟦_⟧ : Morphism ⟦⟧-cong : ⟦_⟧ Preserves F._≈_ ⟶ T._≈_ +-homo : Homomorphicâ‚‚ ⟦_⟧ F._+_ T._+_ *-homo : Homomorphicâ‚‚ ⟦_⟧ F._*_ T._*_ 1-homo : Homomorphicâ‚€ ⟦_⟧ F.1# T.1# open EqR T.setoid 0-homo : Homomorphicâ‚€ ⟦_⟧ F.0# T.0# 0-homo = GroupP.left-identity-unique T.+-group ⟦ F.0# ⟧ ⟦ F.0# ⟧ (begin T._+_ ⟦ F.0# ⟧ ⟦ F.0# ⟧ ≈⟨ T.sym (+-homo F.0# F.0#) ⟩ ⟦ F._+_ F.0# F.0# ⟧ ≈⟨ ⟦⟧-cong (projâ‚ F.+-identity F.0#) ⟩ ⟦ F.0# ⟧ ∎) -‿homo : Homomorphic₠⟦_⟧ (F.-_) (T.-_) -‿homo x = GroupP.left-inverse-unique T.+-group ⟦ F.-_ x ⟧ ⟦ x ⟧ (begin T._+_ ⟦ F.-_ x ⟧ ⟦ x ⟧ ≈⟨ T.sym (+-homo (F.-_ x) x) ⟩ ⟦ F._+_ (F.-_ x) x ⟧ ≈⟨ ⟦⟧-cong (projâ‚ F.-‿inverse x) ⟩ ⟦ F.0# ⟧ ≈⟨ 0-homo ⟩ T.0# ∎) agda-stdlib-0.12/src/Algebra/Operations.agda000066400000000000000000000116011270451047000206730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some defined operations (multiplication by natural number and -- exponentiation) ------------------------------------------------------------------------ open import Algebra module Algebra.Operations {sâ‚ sâ‚‚} (S : Semiring sâ‚ sâ‚‚) where open Semiring S renaming (zero to *-zero) open import Data.Nat.Base using (zero; suc; â„•) renaming (_+_ to _â„•+_; _*_ to _â„•*_) open import Data.Product using (module Σ) open import Function open import Relation.Binary open import Relation.Binary.PropositionalEquality as PropEq using (_≡_) import Relation.Binary.EqReasoning as EqR open EqR setoid ------------------------------------------------------------------------ -- Operations -- Multiplication by natural number. infixr 7 _×_ _×′_ _×_ : â„• → Carrier → Carrier 0 × x = 0# suc n × x = x + n × x -- A variant that includes a "redundant" case which ensures that 1 × y -- is definitionally equal to y. _×′_ : â„• → Carrier → Carrier 0 ×′ x = 0# 1 ×′ x = x suc n ×′ x = x + n ×′ x -- Exponentiation. infixr 8 _^_ _^_ : Carrier → â„• → Carrier x ^ zero = 1# x ^ suc n = x * x ^ n ------------------------------------------------------------------------ -- Some properties -- Unfolding lemma for _×′_. 1+×′ : ∀ n x → suc n ×′ x ≈ x + n ×′ x 1+×′ 0 x = begin x ≈⟨ sym $ Σ.projâ‚‚ +-identity x ⟩ x + 0# ∎ 1+×′ (suc n) x = begin x + suc n ×′ x ≡⟨⟩ x + suc n ×′ x ∎ -- _×_ and _×′_ are extensionally equal (up to the setoid -- equivalence). ×≈×′ : ∀ n x → n × x ≈ n ×′ x ×≈×′ 0 x = begin 0# ∎ ×≈×′ (suc n) x = begin x + n × x ≈⟨ +-cong refl (×≈×′ n x) ⟩ x + n ×′ x ≈⟨ sym $ 1+×′ n x ⟩ suc n ×′ x ∎ -- _×_ is homomorphic with respect to _â„•+_/_+_. ×-homo-+ : ∀ c m n → (m â„•+ n) × c ≈ m × c + n × c ×-homo-+ c 0 n = begin n × c ≈⟨ sym $ Σ.projâ‚ +-identity (n × c) ⟩ 0# + n × c ∎ ×-homo-+ c (suc m) n = begin c + (m â„•+ n) × c ≈⟨ +-cong refl (×-homo-+ c m n) ⟩ c + (m × c + n × c) ≈⟨ sym $ +-assoc c (m × c) (n × c) ⟩ c + m × c + n × c ∎ -- _×′_ is homomorphic with respect to _â„•+_/_+_. ×′-homo-+ : ∀ c m n → (m â„•+ n) ×′ c ≈ m ×′ c + n ×′ c ×′-homo-+ c m n = begin (m â„•+ n) ×′ c ≈⟨ sym $ ×≈×′ (m â„•+ n) c ⟩ (m â„•+ n) × c ≈⟨ ×-homo-+ c m n ⟩ m × c + n × c ≈⟨ +-cong (×≈×′ m c) (×≈×′ n c) ⟩ m ×′ c + n ×′ c ∎ -- _× 1# is homomorphic with respect to _â„•*_/_*_. ×1-homo-* : ∀ m n → (m â„•* n) × 1# ≈ (m × 1#) * (n × 1#) ×1-homo-* 0 n = begin 0# ≈⟨ sym $ Σ.projâ‚ *-zero (n × 1#) ⟩ 0# * (n × 1#) ∎ ×1-homo-* (suc m) n = begin (n â„•+ m â„•* n) × 1# ≈⟨ ×-homo-+ 1# n (m â„•* n) ⟩ n × 1# + (m â„•* n) × 1# ≈⟨ +-cong refl (×1-homo-* m n) ⟩ n × 1# + (m × 1#) * (n × 1#) ≈⟨ sym $ +-cong (Σ.projâ‚ *-identity (n × 1#)) refl ⟩ 1# * (n × 1#) + (m × 1#) * (n × 1#) ≈⟨ sym $ Σ.projâ‚‚ distrib (n × 1#) 1# (m × 1#) ⟩ (1# + m × 1#) * (n × 1#) ∎ -- _×′ 1# is homomorphic with respect to _â„•*_/_*_. ×′1-homo-* : ∀ m n → (m â„•* n) ×′ 1# ≈ (m ×′ 1#) * (n ×′ 1#) ×′1-homo-* m n = begin (m â„•* n) ×′ 1# ≈⟨ sym $ ×≈×′ (m â„•* n) 1# ⟩ (m â„•* n) × 1# ≈⟨ ×1-homo-* m n ⟩ (m × 1#) * (n × 1#) ≈⟨ *-cong (×≈×′ m 1#) (×≈×′ n 1#) ⟩ (m ×′ 1#) * (n ×′ 1#) ∎ -- _×_ preserves equality. ×-cong : _×_ Preservesâ‚‚ _≡_ ⟶ _≈_ ⟶ _≈_ ×-cong {n} {n′} {x} {x′} n≡n′ x≈x′ = begin n × x ≈⟨ reflexive $ PropEq.cong (λ n → n × x) n≡n′ ⟩ n′ × x ≈⟨ ×-congʳ n′ x≈x′ ⟩ n′ × x′ ∎ where ×-congʳ : ∀ n → (_×_ n) Preserves _≈_ ⟶ _≈_ ×-congʳ 0 x≈x′ = refl ×-congʳ (suc n) x≈x′ = x≈x′ ⟨ +-cong ⟩ ×-congʳ n x≈x′ -- _×′_ preserves equality. ×′-cong : _×′_ Preservesâ‚‚ _≡_ ⟶ _≈_ ⟶ _≈_ ×′-cong {n} {n′} {x} {x′} n≡n′ x≈x′ = begin n ×′ x ≈⟨ sym $ ×≈×′ n x ⟩ n × x ≈⟨ ×-cong n≡n′ x≈x′ ⟩ n′ × x′ ≈⟨ ×≈×′ n′ x′ ⟩ n′ ×′ x′ ∎ -- _^_ preserves equality. ^-cong : _^_ Preservesâ‚‚ _≈_ ⟶ _≡_ ⟶ _≈_ ^-cong {x} {x'} {n} {n'} x≈x' n≡n' = begin x ^ n ≈⟨ reflexive $ PropEq.cong (_^_ x) n≡n' ⟩ x ^ n' ≈⟨ ^-congË¡ n' x≈x' ⟩ x' ^ n' ∎ where ^-congË¡ : ∀ n → (λ x → x ^ n) Preserves _≈_ ⟶ _≈_ ^-congË¡ zero x≈x' = refl ^-congË¡ (suc n) x≈x' = x≈x' ⟨ *-cong ⟩ ^-congË¡ n x≈x' agda-stdlib-0.12/src/Algebra/Properties/000077500000000000000000000000001270451047000200675ustar00rootroot00000000000000agda-stdlib-0.12/src/Algebra/Properties/AbelianGroup.agda000066400000000000000000000032601270451047000232560ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.AbelianGroup {gâ‚ gâ‚‚} (G : AbelianGroup gâ‚ gâ‚‚) where import Algebra.Properties.Group as GP open import Data.Product open import Function import Relation.Binary.EqReasoning as EqR open AbelianGroup G open EqR setoid open GP group public private lemma : ∀ x y → x ∙ y ∙ x â»Â¹ ≈ y lemma x y = begin x ∙ y ∙ x â»Â¹ ≈⟨ comm _ _ ⟨ ∙-cong ⟩ refl ⟩ y ∙ x ∙ x â»Â¹ ≈⟨ assoc _ _ _ ⟩ y ∙ (x ∙ x â»Â¹) ≈⟨ refl ⟨ ∙-cong ⟩ projâ‚‚ inverse _ ⟩ y ∙ ε ≈⟨ projâ‚‚ identity _ ⟩ y ∎ â»Â¹-∙-comm : ∀ x y → x â»Â¹ ∙ y â»Â¹ ≈ (x ∙ y) â»Â¹ â»Â¹-∙-comm x y = begin x â»Â¹ ∙ y â»Â¹ ≈⟨ comm _ _ ⟩ y â»Â¹ ∙ x â»Â¹ ≈⟨ sym $ lem ⟨ ∙-cong ⟩ refl ⟩ x ∙ (y ∙ (x ∙ y) â»Â¹ ∙ y â»Â¹) ∙ x â»Â¹ ≈⟨ lemma _ _ ⟩ y ∙ (x ∙ y) â»Â¹ ∙ y â»Â¹ ≈⟨ lemma _ _ ⟩ (x ∙ y) â»Â¹ ∎ where lem = begin x ∙ (y ∙ (x ∙ y) â»Â¹ ∙ y â»Â¹) ≈⟨ sym $ assoc _ _ _ ⟩ x ∙ (y ∙ (x ∙ y) â»Â¹) ∙ y â»Â¹ ≈⟨ sym $ assoc _ _ _ ⟨ ∙-cong ⟩ refl ⟩ x ∙ y ∙ (x ∙ y) â»Â¹ ∙ y â»Â¹ ≈⟨ projâ‚‚ inverse _ ⟨ ∙-cong ⟩ refl ⟩ ε ∙ y â»Â¹ ≈⟨ projâ‚ identity _ ⟩ y â»Â¹ ∎ agda-stdlib-0.12/src/Algebra/Properties/BooleanAlgebra.agda000066400000000000000000000612151270451047000235470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.BooleanAlgebra {bâ‚ bâ‚‚} (B : BooleanAlgebra bâ‚ bâ‚‚) where open BooleanAlgebra B import Algebra.Properties.DistributiveLattice private open module DL = Algebra.Properties.DistributiveLattice distributiveLattice public hiding (replace-equality) open import Algebra.Structures import Algebra.FunctionProperties as P; open P _≈_ import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Relation.Binary open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product ------------------------------------------------------------------------ -- Some simple generalisations ∨-complement : Inverse ⊤ ¬_ _∨_ ∨-complement = ∨-complementË¡ , ∨-complementʳ where ∨-complementË¡ : LeftInverse ⊤ ¬_ _∨_ ∨-complementË¡ x = begin ¬ x ∨ x ≈⟨ ∨-comm _ _ ⟩ x ∨ ¬ x ≈⟨ ∨-complementʳ _ ⟩ ⊤ ∎ ∧-complement : Inverse ⊥ ¬_ _∧_ ∧-complement = ∧-complementË¡ , ∧-complementʳ where ∧-complementË¡ : LeftInverse ⊥ ¬_ _∧_ ∧-complementË¡ x = begin ¬ x ∧ x ≈⟨ ∧-comm _ _ ⟩ x ∧ ¬ x ≈⟨ ∧-complementʳ _ ⟩ ⊥ ∎ ------------------------------------------------------------------------ -- The dual construction is also a boolean algebra ∧-∨-isBooleanAlgebra : IsBooleanAlgebra _≈_ _∧_ _∨_ ¬_ ⊥ ⊤ ∧-∨-isBooleanAlgebra = record { isDistributiveLattice = ∧-∨-isDistributiveLattice ; ∨-complementʳ = projâ‚‚ ∧-complement ; ∧-complementʳ = projâ‚‚ ∨-complement ; ¬-cong = ¬-cong } ∧-∨-booleanAlgebra : BooleanAlgebra _ _ ∧-∨-booleanAlgebra = record { _∧_ = _∨_ ; _∨_ = _∧_ ; ⊤ = ⊥ ; ⊥ = ⊤ ; isBooleanAlgebra = ∧-∨-isBooleanAlgebra } ------------------------------------------------------------------------ -- (∨, ∧, ⊥, ⊤) is a commutative semiring private ∧-identity : Identity ⊤ _∧_ ∧-identity = (λ _ → ∧-comm _ _ ⟨ trans ⟩ x∧⊤=x _) , x∧⊤=x where x∧⊤=x : ∀ x → x ∧ ⊤ ≈ x x∧⊤=x x = begin x ∧ ⊤ ≈⟨ refl ⟨ ∧-cong ⟩ sym (projâ‚‚ ∨-complement _) ⟩ x ∧ (x ∨ ¬ x) ≈⟨ projâ‚‚ absorptive _ _ ⟩ x ∎ ∨-identity : Identity ⊥ _∨_ ∨-identity = (λ _ → ∨-comm _ _ ⟨ trans ⟩ x∨⊥=x _) , x∨⊥=x where x∨⊥=x : ∀ x → x ∨ ⊥ ≈ x x∨⊥=x x = begin x ∨ ⊥ ≈⟨ refl ⟨ ∨-cong ⟩ sym (projâ‚‚ ∧-complement _) ⟩ x ∨ x ∧ ¬ x ≈⟨ projâ‚ absorptive _ _ ⟩ x ∎ ∧-zero : Zero ⊥ _∧_ ∧-zero = (λ _ → ∧-comm _ _ ⟨ trans ⟩ x∧⊥=⊥ _) , x∧⊥=⊥ where x∧⊥=⊥ : ∀ x → x ∧ ⊥ ≈ ⊥ x∧⊥=⊥ x = begin x ∧ ⊥ ≈⟨ refl ⟨ ∧-cong ⟩ sym (projâ‚‚ ∧-complement _) ⟩ x ∧ x ∧ ¬ x ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ x) ∧ ¬ x ≈⟨ ∧-idempotent _ ⟨ ∧-cong ⟩ refl ⟩ x ∧ ¬ x ≈⟨ projâ‚‚ ∧-complement _ ⟩ ⊥ ∎ ∨-∧-isCommutativeSemiring : IsCommutativeSemiring _≈_ _∨_ _∧_ ⊥ ⊤ ∨-∧-isCommutativeSemiring = record { +-isCommutativeMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∨-assoc ; ∙-cong = ∨-cong } ; identityË¡ = proj₠∨-identity ; comm = ∨-comm } ; *-isCommutativeMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∧-assoc ; ∙-cong = ∧-cong } ; identityË¡ = proj₠∧-identity ; comm = ∧-comm } ; distribʳ = projâ‚‚ ∧-∨-distrib ; zeroË¡ = proj₠∧-zero } ∨-∧-commutativeSemiring : CommutativeSemiring _ _ ∨-∧-commutativeSemiring = record { _+_ = _∨_ ; _*_ = _∧_ ; 0# = ⊥ ; 1# = ⊤ ; isCommutativeSemiring = ∨-∧-isCommutativeSemiring } ------------------------------------------------------------------------ -- (∧, ∨, ⊤, ⊥) is a commutative semiring private ∨-zero : Zero ⊤ _∨_ ∨-zero = (λ _ → ∨-comm _ _ ⟨ trans ⟩ x∨⊤=⊤ _) , x∨⊤=⊤ where x∨⊤=⊤ : ∀ x → x ∨ ⊤ ≈ ⊤ x∨⊤=⊤ x = begin x ∨ ⊤ ≈⟨ refl ⟨ ∨-cong ⟩ sym (projâ‚‚ ∨-complement _) ⟩ x ∨ x ∨ ¬ x ≈⟨ sym $ ∨-assoc _ _ _ ⟩ (x ∨ x) ∨ ¬ x ≈⟨ ∨-idempotent _ ⟨ ∨-cong ⟩ refl ⟩ x ∨ ¬ x ≈⟨ projâ‚‚ ∨-complement _ ⟩ ⊤ ∎ ∧-∨-isCommutativeSemiring : IsCommutativeSemiring _≈_ _∧_ _∨_ ⊤ ⊥ ∧-∨-isCommutativeSemiring = record { +-isCommutativeMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∧-assoc ; ∙-cong = ∧-cong } ; identityË¡ = proj₠∧-identity ; comm = ∧-comm } ; *-isCommutativeMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∨-assoc ; ∙-cong = ∨-cong } ; identityË¡ = proj₠∨-identity ; comm = ∨-comm } ; distribʳ = projâ‚‚ ∨-∧-distrib ; zeroË¡ = proj₠∨-zero } ∧-∨-commutativeSemiring : CommutativeSemiring _ _ ∧-∨-commutativeSemiring = record { isCommutativeSemiring = ∧-∨-isCommutativeSemiring } ------------------------------------------------------------------------ -- Some other properties -- I took the statement of this lemma (called Uniqueness of -- Complements) from some course notes, "Boolean Algebra", written -- by Gert Smolka. private lemma : ∀ x y → x ∧ y ≈ ⊥ → x ∨ y ≈ ⊤ → ¬ x ≈ y lemma x y x∧y=⊥ x∨y=⊤ = begin ¬ x ≈⟨ sym $ projâ‚‚ ∧-identity _ ⟩ ¬ x ∧ ⊤ ≈⟨ refl ⟨ ∧-cong ⟩ sym x∨y=⊤ ⟩ ¬ x ∧ (x ∨ y) ≈⟨ proj₠∧-∨-distrib _ _ _ ⟩ ¬ x ∧ x ∨ ¬ x ∧ y ≈⟨ proj₠∧-complement _ ⟨ ∨-cong ⟩ refl ⟩ ⊥ ∨ ¬ x ∧ y ≈⟨ sym x∧y=⊥ ⟨ ∨-cong ⟩ refl ⟩ x ∧ y ∨ ¬ x ∧ y ≈⟨ sym $ projâ‚‚ ∧-∨-distrib _ _ _ ⟩ (x ∨ ¬ x) ∧ y ≈⟨ projâ‚‚ ∨-complement _ ⟨ ∧-cong ⟩ refl ⟩ ⊤ ∧ y ≈⟨ proj₠∧-identity _ ⟩ y ∎ ¬⊥=⊤ : ¬ ⊥ ≈ ⊤ ¬⊥=⊤ = lemma ⊥ ⊤ (projâ‚‚ ∧-identity _) (projâ‚‚ ∨-zero _) ¬⊤=⊥ : ¬ ⊤ ≈ ⊥ ¬⊤=⊥ = lemma ⊤ ⊥ (projâ‚‚ ∧-zero _) (projâ‚‚ ∨-identity _) ¬-involutive : Involutive ¬_ ¬-involutive x = lemma (¬ x) x (proj₠∧-complement _) (proj₠∨-complement _) deMorganâ‚ : ∀ x y → ¬ (x ∧ y) ≈ ¬ x ∨ ¬ y deMorganâ‚ x y = lemma (x ∧ y) (¬ x ∨ ¬ y) lemâ‚ lemâ‚‚ where lemâ‚ = begin (x ∧ y) ∧ (¬ x ∨ ¬ y) ≈⟨ proj₠∧-∨-distrib _ _ _ ⟩ (x ∧ y) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ (∧-comm _ _ ⟨ ∧-cong ⟩ refl) ⟨ ∨-cong ⟩ refl ⟩ (y ∧ x) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ ∧-assoc _ _ _ ⟨ ∨-cong ⟩ ∧-assoc _ _ _ ⟩ y ∧ (x ∧ ¬ x) ∨ x ∧ (y ∧ ¬ y) ≈⟨ (refl ⟨ ∧-cong ⟩ projâ‚‚ ∧-complement _) ⟨ ∨-cong ⟩ (refl ⟨ ∧-cong ⟩ projâ‚‚ ∧-complement _) ⟩ (y ∧ ⊥) ∨ (x ∧ ⊥) ≈⟨ projâ‚‚ ∧-zero _ ⟨ ∨-cong ⟩ projâ‚‚ ∧-zero _ ⟩ ⊥ ∨ ⊥ ≈⟨ projâ‚‚ ∨-identity _ ⟩ ⊥ ∎ lem₃ = begin (x ∧ y) ∨ ¬ x ≈⟨ projâ‚‚ ∨-∧-distrib _ _ _ ⟩ (x ∨ ¬ x) ∧ (y ∨ ¬ x) ≈⟨ projâ‚‚ ∨-complement _ ⟨ ∧-cong ⟩ refl ⟩ ⊤ ∧ (y ∨ ¬ x) ≈⟨ proj₠∧-identity _ ⟩ y ∨ ¬ x ≈⟨ ∨-comm _ _ ⟩ ¬ x ∨ y ∎ lemâ‚‚ = begin (x ∧ y) ∨ (¬ x ∨ ¬ y) ≈⟨ sym $ ∨-assoc _ _ _ ⟩ ((x ∧ y) ∨ ¬ x) ∨ ¬ y ≈⟨ lem₃ ⟨ ∨-cong ⟩ refl ⟩ (¬ x ∨ y) ∨ ¬ y ≈⟨ ∨-assoc _ _ _ ⟩ ¬ x ∨ (y ∨ ¬ y) ≈⟨ refl ⟨ ∨-cong ⟩ projâ‚‚ ∨-complement _ ⟩ ¬ x ∨ ⊤ ≈⟨ projâ‚‚ ∨-zero _ ⟩ ⊤ ∎ deMorganâ‚‚ : ∀ x y → ¬ (x ∨ y) ≈ ¬ x ∧ ¬ y deMorganâ‚‚ x y = begin ¬ (x ∨ y) ≈⟨ ¬-cong $ sym (¬-involutive _) ⟨ ∨-cong ⟩ sym (¬-involutive _) ⟩ ¬ (¬ ¬ x ∨ ¬ ¬ y) ≈⟨ ¬-cong $ sym $ deMorganâ‚ _ _ ⟩ ¬ ¬ (¬ x ∧ ¬ y) ≈⟨ ¬-involutive _ ⟩ ¬ x ∧ ¬ y ∎ -- One can replace the underlying equality with an equivalent one. replace-equality : {_≈′_ : Rel Carrier bâ‚‚} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → BooleanAlgebra _ _ replace-equality {_≈′_} ≈⇔≈′ = record { _≈_ = _≈′_ ; _∨_ = _∨_ ; _∧_ = _∧_ ; ¬_ = ¬_ ; ⊤ = ⊤ ; ⊥ = ⊥ ; isBooleanAlgebra = record { isDistributiveLattice = DistributiveLattice.isDistributiveLattice (DL.replace-equality ≈⇔≈′) ; ∨-complementʳ = λ x → to ⟨$⟩ ∨-complementʳ x ; ∧-complementʳ = λ x → to ⟨$⟩ ∧-complementʳ x ; ¬-cong = λ i≈j → to ⟨$⟩ ¬-cong (from ⟨$⟩ i≈j) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) ------------------------------------------------------------------------ -- (⊕, ∧, id, ⊥, ⊤) is a commutative ring -- This construction is parameterised over the definition of xor. module XorRing (xor : Opâ‚‚ Carrier) (⊕-def : ∀ x y → xor x y ≈ (x ∨ y) ∧ ¬ (x ∧ y)) where private infixl 6 _⊕_ _⊕_ : Opâ‚‚ Carrier _⊕_ = xor private helper : ∀ {x y u v} → x ≈ y → u ≈ v → x ∧ ¬ u ≈ y ∧ ¬ v helper x≈y u≈v = x≈y ⟨ ∧-cong ⟩ ¬-cong u≈v ⊕-¬-distribË¡ : ∀ x y → ¬ (x ⊕ y) ≈ ¬ x ⊕ y ⊕-¬-distribË¡ x y = begin ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-def _ _ ⟩ ¬ ((x ∨ y) ∧ (¬ (x ∧ y))) ≈⟨ ¬-cong (projâ‚‚ ∧-∨-distrib _ _ _) ⟩ ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (x ∧ y))) ≈⟨ ¬-cong $ refl ⟨ ∨-cong ⟩ (refl ⟨ ∧-cong ⟩ ¬-cong (∧-comm _ _)) ⟩ ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (y ∧ x))) ≈⟨ ¬-cong $ lem _ _ ⟨ ∨-cong ⟩ lem _ _ ⟩ ¬ ((x ∧ ¬ y) ∨ (y ∧ ¬ x)) ≈⟨ deMorganâ‚‚ _ _ ⟩ ¬ (x ∧ ¬ y) ∧ ¬ (y ∧ ¬ x) ≈⟨ deMorganâ‚ _ _ ⟨ ∧-cong ⟩ refl ⟩ (¬ x ∨ (¬ ¬ y)) ∧ ¬ (y ∧ ¬ x) ≈⟨ helper (refl ⟨ ∨-cong ⟩ ¬-involutive _) (∧-comm _ _) ⟩ (¬ x ∨ y) ∧ ¬ (¬ x ∧ y) ≈⟨ sym $ ⊕-def _ _ ⟩ ¬ x ⊕ y ∎ where lem : ∀ x y → x ∧ ¬ (x ∧ y) ≈ x ∧ ¬ y lem x y = begin x ∧ ¬ (x ∧ y) ≈⟨ refl ⟨ ∧-cong ⟩ deMorganâ‚ _ _ ⟩ x ∧ (¬ x ∨ ¬ y) ≈⟨ proj₠∧-∨-distrib _ _ _ ⟩ (x ∧ ¬ x) ∨ (x ∧ ¬ y) ≈⟨ projâ‚‚ ∧-complement _ ⟨ ∨-cong ⟩ refl ⟩ ⊥ ∨ (x ∧ ¬ y) ≈⟨ proj₠∨-identity _ ⟩ x ∧ ¬ y ∎ private ⊕-comm : Commutative _⊕_ ⊕-comm x y = begin x ⊕ y ≈⟨ ⊕-def _ _ ⟩ (x ∨ y) ∧ ¬ (x ∧ y) ≈⟨ helper (∨-comm _ _) (∧-comm _ _) ⟩ (y ∨ x) ∧ ¬ (y ∧ x) ≈⟨ sym $ ⊕-def _ _ ⟩ y ⊕ x ∎ ⊕-¬-distribʳ : ∀ x y → ¬ (x ⊕ y) ≈ x ⊕ ¬ y ⊕-¬-distribʳ x y = begin ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-comm _ _ ⟩ ¬ (y ⊕ x) ≈⟨ ⊕-¬-distribË¡ _ _ ⟩ ¬ y ⊕ x ≈⟨ ⊕-comm _ _ ⟩ x ⊕ ¬ y ∎ ⊕-annihilates-¬ : ∀ x y → x ⊕ y ≈ ¬ x ⊕ ¬ y ⊕-annihilates-¬ x y = begin x ⊕ y ≈⟨ sym $ ¬-involutive _ ⟩ ¬ ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-¬-distribË¡ _ _ ⟩ ¬ (¬ x ⊕ y) ≈⟨ ⊕-¬-distribʳ _ _ ⟩ ¬ x ⊕ ¬ y ∎ private ⊕-cong : _⊕_ Preservesâ‚‚ _≈_ ⟶ _≈_ ⟶ _≈_ ⊕-cong {x} {y} {u} {v} x≈y u≈v = begin x ⊕ u ≈⟨ ⊕-def _ _ ⟩ (x ∨ u) ∧ ¬ (x ∧ u) ≈⟨ helper (x≈y ⟨ ∨-cong ⟩ u≈v) (x≈y ⟨ ∧-cong ⟩ u≈v) ⟩ (y ∨ v) ∧ ¬ (y ∧ v) ≈⟨ sym $ ⊕-def _ _ ⟩ y ⊕ v ∎ ⊕-identity : Identity ⊥ _⊕_ ⊕-identity = ⊥⊕x=x , (λ _ → ⊕-comm _ _ ⟨ trans ⟩ ⊥⊕x=x _) where ⊥⊕x=x : ∀ x → ⊥ ⊕ x ≈ x ⊥⊕x=x x = begin ⊥ ⊕ x ≈⟨ ⊕-def _ _ ⟩ (⊥ ∨ x) ∧ ¬ (⊥ ∧ x) ≈⟨ helper (proj₠∨-identity _) (proj₠∧-zero _) ⟩ x ∧ ¬ ⊥ ≈⟨ refl ⟨ ∧-cong ⟩ ¬⊥=⊤ ⟩ x ∧ ⊤ ≈⟨ projâ‚‚ ∧-identity _ ⟩ x ∎ ⊕-inverse : Inverse ⊥ id _⊕_ ⊕-inverse = x⊕x=⊥ , (λ _ → ⊕-comm _ _ ⟨ trans ⟩ x⊕x=⊥ _) where x⊕x=⊥ : ∀ x → x ⊕ x ≈ ⊥ x⊕x=⊥ x = begin x ⊕ x ≈⟨ ⊕-def _ _ ⟩ (x ∨ x) ∧ ¬ (x ∧ x) ≈⟨ helper (∨-idempotent _) (∧-idempotent _) ⟩ x ∧ ¬ x ≈⟨ projâ‚‚ ∧-complement _ ⟩ ⊥ ∎ distrib-∧-⊕ : _∧_ DistributesOver _⊕_ distrib-∧-⊕ = distË¡ , distʳ where distË¡ : _∧_ DistributesOverË¡ _⊕_ distË¡ x y z = begin x ∧ (y ⊕ z) ≈⟨ refl ⟨ ∧-cong ⟩ ⊕-def _ _ ⟩ x ∧ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ (y ∨ z)) ∧ ¬ (y ∧ z) ≈⟨ refl ⟨ ∧-cong ⟩ deMorganâ‚ _ _ ⟩ (x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z) ≈⟨ sym $ proj₠∨-identity _ ⟩ ⊥ ∨ ((x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z)) ≈⟨ lem₃ ⟨ ∨-cong ⟩ refl ⟩ ((x ∧ (y ∨ z)) ∧ ¬ x) ∨ ((x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z)) ≈⟨ sym $ proj₠∧-∨-distrib _ _ _ ⟩ (x ∧ (y ∨ z)) ∧ (¬ x ∨ (¬ y ∨ ¬ z)) ≈⟨ refl ⟨ ∧-cong ⟩ (refl ⟨ ∨-cong ⟩ sym (deMorganâ‚ _ _)) ⟩ (x ∧ (y ∨ z)) ∧ (¬ x ∨ ¬ (y ∧ z)) ≈⟨ refl ⟨ ∧-cong ⟩ sym (deMorganâ‚ _ _) ⟩ (x ∧ (y ∨ z)) ∧ ¬ (x ∧ (y ∧ z)) ≈⟨ helper refl lem₠⟩ (x ∧ (y ∨ z)) ∧ ¬ ((x ∧ y) ∧ (x ∧ z)) ≈⟨ proj₠∧-∨-distrib _ _ _ ⟨ ∧-cong ⟩ refl ⟩ ((x ∧ y) ∨ (x ∧ z)) ∧ ¬ ((x ∧ y) ∧ (x ∧ z)) ≈⟨ sym $ ⊕-def _ _ ⟩ (x ∧ y) ⊕ (x ∧ z) ∎ where lemâ‚‚ = begin x ∧ (y ∧ z) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ y) ∧ z ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (y ∧ x) ∧ z ≈⟨ ∧-assoc _ _ _ ⟩ y ∧ (x ∧ z) ∎ lemâ‚ = begin x ∧ (y ∧ z) ≈⟨ sym (∧-idempotent _) ⟨ ∧-cong ⟩ refl ⟩ (x ∧ x) ∧ (y ∧ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ (x ∧ (y ∧ z)) ≈⟨ refl ⟨ ∧-cong ⟩ lemâ‚‚ ⟩ x ∧ (y ∧ (x ∧ z)) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (x ∧ y) ∧ (x ∧ z) ∎ lem₃ = begin ⊥ ≈⟨ sym $ projâ‚‚ ∧-zero _ ⟩ (y ∨ z) ∧ ⊥ ≈⟨ refl ⟨ ∧-cong ⟩ sym (projâ‚‚ ∧-complement _) ⟩ (y ∨ z) ∧ (x ∧ ¬ x) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ ((y ∨ z) ∧ x) ∧ ¬ x ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (y ∨ z)) ∧ ¬ x ∎ distʳ : _∧_ DistributesOverʳ _⊕_ distʳ x y z = begin (y ⊕ z) ∧ x ≈⟨ ∧-comm _ _ ⟩ x ∧ (y ⊕ z) ≈⟨ distË¡ _ _ _ ⟩ (x ∧ y) ⊕ (x ∧ z) ≈⟨ ∧-comm _ _ ⟨ ⊕-cong ⟩ ∧-comm _ _ ⟩ (y ∧ x) ⊕ (z ∧ x) ∎ lemmaâ‚‚ : ∀ x y u v → (x ∧ y) ∨ (u ∧ v) ≈ ((x ∨ u) ∧ (y ∨ u)) ∧ ((x ∨ v) ∧ (y ∨ v)) lemmaâ‚‚ x y u v = begin (x ∧ y) ∨ (u ∧ v) ≈⟨ proj₠∨-∧-distrib _ _ _ ⟩ ((x ∧ y) ∨ u) ∧ ((x ∧ y) ∨ v) ≈⟨ projâ‚‚ ∨-∧-distrib _ _ _ ⟨ ∧-cong ⟩ projâ‚‚ ∨-∧-distrib _ _ _ ⟩ ((x ∨ u) ∧ (y ∨ u)) ∧ ((x ∨ v) ∧ (y ∨ v)) ∎ ⊕-assoc : Associative _⊕_ ⊕-assoc x y z = sym $ begin x ⊕ (y ⊕ z) ≈⟨ refl ⟨ ⊕-cong ⟩ ⊕-def _ _ ⟩ x ⊕ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ⊕-def _ _ ⟩ (x ∨ ((y ∨ z) ∧ ¬ (y ∧ z))) ∧ ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ lem₃ ⟨ ∧-cong ⟩ lemâ‚„ ⟩ (((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ ∧-assoc _ _ _ ⟩ ((x ∨ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈⟨ refl ⟨ ∧-cong ⟩ lemâ‚… ⟩ ((x ∨ y) ∨ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ lem₠⟨ ∧-cong ⟩ lemâ‚‚ ⟩ (((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z) ∧ ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ≈⟨ sym $ ⊕-def _ _ ⟩ ((x ∨ y) ∧ ¬ (x ∧ y)) ⊕ z ≈⟨ sym $ ⊕-def _ _ ⟨ ⊕-cong ⟩ refl ⟩ (x ⊕ y) ⊕ z ∎ where lemâ‚ = begin ((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈⟨ sym $ projâ‚‚ ∨-∧-distrib _ _ _ ⟩ ((x ∨ y) ∧ (¬ x ∨ ¬ y)) ∨ z ≈⟨ (refl ⟨ ∧-cong ⟩ sym (deMorganâ‚ _ _)) ⟨ ∨-cong ⟩ refl ⟩ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z ∎ lemâ‚‚' = begin (x ∨ ¬ y) ∧ (¬ x ∨ y) ≈⟨ sym $ proj₠∧-identity _ ⟨ ∧-cong ⟩ projâ‚‚ ∧-identity _ ⟩ (⊤ ∧ (x ∨ ¬ y)) ∧ ((¬ x ∨ y) ∧ ⊤) ≈⟨ sym $ (proj₠∨-complement _ ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ (refl ⟨ ∧-cong ⟩ proj₠∨-complement _) ⟩ ((¬ x ∨ x) ∧ (¬ y ∨ x)) ∧ ((¬ x ∨ y) ∧ (¬ y ∨ y)) ≈⟨ sym $ lemmaâ‚‚ _ _ _ _ ⟩ (¬ x ∧ ¬ y) ∨ (x ∧ y) ≈⟨ sym $ deMorganâ‚‚ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ ¬ (x ∨ y) ∨ ¬ ¬ (x ∧ y) ≈⟨ sym (deMorganâ‚ _ _) ⟩ ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∎ lemâ‚‚ = begin ((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ sym $ projâ‚‚ ∨-∧-distrib _ _ _ ⟩ ((x ∨ ¬ y) ∧ (¬ x ∨ y)) ∨ ¬ z ≈⟨ lemâ‚‚' ⟨ ∨-cong ⟩ refl ⟩ ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ ¬ z ≈⟨ sym $ deMorganâ‚ _ _ ⟩ ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ∎ lem₃ = begin x ∨ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ refl ⟨ ∨-cong ⟩ (refl ⟨ ∧-cong ⟩ deMorganâ‚ _ _) ⟩ x ∨ ((y ∨ z) ∧ (¬ y ∨ ¬ z)) ≈⟨ proj₠∨-∧-distrib _ _ _ ⟩ (x ∨ (y ∨ z)) ∧ (x ∨ (¬ y ∨ ¬ z)) ≈⟨ sym (∨-assoc _ _ _) ⟨ ∧-cong ⟩ sym (∨-assoc _ _ _) ⟩ ((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z) ∎ lemâ‚„' = begin ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ deMorganâ‚ _ _ ⟩ ¬ (y ∨ z) ∨ ¬ ¬ (y ∧ z) ≈⟨ deMorganâ‚‚ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ (¬ y ∧ ¬ z) ∨ (y ∧ z) ≈⟨ lemmaâ‚‚ _ _ _ _ ⟩ ((¬ y ∨ y) ∧ (¬ z ∨ y)) ∧ ((¬ y ∨ z) ∧ (¬ z ∨ z)) ≈⟨ (proj₠∨-complement _ ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ (refl ⟨ ∧-cong ⟩ proj₠∨-complement _) ⟩ (⊤ ∧ (y ∨ ¬ z)) ∧ ((¬ y ∨ z) ∧ ⊤) ≈⟨ proj₠∧-identity _ ⟨ ∧-cong ⟩ projâ‚‚ ∧-identity _ ⟩ (y ∨ ¬ z) ∧ (¬ y ∨ z) ∎ lemâ‚„ = begin ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ deMorganâ‚ _ _ ⟩ ¬ x ∨ ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ refl ⟨ ∨-cong ⟩ lemâ‚„' ⟩ ¬ x ∨ ((y ∨ ¬ z) ∧ (¬ y ∨ z)) ≈⟨ proj₠∨-∧-distrib _ _ _ ⟩ (¬ x ∨ (y ∨ ¬ z)) ∧ (¬ x ∨ (¬ y ∨ z)) ≈⟨ sym (∨-assoc _ _ _) ⟨ ∧-cong ⟩ sym (∨-assoc _ _ _) ⟩ ((¬ x ∨ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈⟨ ∧-comm _ _ ⟩ ((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ∎ lemâ‚… = begin ((x ∨ ¬ y) ∨ ¬ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ sym $ ∧-assoc _ _ _ ⟩ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (((¬ x ∨ ¬ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-assoc _ _ _ ⟩ ((¬ x ∨ ¬ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ∎ isCommutativeRing : IsCommutativeRing _≈_ _⊕_ _∧_ id ⊥ ⊤ isCommutativeRing = record { isRing = record { +-isAbelianGroup = record { isGroup = record { isMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ⊕-assoc ; ∙-cong = ⊕-cong } ; identity = ⊕-identity } ; inverse = ⊕-inverse ; â»Â¹-cong = id } ; comm = ⊕-comm } ; *-isMonoid = record { isSemigroup = record { isEquivalence = isEquivalence ; assoc = ∧-assoc ; ∙-cong = ∧-cong } ; identity = ∧-identity } ; distrib = distrib-∧-⊕ } ; *-comm = ∧-comm } commutativeRing : CommutativeRing _ _ commutativeRing = record { _+_ = _⊕_ ; _*_ = _∧_ ; -_ = id ; 0# = ⊥ ; 1# = ⊤ ; isCommutativeRing = isCommutativeRing } infixl 6 _⊕_ _⊕_ : Opâ‚‚ Carrier x ⊕ y = (x ∨ y) ∧ ¬ (x ∧ y) module DefaultXorRing = XorRing _⊕_ (λ _ _ → refl) agda-stdlib-0.12/src/Algebra/Properties/BooleanAlgebra/000077500000000000000000000000001270451047000227245ustar00rootroot00000000000000agda-stdlib-0.12/src/Algebra/Properties/BooleanAlgebra/Expression.agda000066400000000000000000000206501270451047000257040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Boolean algebra expressions ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.BooleanAlgebra.Expression {b} (B : BooleanAlgebra b b) where open BooleanAlgebra B open import Category.Applicative import Category.Applicative.Indexed as Applicative open import Category.Monad open import Category.Monad.Identity open import Data.Fin using (Fin) open import Data.Nat open import Data.Vec as Vec using (Vec) open import Data.Product import Data.Vec.Properties as VecProp open import Function open import Relation.Binary.PropositionalEquality as P using (_≗_) import Relation.Binary.Reflection as Reflection open import Relation.Binary.Vec.Pointwise as PW using (Pointwise; module Pointwise; ext) -- Expressions made up of variables and the operations of a boolean -- algebra. infixr 7 _and_ infixr 6 _or_ data Expr n : Set b where var : (x : Fin n) → Expr n _or_ _and_ : (eâ‚ eâ‚‚ : Expr n) → Expr n not : (e : Expr n) → Expr n top bot : Expr n -- The semantics of an expression, parametrised by an applicative -- functor. module Semantics {F : Set b → Set b} (A : RawApplicative F) where open RawApplicative A ⟦_⟧ : ∀ {n} → Expr n → Vec (F Carrier) n → F Carrier ⟦ var x ⟧ Ï = Vec.lookup x Ï âŸ¦ eâ‚ or eâ‚‚ ⟧ Ï = pure _∨_ ⊛ ⟦ e₠⟧ Ï âŠ› ⟦ eâ‚‚ ⟧ Ï âŸ¦ eâ‚ and eâ‚‚ ⟧ Ï = pure _∧_ ⊛ ⟦ e₠⟧ Ï âŠ› ⟦ eâ‚‚ ⟧ Ï âŸ¦ not e ⟧ Ï = pure ¬_ ⊛ ⟦ e ⟧ Ï âŸ¦ top ⟧ Ï = pure ⊤ ⟦ bot ⟧ Ï = pure ⊥ -- flip Semantics.⟦_⟧ e is natural. module Naturality {Fâ‚ Fâ‚‚ : Set b → Set b} {Aâ‚ : RawApplicative Fâ‚} {Aâ‚‚ : RawApplicative Fâ‚‚} (f : Applicative.Morphism Aâ‚ Aâ‚‚) where open P.≡-Reasoning open Applicative.Morphism f open Semantics Aâ‚ renaming (⟦_⟧ to ⟦_⟧â‚) open Semantics Aâ‚‚ renaming (⟦_⟧ to ⟦_⟧₂) open RawApplicative Aâ‚ renaming (pure to pureâ‚; _⊛_ to _⊛â‚_) open RawApplicative Aâ‚‚ renaming (pure to pureâ‚‚; _⊛_ to _⊛₂_) natural : ∀ {n} (e : Expr n) → op ∘ ⟦ e ⟧₠≗ ⟦ e ⟧₂ ∘ Vec.map op natural (var x) Ï = begin op (Vec.lookup x Ï) ≡⟨ P.sym $ Applicative.Morphism.op-<$> (VecProp.lookup-morphism x) op Ï âŸ© Vec.lookup x (Vec.map op Ï) ∎ natural (eâ‚ or eâ‚‚) Ï = begin op (pureâ‚ _∨_ ⊛₠⟦ eâ‚ âŸ§â‚ Ï âŠ›â‚ âŸ¦ eâ‚‚ ⟧₠Ï) ≡⟨ op-⊛ _ _ ⟩ op (pureâ‚ _∨_ ⊛₠⟦ e₠⟧₠Ï) ⊛₂ op (⟦ eâ‚‚ ⟧₠Ï) ≡⟨ P.congâ‚‚ _⊛₂_ (op-⊛ _ _) P.refl ⟩ op (pureâ‚ _∨_) ⊛₂ op (⟦ e₠⟧₠Ï) ⊛₂ op (⟦ eâ‚‚ ⟧₠Ï) ≡⟨ P.congâ‚‚ _⊛₂_ (P.congâ‚‚ _⊛₂_ (op-pure _) (natural eâ‚ Ï)) (natural eâ‚‚ Ï) ⟩ pureâ‚‚ _∨_ ⊛₂ ⟦ e₠⟧₂ (Vec.map op Ï) ⊛₂ ⟦ eâ‚‚ ⟧₂ (Vec.map op Ï) ∎ natural (eâ‚ and eâ‚‚) Ï = begin op (pureâ‚ _∧_ ⊛₠⟦ eâ‚ âŸ§â‚ Ï âŠ›â‚ âŸ¦ eâ‚‚ ⟧₠Ï) ≡⟨ op-⊛ _ _ ⟩ op (pureâ‚ _∧_ ⊛₠⟦ e₠⟧₠Ï) ⊛₂ op (⟦ eâ‚‚ ⟧₠Ï) ≡⟨ P.congâ‚‚ _⊛₂_ (op-⊛ _ _) P.refl ⟩ op (pureâ‚ _∧_) ⊛₂ op (⟦ e₠⟧₠Ï) ⊛₂ op (⟦ eâ‚‚ ⟧₠Ï) ≡⟨ P.congâ‚‚ _⊛₂_ (P.congâ‚‚ _⊛₂_ (op-pure _) (natural eâ‚ Ï)) (natural eâ‚‚ Ï) ⟩ pureâ‚‚ _∧_ ⊛₂ ⟦ e₠⟧₂ (Vec.map op Ï) ⊛₂ ⟦ eâ‚‚ ⟧₂ (Vec.map op Ï) ∎ natural (not e) Ï = begin op (pure₠¬_ ⊛₠⟦ e ⟧₠Ï) ≡⟨ op-⊛ _ _ ⟩ op (pure₠¬_) ⊛₂ op (⟦ e ⟧₠Ï) ≡⟨ P.congâ‚‚ _⊛₂_ (op-pure _) (natural e Ï) ⟩ pureâ‚‚ ¬_ ⊛₂ ⟦ e ⟧₂ (Vec.map op Ï) ∎ natural top Ï = begin op (pure₠⊤) ≡⟨ op-pure _ ⟩ pureâ‚‚ ⊤ ∎ natural bot Ï = begin op (pure₠⊥) ≡⟨ op-pure _ ⟩ pureâ‚‚ ⊥ ∎ -- An example of how naturality can be used: Any boolean algebra can -- be lifted, in a pointwise manner, to vectors of carrier elements. lift : â„• → BooleanAlgebra b b lift n = record { Carrier = Vec Carrier n ; _≈_ = Pointwise _≈_ ; _∨_ = Vec.zipWith _∨_ ; _∧_ = Vec.zipWith _∧_ ; ¬_ = Vec.map ¬_ ; ⊤ = Vec.replicate ⊤ ; ⊥ = Vec.replicate ⊥ ; isBooleanAlgebra = record { isDistributiveLattice = record { isLattice = record { isEquivalence = PW.isEquivalence isEquivalence ; ∨-comm = λ _ _ → ext λ i → solve i 2 (λ x y → x or y , y or x) (∨-comm _ _) _ _ ; ∨-assoc = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (x or y) or z , x or (y or z)) (∨-assoc _ _ _) _ _ _ ; ∨-cong = λ xs≈us ys≈vs → ext λ i → solveâ‚ i 4 (λ x y u v → x or y , u or v) _ _ _ _ (∨-cong (Pointwise.app xs≈us i) (Pointwise.app ys≈vs i)) ; ∧-comm = λ _ _ → ext λ i → solve i 2 (λ x y → x and y , y and x) (∧-comm _ _) _ _ ; ∧-assoc = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (x and y) and z , x and (y and z)) (∧-assoc _ _ _) _ _ _ ; ∧-cong = λ xs≈ys us≈vs → ext λ i → solveâ‚ i 4 (λ x y u v → x and y , u and v) _ _ _ _ (∧-cong (Pointwise.app xs≈ys i) (Pointwise.app us≈vs i)) ; absorptive = (λ _ _ → ext λ i → solve i 2 (λ x y → x or (x and y) , x) (projâ‚ absorptive _ _) _ _) , (λ _ _ → ext λ i → solve i 2 (λ x y → x and (x or y) , x) (projâ‚‚ absorptive _ _) _ _) } ; ∨-∧-distribʳ = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (y and z) or x , (y or x) and (z or x)) (∨-∧-distribʳ _ _ _) _ _ _ } ; ∨-complementʳ = λ _ → ext λ i → solve i 1 (λ x → x or (not x) , top) (∨-complementʳ _) _ ; ∧-complementʳ = λ _ → ext λ i → solve i 1 (λ x → x and (not x) , bot) (∧-complementʳ _) _ ; ¬-cong = λ xs≈ys → ext λ i → solveâ‚ i 2 (λ x y → not x , not y) _ _ (¬-cong (Pointwise.app xs≈ys i)) } } where ⟦_⟧Id : ∀ {n} → Expr n → Vec Carrier n → Carrier ⟦_⟧Id = Semantics.⟦_⟧ (RawMonad.rawIApplicative IdentityMonad) ⟦_⟧Vec : ∀ {m n} → Expr n → Vec (Vec Carrier m) n → Vec Carrier m ⟦_⟧Vec = Semantics.⟦_⟧ Vec.applicative open module R {n} (i : Fin n) = Reflection setoid var (λ e Ï â†’ Vec.lookup i (⟦ e ⟧Vec Ï)) (λ e Ï â†’ ⟦ e ⟧Id (Vec.map (Vec.lookup i) Ï)) (λ e Ï â†’ sym $ reflexive $ Naturality.natural (VecProp.lookup-morphism i) e Ï) agda-stdlib-0.12/src/Algebra/Properties/DistributiveLattice.agda000066400000000000000000000066211270451047000246750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.DistributiveLattice {dlâ‚ dlâ‚‚} (DL : DistributiveLattice dlâ‚ dlâ‚‚) where open DistributiveLattice DL import Algebra.Properties.Lattice private open module L = Algebra.Properties.Lattice lattice public hiding (replace-equality) open import Algebra.Structures import Algebra.FunctionProperties as P; open P _≈_ open import Relation.Binary import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product ∨-∧-distrib : _∨_ DistributesOver _∧_ ∨-∧-distrib = ∨-∧-distribË¡ , ∨-∧-distribʳ where ∨-∧-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ʳ where ∧-∨-distribË¡ : _∧_ DistributesOverË¡ _∨_ ∧-∨-distribË¡ x y z = begin x ∧ (y ∨ z) ≈⟨ sym (projâ‚‚ absorptive _ _) ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (x ∨ y)) ∧ (y ∨ z) ≈⟨ (refl ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (y ∨ x)) ∧ (y ∨ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ ((y ∨ x) ∧ (y ∨ z)) ≈⟨ refl ⟨ ∧-cong ⟩ sym (proj₠∨-∧-distrib _ _ _) ⟩ x ∧ (y ∨ x ∧ z) ≈⟨ sym (projâ‚ absorptive _ _) ⟨ ∧-cong ⟩ refl ⟩ (x ∨ x ∧ z) ∧ (y ∨ x ∧ z) ≈⟨ sym $ projâ‚‚ ∨-∧-distrib _ _ _ ⟩ x ∧ y ∨ x ∧ z ∎ ∧-∨-distribʳ : _∧_ DistributesOverʳ _∨_ ∧-∨-distribʳ x y z = begin (y ∨ z) ∧ x ≈⟨ ∧-comm _ _ ⟩ x ∧ (y ∨ z) ≈⟨ ∧-∨-distribË¡ _ _ _ ⟩ x ∧ y ∨ x ∧ z ≈⟨ ∧-comm _ _ ⟨ ∨-cong ⟩ ∧-comm _ _ ⟩ y ∧ x ∨ z ∧ x ∎ -- The dual construction is also a distributive lattice. ∧-∨-isDistributiveLattice : IsDistributiveLattice _≈_ _∧_ _∨_ ∧-∨-isDistributiveLattice = record { isLattice = ∧-∨-isLattice ; ∨-∧-distribʳ = projâ‚‚ ∧-∨-distrib } ∧-∨-distributiveLattice : DistributiveLattice _ _ ∧-∨-distributiveLattice = record { _∧_ = _∨_ ; _∨_ = _∧_ ; isDistributiveLattice = ∧-∨-isDistributiveLattice } -- One can replace the underlying equality with an equivalent one. replace-equality : {_≈′_ : Rel Carrier dlâ‚‚} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → DistributiveLattice _ _ replace-equality {_≈′_} ≈⇔≈′ = record { _≈_ = _≈′_ ; _∧_ = _∧_ ; _∨_ = _∨_ ; isDistributiveLattice = record { isLattice = Lattice.isLattice (L.replace-equality ≈⇔≈′) ; ∨-∧-distribʳ = λ x y z → to ⟨$⟩ ∨-∧-distribʳ x y z } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) agda-stdlib-0.12/src/Algebra/Properties/Group.agda000066400000000000000000000053401270451047000220030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.Group {gâ‚ gâ‚‚} (G : Group gâ‚ gâ‚‚) where open Group G import Algebra.FunctionProperties as P; open P _≈_ import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Data.Product â»Â¹-involutive : ∀ x → x â»Â¹ â»Â¹ ≈ x â»Â¹-involutive x = begin x â»Â¹ â»Â¹ ≈⟨ sym $ projâ‚‚ identity _ ⟩ x â»Â¹ â»Â¹ ∙ ε ≈⟨ refl ⟨ ∙-cong ⟩ sym (projâ‚ inverse _) ⟩ x â»Â¹ â»Â¹ ∙ (x â»Â¹ ∙ x) ≈⟨ sym $ assoc _ _ _ ⟩ x â»Â¹ â»Â¹ ∙ x â»Â¹ ∙ x ≈⟨ projâ‚ inverse _ ⟨ ∙-cong ⟩ refl ⟩ ε ∙ x ≈⟨ projâ‚ identity _ ⟩ x ∎ private left-helper : ∀ x y → x ≈ (x ∙ y) ∙ y â»Â¹ left-helper x y = begin x ≈⟨ sym (projâ‚‚ identity x) ⟩ x ∙ ε ≈⟨ refl ⟨ ∙-cong ⟩ sym (projâ‚‚ inverse y) ⟩ x ∙ (y ∙ y â»Â¹) ≈⟨ sym (assoc x y (y â»Â¹)) ⟩ (x ∙ y) ∙ y â»Â¹ ∎ right-helper : ∀ x y → y ≈ x â»Â¹ ∙ (x ∙ y) right-helper x y = begin y ≈⟨ sym (projâ‚ identity y) ⟩ ε ∙ y ≈⟨ sym (projâ‚ inverse x) ⟨ ∙-cong ⟩ refl ⟩ (x â»Â¹ ∙ x) ∙ y ≈⟨ assoc (x â»Â¹) x y ⟩ x â»Â¹ ∙ (x ∙ y) ∎ left-identity-unique : ∀ x y → x ∙ y ≈ y → x ≈ ε left-identity-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y â»Â¹ ≈⟨ eq ⟨ ∙-cong ⟩ refl ⟩ y ∙ y â»Â¹ ≈⟨ projâ‚‚ inverse y ⟩ ε ∎ right-identity-unique : ∀ x y → x ∙ y ≈ x → y ≈ ε right-identity-unique x y eq = begin y ≈⟨ right-helper x y ⟩ x â»Â¹ ∙ (x ∙ y) ≈⟨ refl ⟨ ∙-cong ⟩ eq ⟩ x â»Â¹ ∙ x ≈⟨ projâ‚ inverse x ⟩ ε ∎ identity-unique : ∀ {x} → Identity x _∙_ → x ≈ ε identity-unique {x} id = left-identity-unique x x (projâ‚‚ id x) left-inverse-unique : ∀ x y → x ∙ y ≈ ε → x ≈ y â»Â¹ left-inverse-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y â»Â¹ ≈⟨ eq ⟨ ∙-cong ⟩ refl ⟩ ε ∙ y â»Â¹ ≈⟨ projâ‚ identity (y â»Â¹) ⟩ y â»Â¹ ∎ right-inverse-unique : ∀ x y → x ∙ y ≈ ε → y ≈ x â»Â¹ right-inverse-unique x y eq = begin y ≈⟨ sym (â»Â¹-involutive y) ⟩ y â»Â¹ â»Â¹ ≈⟨ â»Â¹-cong (sym (left-inverse-unique x y eq)) ⟩ x â»Â¹ ∎ agda-stdlib-0.12/src/Algebra/Properties/Lattice.agda000066400000000000000000000076211270451047000223000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.Lattice {lâ‚ lâ‚‚} (L : Lattice lâ‚ lâ‚‚) where open Lattice L open import Algebra.Structures import Algebra.FunctionProperties as P; open P _≈_ open import Relation.Binary import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product ∧-idempotent : Idempotent _∧_ ∧-idempotent x = begin x ∧ x ≈⟨ refl ⟨ ∧-cong ⟩ sym (projâ‚ absorptive _ _) ⟩ x ∧ (x ∨ x ∧ x) ≈⟨ projâ‚‚ absorptive _ _ ⟩ x ∎ ∨-idempotent : Idempotent _∨_ ∨-idempotent x = begin x ∨ x ≈⟨ refl ⟨ ∨-cong ⟩ sym (∧-idempotent _) ⟩ x ∨ x ∧ x ≈⟨ projâ‚ absorptive _ _ ⟩ x ∎ -- The dual construction is also a lattice. ∧-∨-isLattice : IsLattice _≈_ _∧_ _∨_ ∧-∨-isLattice = record { isEquivalence = isEquivalence ; ∨-comm = ∧-comm ; ∨-assoc = ∧-assoc ; ∨-cong = ∧-cong ; ∧-comm = ∨-comm ; ∧-assoc = ∨-assoc ; ∧-cong = ∨-cong ; absorptive = swap absorptive } ∧-∨-lattice : Lattice _ _ ∧-∨-lattice = record { _∧_ = _∨_ ; _∨_ = _∧_ ; isLattice = ∧-∨-isLattice } -- Every lattice can be turned into a poset. poset : Poset _ _ _ poset = record { Carrier = Carrier ; _≈_ = _≈_ ; _≤_ = λ x y → x ≈ x ∧ y ; isPartialOrder = record { isPreorder = record { isEquivalence = isEquivalence ; reflexive = λ {i} {j} i≈j → begin i ≈⟨ sym $ ∧-idempotent _ ⟩ i ∧ i ≈⟨ ∧-cong refl i≈j ⟩ i ∧ j ∎ ; trans = λ {i} {j} {k} i≈i∧j j≈j∧k → begin i ≈⟨ i≈i∧j ⟩ i ∧ j ≈⟨ ∧-cong refl j≈j∧k ⟩ i ∧ (j ∧ k) ≈⟨ sym (∧-assoc _ _ _) ⟩ (i ∧ j) ∧ k ≈⟨ ∧-cong (sym i≈i∧j) refl ⟩ i ∧ k ∎ } ; antisym = λ {x} {y} x≈x∧y y≈y∧x → begin x ≈⟨ x≈x∧y ⟩ x ∧ y ≈⟨ ∧-comm _ _ ⟩ y ∧ x ≈⟨ sym y≈y∧x ⟩ y ∎ } } -- One can replace the underlying equality with an equivalent one. replace-equality : {_≈′_ : Rel Carrier lâ‚‚} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → Lattice _ _ replace-equality {_≈′_} ≈⇔≈′ = record { _≈_ = _≈′_ ; _∧_ = _∧_ ; _∨_ = _∨_ ; isLattice = record { isEquivalence = record { refl = to ⟨$⟩ refl ; sym = λ x≈y → to ⟨$⟩ sym (from ⟨$⟩ x≈y) ; trans = λ x≈y y≈z → to ⟨$⟩ trans (from ⟨$⟩ x≈y) (from ⟨$⟩ y≈z) } ; ∨-comm = λ x y → to ⟨$⟩ ∨-comm x y ; ∨-assoc = λ x y z → to ⟨$⟩ ∨-assoc x y z ; ∨-cong = λ x≈y u≈v → to ⟨$⟩ ∨-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) ; ∧-comm = λ x y → to ⟨$⟩ ∧-comm x y ; ∧-assoc = λ x y z → to ⟨$⟩ ∧-assoc x y z ; ∧-cong = λ x≈y u≈v → to ⟨$⟩ ∧-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) ; absorptive = (λ x y → to ⟨$⟩ projâ‚ absorptive x y) , (λ x y → to ⟨$⟩ projâ‚‚ absorptive x y) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) agda-stdlib-0.12/src/Algebra/Properties/Ring.agda000066400000000000000000000044411270451047000216070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ open import Algebra module Algebra.Properties.Ring {râ‚ râ‚‚} (R : Ring râ‚ râ‚‚) where import Algebra.Properties.AbelianGroup as AGP open import Data.Product open import Function import Relation.Binary.EqReasoning as EqR open Ring R open EqR setoid open AGP +-abelianGroup public renaming ( â»Â¹-involutive to -‿involutive ; left-identity-unique to +-left-identity-unique ; right-identity-unique to +-right-identity-unique ; identity-unique to +-identity-unique ; left-inverse-unique to +-left-inverse-unique ; right-inverse-unique to +-right-inverse-unique ; â»Â¹-∙-comm to -‿+-comm ) -‿*-distribË¡ : ∀ x y → - x * y ≈ - (x * y) -‿*-distribË¡ x y = begin - x * y ≈⟨ sym $ projâ‚‚ +-identity _ ⟩ - x * y + 0# ≈⟨ refl ⟨ +-cong ⟩ sym (projâ‚‚ -‿inverse _) ⟩ - x * y + (x * y + - (x * y)) ≈⟨ sym $ +-assoc _ _ _ ⟩ - x * y + x * y + - (x * y) ≈⟨ sym (projâ‚‚ distrib _ _ _) ⟨ +-cong ⟩ refl ⟩ (- x + x) * y + - (x * y) ≈⟨ (projâ‚ -‿inverse _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ 0# * y + - (x * y) ≈⟨ projâ‚ zero _ ⟨ +-cong ⟩ refl ⟩ 0# + - (x * y) ≈⟨ projâ‚ +-identity _ ⟩ - (x * y) ∎ -‿*-distribʳ : ∀ x y → x * - y ≈ - (x * y) -‿*-distribʳ x y = begin x * - y ≈⟨ sym $ projâ‚ +-identity _ ⟩ 0# + x * - y ≈⟨ sym (projâ‚ -‿inverse _) ⟨ +-cong ⟩ refl ⟩ - (x * y) + x * y + x * - y ≈⟨ +-assoc _ _ _ ⟩ - (x * y) + (x * y + x * - y) ≈⟨ refl ⟨ +-cong ⟩ sym (projâ‚ distrib _ _ _) ⟩ - (x * y) + x * (y + - y) ≈⟨ refl ⟨ +-cong ⟩ (refl ⟨ *-cong ⟩ projâ‚‚ -‿inverse _) ⟩ - (x * y) + x * 0# ≈⟨ refl ⟨ +-cong ⟩ projâ‚‚ zero _ ⟩ - (x * y) + 0# ≈⟨ projâ‚‚ +-identity _ ⟩ - (x * y) ∎ agda-stdlib-0.12/src/Algebra/RingSolver.agda000066400000000000000000000544271270451047000206570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for commutative ring or semiring equalities ------------------------------------------------------------------------ -- Uses ideas from the Coq ring tactic. See "Proving Equalities in a -- Commutative Ring Done Right in Coq" by Grégoire and Mahboubi. The -- code below is not optimised like theirs, though (in particular, our -- Horner normal forms are not sparse). open import Algebra open import Algebra.RingSolver.AlmostCommutativeRing open import Relation.Binary module Algebra.RingSolver {râ‚ râ‚‚ r₃} (Coeff : RawRing râ‚) -- Coefficient "ring". (R : AlmostCommutativeRing râ‚‚ r₃) -- Main "ring". (morphism : Coeff -Raw-AlmostCommutative⟶ R) (_coeff≟_ : Decidable (Induced-equivalence morphism)) where import Algebra.RingSolver.Lemmas as L; open L Coeff R morphism private module C = RawRing Coeff open AlmostCommutativeRing R renaming (zero to zero*) import Algebra.FunctionProperties as P; open P _≈_ open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism renaming (⟦_⟧ to ⟦_⟧′) import Algebra.Operations as Ops; open Ops semiring open import Relation.Binary open import Relation.Nullary import Relation.Binary.EqReasoning as EqR; open EqR setoid import Relation.Binary.PropositionalEquality as PropEq import Relation.Binary.Reflection as Reflection open import Data.Empty open import Data.Product open import Data.Nat.Base as Nat using (â„•; suc; zero) open import Data.Fin as Fin using (Fin; zero; suc) open import Data.Vec open import Function open import Level using (_⊔_) infix 9 :-_ -H_ -N_ infixr 9 _:^_ _^N_ infix 8 _*x+_ _*x+HN_ _*x+H_ infixl 8 _:*_ _*N_ _*H_ _*NH_ _*HN_ infixl 7 _:+_ _:-_ _+H_ _+N_ infix 4 _≈H_ _≈N_ ------------------------------------------------------------------------ -- Polynomials data Op : Set where [+] : Op [*] : Op -- The polynomials are indexed by the number of variables. data Polynomial (m : â„•) : Set râ‚ where op : (o : Op) (pâ‚ : Polynomial m) (pâ‚‚ : Polynomial m) → Polynomial m con : (c : C.Carrier) → Polynomial m var : (x : Fin m) → Polynomial m _:^_ : (p : Polynomial m) (n : â„•) → Polynomial m :-_ : (p : Polynomial m) → Polynomial m -- Short-hand notation. _:+_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n _:+_ = op [+] _:*_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n _:*_ = op [*] _:-_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n x :- y = x :+ :- y -- Semantics. sem : Op → Opâ‚‚ Carrier sem [+] = _+_ sem [*] = _*_ ⟦_⟧ : ∀ {n} → Polynomial n → Vec Carrier n → Carrier ⟦ op o pâ‚ pâ‚‚ ⟧ Ï = ⟦ p₠⟧ Ï âŸ¨ sem o ⟩ ⟦ pâ‚‚ ⟧ Ï âŸ¦ con c ⟧ Ï = ⟦ c ⟧′ ⟦ var x ⟧ Ï = lookup x Ï âŸ¦ p :^ n ⟧ Ï = ⟦ p ⟧ Ï ^ n ⟦ :- p ⟧ Ï = - ⟦ p ⟧ Ï ------------------------------------------------------------------------ -- Normal forms of polynomials -- A univariate polynomial of degree d, -- -- p = a_d x^d + a_{d-1}x^{d-1} + … + a_0, -- -- is represented in Horner normal form by -- -- p = ((a_d x + a_{d-1})x + …)x + a_0. -- -- Note that Horner normal forms can be represented as lists, with the -- empty list standing for the zero polynomial of degree "-1". -- -- Given this representation of univariate polynomials over an -- arbitrary ring, polynomials in any number of variables over the -- ring C can be represented via the isomorphisms -- -- C[] ≅ C -- -- and -- -- C[X_0,...X_{n+1}] ≅ C[X_0,...,X_n][X_{n+1}]. mutual -- The polynomial representations are indexed by the polynomial's -- degree. data HNF : â„• → Set râ‚ where ∅ : ∀ {n} → HNF (suc n) _*x+_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) data Normal : â„• → Set râ‚ where con : C.Carrier → Normal zero poly : ∀ {n} → HNF (suc n) → Normal (suc n) -- Note that the data types above do /not/ ensure uniqueness of -- normal forms: the zero polynomial of degree one can be -- represented using both ∅ and ∅ *x+ con C.0#. mutual -- Semantics. ⟦_⟧H : ∀ {n} → HNF (suc n) → Vec Carrier (suc n) → Carrier ⟦ ∅ ⟧H _ = 0# ⟦ p *x+ c ⟧H (x ∷ Ï) = ⟦ p ⟧H (x ∷ Ï) * x + ⟦ c ⟧N Ï âŸ¦_⟧N : ∀ {n} → Normal n → Vec Carrier n → Carrier ⟦ con c ⟧N _ = ⟦ c ⟧′ ⟦ poly p ⟧N Ï = ⟦ p ⟧H Ï ------------------------------------------------------------------------ -- Equality and decidability mutual -- Equality. data _≈H_ : ∀ {n} → HNF n → HNF n → Set (r₠⊔ r₃) where ∅ : ∀ {n} → _≈H_ {suc n} ∅ ∅ _*x+_ : ∀ {n} {pâ‚ pâ‚‚ : HNF (suc n)} {câ‚ câ‚‚ : Normal n} → p₠≈H pâ‚‚ → c₠≈N câ‚‚ → (pâ‚ *x+ câ‚) ≈H (pâ‚‚ *x+ câ‚‚) data _≈N_ : ∀ {n} → Normal n → Normal n → Set (r₠⊔ r₃) where con : ∀ {câ‚ câ‚‚} → ⟦ c₠⟧′ ≈ ⟦ câ‚‚ ⟧′ → con c₠≈N con câ‚‚ poly : ∀ {n} {pâ‚ pâ‚‚ : HNF (suc n)} → p₠≈H pâ‚‚ → poly p₠≈N poly pâ‚‚ mutual -- Equality is decidable. _≟H_ : ∀ {n} → Decidable (_≈H_ {n = n}) ∅ ≟H ∅ = yes ∅ ∅ ≟H (_ *x+ _) = no λ() (_ *x+ _) ≟H ∅ = no λ() (pâ‚ *x+ câ‚) ≟H (pâ‚‚ *x+ câ‚‚) with p₠≟H pâ‚‚ | c₠≟N câ‚‚ ... | yes pâ‚≈pâ‚‚ | yes câ‚≈câ‚‚ = yes (pâ‚≈pâ‚‚ *x+ câ‚≈câ‚‚) ... | _ | no câ‚≉câ‚‚ = no λ { (_ *x+ câ‚≈câ‚‚) → câ‚≉câ‚‚ câ‚≈câ‚‚ } ... | no pâ‚≉pâ‚‚ | _ = no λ { (pâ‚≈pâ‚‚ *x+ _) → pâ‚≉pâ‚‚ pâ‚≈pâ‚‚ } _≟N_ : ∀ {n} → Decidable (_≈N_ {n = n}) con c₠≟N con câ‚‚ with câ‚ coeff≟ câ‚‚ ... | yes câ‚≈câ‚‚ = yes (con câ‚≈câ‚‚) ... | no câ‚≉câ‚‚ = no λ { (con câ‚≈câ‚‚) → câ‚≉câ‚‚ câ‚≈câ‚‚} poly p₠≟N poly pâ‚‚ with p₠≟H pâ‚‚ ... | yes pâ‚≈pâ‚‚ = yes (poly pâ‚≈pâ‚‚) ... | no pâ‚≉pâ‚‚ = no λ { (poly pâ‚≈pâ‚‚) → pâ‚≉pâ‚‚ pâ‚≈pâ‚‚ } mutual -- The semantics respect the equality relations defined above. ⟦_⟧H-cong : ∀ {n} {pâ‚ pâ‚‚ : HNF (suc n)} → p₠≈H pâ‚‚ → ∀ Ï â†’ ⟦ p₠⟧H Ï â‰ˆ ⟦ pâ‚‚ ⟧H Ï âŸ¦ ∅ ⟧H-cong _ = refl ⟦ pâ‚≈pâ‚‚ *x+ câ‚≈câ‚‚ ⟧H-cong (x ∷ Ï) = (⟦ pâ‚≈pâ‚‚ ⟧H-cong (x ∷ Ï) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ ⟦ câ‚≈câ‚‚ ⟧N-cong Ï âŸ¦_⟧N-cong : ∀ {n} {pâ‚ pâ‚‚ : Normal n} → p₠≈N pâ‚‚ → ∀ Ï â†’ ⟦ p₠⟧N Ï â‰ˆ ⟦ pâ‚‚ ⟧N Ï âŸ¦ con câ‚≈câ‚‚ ⟧N-cong _ = câ‚≈câ‚‚ ⟦ poly pâ‚≈pâ‚‚ ⟧N-cong Ï = ⟦ pâ‚≈pâ‚‚ ⟧H-cong Ï ------------------------------------------------------------------------ -- Ring operations on Horner normal forms -- Zero. 0H : ∀ {n} → HNF (suc n) 0H = ∅ 0N : ∀ {n} → Normal n 0N {zero} = con C.0# 0N {suc n} = poly 0H mutual -- One. 1H : ∀ {n} → HNF (suc n) 1H {n} = ∅ *x+ 1N {n} 1N : ∀ {n} → Normal n 1N {zero} = con C.1# 1N {suc n} = poly 1H -- A simplifying variant of _*x+_. _*x+HN_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) (p *x+ c′) *x+HN c = (p *x+ c′) *x+ c ∅ *x+HN c with c ≟N 0N ... | yes c≈0 = ∅ ... | no c≉0 = ∅ *x+ c mutual -- Addition. _+H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) ∅ +H p = p p +H ∅ = p (pâ‚ *x+ câ‚) +H (pâ‚‚ *x+ câ‚‚) = (pâ‚ +H pâ‚‚) *x+HN (câ‚ +N câ‚‚) _+N_ : ∀ {n} → Normal n → Normal n → Normal n con câ‚ +N con câ‚‚ = con (câ‚ C.+ câ‚‚) poly pâ‚ +N poly pâ‚‚ = poly (pâ‚ +H pâ‚‚) -- Multiplication. _*x+H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) pâ‚ *x+H (pâ‚‚ *x+ c) = (pâ‚ +H pâ‚‚) *x+HN c ∅ *x+H ∅ = ∅ (pâ‚ *x+ c) *x+H ∅ = (pâ‚ *x+ c) *x+ 0N mutual _*NH_ : ∀ {n} → Normal n → HNF (suc n) → HNF (suc n) c *NH ∅ = ∅ c *NH (p *x+ c′) with c ≟N 0N ... | yes c≈0 = ∅ ... | no c≉0 = (c *NH p) *x+ (c *N c′) _*HN_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) ∅ *HN c = ∅ (p *x+ c′) *HN c with c ≟N 0N ... | yes c≈0 = ∅ ... | no c≉0 = (p *HN c) *x+ (c′ *N c) _*H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) ∅ *H _ = ∅ (_ *x+ _) *H ∅ = ∅ (pâ‚ *x+ câ‚) *H (pâ‚‚ *x+ câ‚‚) = ((pâ‚ *H pâ‚‚) *x+H (pâ‚ *HN câ‚‚ +H câ‚ *NH pâ‚‚)) *x+HN (câ‚ *N câ‚‚) _*N_ : ∀ {n} → Normal n → Normal n → Normal n con câ‚ *N con câ‚‚ = con (câ‚ C.* câ‚‚) poly pâ‚ *N poly pâ‚‚ = poly (pâ‚ *H pâ‚‚) -- Exponentiation. _^N_ : ∀ {n} → Normal n → â„• → Normal n p ^N zero = 1N p ^N suc n = p *N (p ^N n) mutual -- Negation. -H_ : ∀ {n} → HNF (suc n) → HNF (suc n) -H p = (-N 1N) *NH p -N_ : ∀ {n} → Normal n → Normal n -N con c = con (C.- c) -N poly p = poly (-H p) ------------------------------------------------------------------------ -- Normalisation normalise-con : ∀ {n} → C.Carrier → Normal n normalise-con {zero} c = con c normalise-con {suc n} c = poly (∅ *x+HN normalise-con c) normalise-var : ∀ {n} → Fin n → Normal n normalise-var zero = poly ((∅ *x+ 1N) *x+ 0N) normalise-var (suc i) = poly (∅ *x+HN normalise-var i) normalise : ∀ {n} → Polynomial n → Normal n normalise (op [+] tâ‚ tâ‚‚) = normalise tâ‚ +N normalise tâ‚‚ normalise (op [*] tâ‚ tâ‚‚) = normalise tâ‚ *N normalise tâ‚‚ normalise (con c) = normalise-con c normalise (var i) = normalise-var i normalise (t :^ k) = normalise t ^N k normalise (:- t) = -N normalise t -- Evaluation after normalisation. ⟦_⟧↓ : ∀ {n} → Polynomial n → Vec Carrier n → Carrier ⟦ p ⟧↓ Ï = ⟦ normalise p ⟧N Ï ------------------------------------------------------------------------ -- Homomorphism lemmas 0N-homo : ∀ {n} Ï â†’ ⟦ 0N {n} ⟧N Ï â‰ˆ 0# 0N-homo [] = 0-homo 0N-homo (x ∷ Ï) = refl -- If c is equal to 0N, then c is semantically equal to 0#. 0≈⟦0⟧ : ∀ {n} {c : Normal n} → c ≈N 0N → ∀ Ï â†’ 0# ≈ ⟦ c ⟧N Ï 0≈⟦0⟧ {c = c} c≈0 Ï = sym (begin ⟦ c ⟧N Ï â‰ˆâŸ¨ ⟦ c≈0 ⟧N-cong Ï âŸ© ⟦ 0N ⟧N Ï â‰ˆâŸ¨ 0N-homo Ï âŸ© 0# ∎) 1N-homo : ∀ {n} Ï â†’ ⟦ 1N {n} ⟧N Ï â‰ˆ 1# 1N-homo [] = 1-homo 1N-homo (x ∷ Ï) = begin 0# * x + ⟦ 1N ⟧N Ï â‰ˆâŸ¨ refl ⟨ +-cong ⟩ 1N-homo Ï âŸ© 0# * x + 1# ≈⟨ lemma₆ _ _ ⟩ 1# ∎ -- _*x+HN_ is equal to _*x+_. *x+HN≈*x+ : ∀ {n} (p : HNF (suc n)) (c : Normal n) → ∀ Ï â†’ ⟦ p *x+HN c ⟧H Ï â‰ˆ ⟦ p *x+ c ⟧H Ï *x+HN≈*x+ (p *x+ c′) c Ï = refl *x+HN≈*x+ ∅ c (x ∷ Ï) with c ≟N 0N ... | yes c≈0 = begin 0# ≈⟨ 0≈⟦0⟧ c≈0 Ï âŸ© ⟦ c ⟧N Ï â‰ˆâŸ¨ sym $ lemma₆ _ _ ⟩ 0# * x + ⟦ c ⟧N Ï âˆŽ ... | no c≉0 = refl ∅*x+HN-homo : ∀ {n} (c : Normal n) x Ï â†’ ⟦ ∅ *x+HN c ⟧H (x ∷ Ï) ≈ ⟦ c ⟧N Ï âˆ…*x+HN-homo c x Ï with c ≟N 0N ... | yes c≈0 = 0≈⟦0⟧ c≈0 Ï ... | no c≉0 = lemma₆ _ _ mutual +H-homo : ∀ {n} (pâ‚ pâ‚‚ : HNF (suc n)) → ∀ Ï â†’ ⟦ pâ‚ +H pâ‚‚ ⟧H Ï â‰ˆ ⟦ p₠⟧H Ï + ⟦ pâ‚‚ ⟧H Ï +H-homo ∅ pâ‚‚ Ï = sym (projâ‚ +-identity _) +H-homo (pâ‚ *x+ xâ‚) ∅ Ï = sym (projâ‚‚ +-identity _) +H-homo (pâ‚ *x+ câ‚) (pâ‚‚ *x+ câ‚‚) (x ∷ Ï) = begin ⟦ (pâ‚ +H pâ‚‚) *x+HN (câ‚ +N câ‚‚) ⟧H (x ∷ Ï) ≈⟨ *x+HN≈*x+ (pâ‚ +H pâ‚‚) (câ‚ +N câ‚‚) (x ∷ Ï) ⟩ ⟦ pâ‚ +H pâ‚‚ ⟧H (x ∷ Ï) * x + ⟦ câ‚ +N câ‚‚ ⟧N Ï â‰ˆâŸ¨ (+H-homo pâ‚ pâ‚‚ (x ∷ Ï) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ +N-homo câ‚ câ‚‚ Ï âŸ© (⟦ p₠⟧H (x ∷ Ï) + ⟦ pâ‚‚ ⟧H (x ∷ Ï)) * x + (⟦ c₠⟧N Ï + ⟦ câ‚‚ ⟧N Ï) ≈⟨ lemmaâ‚ _ _ _ _ _ ⟩ (⟦ p₠⟧H (x ∷ Ï) * x + ⟦ c₠⟧N Ï) + (⟦ pâ‚‚ ⟧H (x ∷ Ï) * x + ⟦ câ‚‚ ⟧N Ï) ∎ +N-homo : ∀ {n} (pâ‚ pâ‚‚ : Normal n) → ∀ Ï â†’ ⟦ pâ‚ +N pâ‚‚ ⟧N Ï â‰ˆ ⟦ p₠⟧N Ï + ⟦ pâ‚‚ ⟧N Ï +N-homo (con câ‚) (con câ‚‚) _ = +-homo _ _ +N-homo (poly pâ‚) (poly pâ‚‚) Ï = +H-homo pâ‚ pâ‚‚ Ï *x+H-homo : ∀ {n} (pâ‚ pâ‚‚ : HNF (suc n)) x Ï â†’ ⟦ pâ‚ *x+H pâ‚‚ ⟧H (x ∷ Ï) ≈ ⟦ p₠⟧H (x ∷ Ï) * x + ⟦ pâ‚‚ ⟧H (x ∷ Ï) *x+H-homo ∅ ∅ _ _ = sym $ lemma₆ _ _ *x+H-homo (p *x+ c) ∅ x Ï = begin ⟦ p *x+ c ⟧H (x ∷ Ï) * x + ⟦ 0N ⟧N Ï â‰ˆâŸ¨ refl ⟨ +-cong ⟩ 0N-homo Ï âŸ© ⟦ p *x+ c ⟧H (x ∷ Ï) * x + 0# ∎ *x+H-homo pâ‚ (pâ‚‚ *x+ câ‚‚) x Ï = begin ⟦ (pâ‚ +H pâ‚‚) *x+HN câ‚‚ ⟧H (x ∷ Ï) ≈⟨ *x+HN≈*x+ (pâ‚ +H pâ‚‚) câ‚‚ (x ∷ Ï) ⟩ ⟦ pâ‚ +H pâ‚‚ ⟧H (x ∷ Ï) * x + ⟦ câ‚‚ ⟧N Ï â‰ˆâŸ¨ (+H-homo pâ‚ pâ‚‚ (x ∷ Ï) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₠⟧H (x ∷ Ï) + ⟦ pâ‚‚ ⟧H (x ∷ Ï)) * x + ⟦ câ‚‚ ⟧N Ï â‰ˆâŸ¨ lemmaâ‚€ _ _ _ _ ⟩ ⟦ p₠⟧H (x ∷ Ï) * x + (⟦ pâ‚‚ ⟧H (x ∷ Ï) * x + ⟦ câ‚‚ ⟧N Ï) ∎ mutual *NH-homo : ∀ {n} (c : Normal n) (p : HNF (suc n)) x Ï â†’ ⟦ c *NH p ⟧H (x ∷ Ï) ≈ ⟦ c ⟧N Ï * ⟦ p ⟧H (x ∷ Ï) *NH-homo c ∅ x Ï = sym (projâ‚‚ zero* _) *NH-homo c (p *x+ c′) x Ï with c ≟N 0N ... | yes c≈0 = begin 0# ≈⟨ sym (projâ‚ zero* _) ⟩ 0# * (⟦ p ⟧H (x ∷ Ï) * x + ⟦ c′ ⟧N Ï) ≈⟨ 0≈⟦0⟧ c≈0 Ï âŸ¨ *-cong ⟩ refl ⟩ ⟦ c ⟧N Ï * (⟦ p ⟧H (x ∷ Ï) * x + ⟦ c′ ⟧N Ï) ∎ ... | no c≉0 = begin ⟦ c *NH p ⟧H (x ∷ Ï) * x + ⟦ c *N c′ ⟧N Ï â‰ˆâŸ¨ (*NH-homo c p x Ï âŸ¨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c c′ Ï âŸ© (⟦ c ⟧N Ï * ⟦ p ⟧H (x ∷ Ï)) * x + (⟦ c ⟧N Ï * ⟦ c′ ⟧N Ï) ≈⟨ lemma₃ _ _ _ _ ⟩ ⟦ c ⟧N Ï * (⟦ p ⟧H (x ∷ Ï) * x + ⟦ c′ ⟧N Ï) ∎ *HN-homo : ∀ {n} (p : HNF (suc n)) (c : Normal n) x Ï â†’ ⟦ p *HN c ⟧H (x ∷ Ï) ≈ ⟦ p ⟧H (x ∷ Ï) * ⟦ c ⟧N Ï *HN-homo ∅ c x Ï = sym (projâ‚ zero* _) *HN-homo (p *x+ c′) c x Ï with c ≟N 0N ... | yes c≈0 = begin 0# ≈⟨ sym (projâ‚‚ zero* _) ⟩ (⟦ p ⟧H (x ∷ Ï) * x + ⟦ c′ ⟧N Ï) * 0# ≈⟨ refl ⟨ *-cong ⟩ 0≈⟦0⟧ c≈0 Ï âŸ© (⟦ p ⟧H (x ∷ Ï) * x + ⟦ c′ ⟧N Ï) * ⟦ c ⟧N Ï âˆŽ ... | no c≉0 = begin ⟦ p *HN c ⟧H (x ∷ Ï) * x + ⟦ c′ *N c ⟧N Ï â‰ˆâŸ¨ (*HN-homo p c x Ï âŸ¨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c′ c Ï âŸ© (⟦ p ⟧H (x ∷ Ï) * ⟦ c ⟧N Ï) * x + (⟦ c′ ⟧N Ï * ⟦ c ⟧N Ï) ≈⟨ lemmaâ‚‚ _ _ _ _ ⟩ (⟦ p ⟧H (x ∷ Ï) * x + ⟦ c′ ⟧N Ï) * ⟦ c ⟧N Ï âˆŽ *H-homo : ∀ {n} (pâ‚ pâ‚‚ : HNF (suc n)) → ∀ Ï â†’ ⟦ pâ‚ *H pâ‚‚ ⟧H Ï â‰ˆ ⟦ p₠⟧H Ï * ⟦ pâ‚‚ ⟧H Ï *H-homo ∅ pâ‚‚ Ï = sym $ projâ‚ zero* _ *H-homo (pâ‚ *x+ câ‚) ∅ Ï = sym $ projâ‚‚ zero* _ *H-homo (pâ‚ *x+ câ‚) (pâ‚‚ *x+ câ‚‚) (x ∷ Ï) = begin ⟦ ((pâ‚ *H pâ‚‚) *x+H ((pâ‚ *HN câ‚‚) +H (câ‚ *NH pâ‚‚))) *x+HN (câ‚ *N câ‚‚) ⟧H (x ∷ Ï) ≈⟨ *x+HN≈*x+ ((pâ‚ *H pâ‚‚) *x+H ((pâ‚ *HN câ‚‚) +H (câ‚ *NH pâ‚‚))) (câ‚ *N câ‚‚) (x ∷ Ï) ⟩ ⟦ (pâ‚ *H pâ‚‚) *x+H ((pâ‚ *HN câ‚‚) +H (câ‚ *NH pâ‚‚)) ⟧H (x ∷ Ï) * x + ⟦ câ‚ *N câ‚‚ ⟧N Ï â‰ˆâŸ¨ (*x+H-homo (pâ‚ *H pâ‚‚) ((pâ‚ *HN câ‚‚) +H (câ‚ *NH pâ‚‚)) x Ï âŸ¨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo câ‚ câ‚‚ Ï âŸ© (⟦ pâ‚ *H pâ‚‚ ⟧H (x ∷ Ï) * x + ⟦ (pâ‚ *HN câ‚‚) +H (câ‚ *NH pâ‚‚) ⟧H (x ∷ Ï)) * x + ⟦ c₠⟧N Ï * ⟦ câ‚‚ ⟧N Ï â‰ˆâŸ¨ (((*H-homo pâ‚ pâ‚‚ (x ∷ Ï) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ (+H-homo (pâ‚ *HN câ‚‚) (câ‚ *NH pâ‚‚) (x ∷ Ï))) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₠⟧H (x ∷ Ï) * ⟦ pâ‚‚ ⟧H (x ∷ Ï) * x + (⟦ pâ‚ *HN câ‚‚ ⟧H (x ∷ Ï) + ⟦ câ‚ *NH pâ‚‚ ⟧H (x ∷ Ï))) * x + ⟦ c₠⟧N Ï * ⟦ câ‚‚ ⟧N Ï â‰ˆâŸ¨ ((refl ⟨ +-cong ⟩ (*HN-homo pâ‚ câ‚‚ x Ï âŸ¨ +-cong ⟩ *NH-homo câ‚ pâ‚‚ x Ï)) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₠⟧H (x ∷ Ï) * ⟦ pâ‚‚ ⟧H (x ∷ Ï) * x + (⟦ p₠⟧H (x ∷ Ï) * ⟦ câ‚‚ ⟧N Ï + ⟦ c₠⟧N Ï * ⟦ pâ‚‚ ⟧H (x ∷ Ï))) * x + (⟦ c₠⟧N Ï * ⟦ câ‚‚ ⟧N Ï) ≈⟨ lemmaâ‚„ _ _ _ _ _ ⟩ (⟦ p₠⟧H (x ∷ Ï) * x + ⟦ c₠⟧N Ï) * (⟦ pâ‚‚ ⟧H (x ∷ Ï) * x + ⟦ câ‚‚ ⟧N Ï) ∎ *N-homo : ∀ {n} (pâ‚ pâ‚‚ : Normal n) → ∀ Ï â†’ ⟦ pâ‚ *N pâ‚‚ ⟧N Ï â‰ˆ ⟦ p₠⟧N Ï * ⟦ pâ‚‚ ⟧N Ï *N-homo (con câ‚) (con câ‚‚) _ = *-homo _ _ *N-homo (poly pâ‚) (poly pâ‚‚) Ï = *H-homo pâ‚ pâ‚‚ Ï ^N-homo : ∀ {n} (p : Normal n) (k : â„•) → ∀ Ï â†’ ⟦ p ^N k ⟧N Ï â‰ˆ ⟦ p ⟧N Ï ^ k ^N-homo p zero Ï = 1N-homo Ï ^N-homo p (suc k) Ï = begin ⟦ p *N (p ^N k) ⟧N Ï â‰ˆâŸ¨ *N-homo p (p ^N k) Ï âŸ© ⟦ p ⟧N Ï * ⟦ p ^N k ⟧N Ï â‰ˆâŸ¨ refl ⟨ *-cong ⟩ ^N-homo p k Ï âŸ© ⟦ p ⟧N Ï * (⟦ p ⟧N Ï ^ k) ∎ mutual -H‿-homo : ∀ {n} (p : HNF (suc n)) → ∀ Ï â†’ ⟦ -H p ⟧H Ï â‰ˆ - ⟦ p ⟧H Ï -H‿-homo p (x ∷ Ï) = begin ⟦ (-N 1N) *NH p ⟧H (x ∷ Ï) ≈⟨ *NH-homo (-N 1N) p x Ï âŸ© ⟦ -N 1N ⟧N Ï * ⟦ p ⟧H (x ∷ Ï) ≈⟨ trans (-N‿-homo 1N Ï) (-‿cong (1N-homo Ï)) ⟨ *-cong ⟩ refl ⟩ - 1# * ⟦ p ⟧H (x ∷ Ï) ≈⟨ lemma₇ _ ⟩ - ⟦ p ⟧H (x ∷ Ï) ∎ -N‿-homo : ∀ {n} (p : Normal n) → ∀ Ï â†’ ⟦ -N p ⟧N Ï â‰ˆ - ⟦ p ⟧N Ï -N‿-homo (con c) _ = -‿homo _ -N‿-homo (poly p) Ï = -H‿-homo p Ï ------------------------------------------------------------------------ -- Correctness correct-con : ∀ {n} (c : C.Carrier) (Ï : Vec Carrier n) → ⟦ normalise-con c ⟧N Ï â‰ˆ ⟦ c ⟧′ correct-con c [] = refl correct-con c (x ∷ Ï) = begin ⟦ ∅ *x+HN normalise-con c ⟧H (x ∷ Ï) ≈⟨ ∅*x+HN-homo (normalise-con c) x Ï âŸ© ⟦ normalise-con c ⟧N Ï â‰ˆâŸ¨ correct-con c Ï âŸ© ⟦ c ⟧′ ∎ correct-var : ∀ {n} (i : Fin n) → ∀ Ï â†’ ⟦ normalise-var i ⟧N Ï â‰ˆ lookup i Ï correct-var () [] correct-var (suc i) (x ∷ Ï) = begin ⟦ ∅ *x+HN normalise-var i ⟧H (x ∷ Ï) ≈⟨ ∅*x+HN-homo (normalise-var i) x Ï âŸ© ⟦ normalise-var i ⟧N Ï â‰ˆâŸ¨ correct-var i Ï âŸ© lookup i Ï âˆŽ correct-var zero (x ∷ Ï) = begin (0# * x + ⟦ 1N ⟧N Ï) * x + ⟦ 0N ⟧N Ï â‰ˆâŸ¨ ((refl ⟨ +-cong ⟩ 1N-homo Ï) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ 0N-homo Ï âŸ© (0# * x + 1#) * x + 0# ≈⟨ lemmaâ‚… _ ⟩ x ∎ correct : ∀ {n} (p : Polynomial n) → ∀ Ï â†’ ⟦ p ⟧↓ Ï â‰ˆ ⟦ p ⟧ Ï correct (op [+] pâ‚ pâ‚‚) Ï = begin ⟦ normalise pâ‚ +N normalise pâ‚‚ ⟧N Ï â‰ˆâŸ¨ +N-homo (normalise pâ‚) (normalise pâ‚‚) Ï âŸ© ⟦ p₠⟧↓ Ï + ⟦ pâ‚‚ ⟧↓ Ï â‰ˆâŸ¨ correct pâ‚ Ï âŸ¨ +-cong ⟩ correct pâ‚‚ Ï âŸ© ⟦ p₠⟧ Ï + ⟦ pâ‚‚ ⟧ Ï âˆŽ correct (op [*] pâ‚ pâ‚‚) Ï = begin ⟦ normalise pâ‚ *N normalise pâ‚‚ ⟧N Ï â‰ˆâŸ¨ *N-homo (normalise pâ‚) (normalise pâ‚‚) Ï âŸ© ⟦ p₠⟧↓ Ï * ⟦ pâ‚‚ ⟧↓ Ï â‰ˆâŸ¨ correct pâ‚ Ï âŸ¨ *-cong ⟩ correct pâ‚‚ Ï âŸ© ⟦ p₠⟧ Ï * ⟦ pâ‚‚ ⟧ Ï âˆŽ correct (con c) Ï = correct-con c Ï correct (var i) Ï = correct-var i Ï correct (p :^ k) Ï = begin ⟦ normalise p ^N k ⟧N Ï â‰ˆâŸ¨ ^N-homo (normalise p) k Ï âŸ© ⟦ p ⟧↓ Ï ^ k ≈⟨ correct p Ï âŸ¨ ^-cong ⟩ PropEq.refl {x = k} ⟩ ⟦ p ⟧ Ï ^ k ∎ correct (:- p) Ï = begin ⟦ -N normalise p ⟧N Ï â‰ˆâŸ¨ -N‿-homo (normalise p) Ï âŸ© - ⟦ p ⟧↓ Ï â‰ˆâŸ¨ -‿cong (correct p Ï) ⟩ - ⟦ p ⟧ Ï âˆŽ ------------------------------------------------------------------------ -- "Tactics" open Reflection setoid var ⟦_⟧ ⟦_⟧↓ correct public using (prove; solve) renaming (_⊜_ to _:=_) -- For examples of how solve and _:=_ can be used to -- semi-automatically prove ring equalities, see, for instance, -- Data.Digit or Data.Nat.DivMod. agda-stdlib-0.12/src/Algebra/RingSolver/000077500000000000000000000000001270451047000200255ustar00rootroot00000000000000agda-stdlib-0.12/src/Algebra/RingSolver/AlmostCommutativeRing.agda000066400000000000000000000114501270451047000251410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Commutative semirings with some additional structure ("almost" -- commutative rings), used by the ring solver ------------------------------------------------------------------------ module Algebra.RingSolver.AlmostCommutativeRing where open import Relation.Binary open import Algebra open import Algebra.Structures open import Algebra.FunctionProperties import Algebra.Morphism as Morphism open import Function open import Level ------------------------------------------------------------------------ -- Definitions record IsAlmostCommutativeRing {a â„“} {A : Set a} (_≈_ : Rel A â„“) (_+_ _*_ : Opâ‚‚ A) (-_ : Opâ‚ A) (0# 1# : A) : Set (a ⊔ â„“) where field isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# -‿cong : -_ Preserves _≈_ ⟶ _≈_ -‿*-distribË¡ : ∀ x y → ((- x) * y) ≈ (- (x * y)) -‿+-comm : ∀ x y → ((- x) + (- y)) ≈ (- (x + y)) open IsCommutativeSemiring isCommutativeSemiring public record AlmostCommutativeRing c â„“ : Set (suc (c ⊔ â„“)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier â„“ _+_ : Opâ‚‚ Carrier _*_ : Opâ‚‚ Carrier -_ : Opâ‚ Carrier 0# : Carrier 1# : Carrier isAlmostCommutativeRing : IsAlmostCommutativeRing _≈_ _+_ _*_ -_ 0# 1# open IsAlmostCommutativeRing isAlmostCommutativeRing public commutativeSemiring : CommutativeSemiring _ _ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open CommutativeSemiring commutativeSemiring public using ( setoid ; +-semigroup; +-monoid; +-commutativeMonoid ; *-semigroup; *-monoid; *-commutativeMonoid ; semiring ) rawRing : RawRing _ rawRing = record { _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0# ; 1# = 1# } ------------------------------------------------------------------------ -- Homomorphisms record _-Raw-AlmostCommutative⟶_ {râ‚ râ‚‚ r₃} (From : RawRing râ‚) (To : AlmostCommutativeRing râ‚‚ r₃) : Set (r₠⊔ râ‚‚ ⊔ r₃) where private module F = RawRing From module T = AlmostCommutativeRing To open Morphism.Definitions F.Carrier T.Carrier T._≈_ field ⟦_⟧ : Morphism +-homo : Homomorphicâ‚‚ ⟦_⟧ F._+_ T._+_ *-homo : Homomorphicâ‚‚ ⟦_⟧ F._*_ T._*_ -‿homo : Homomorphic₠⟦_⟧ F.-_ T.-_ 0-homo : Homomorphicâ‚€ ⟦_⟧ F.0# T.0# 1-homo : Homomorphicâ‚€ ⟦_⟧ F.1# T.1# -raw-almostCommutative⟶ : ∀ {râ‚ râ‚‚} (R : AlmostCommutativeRing râ‚ râ‚‚) → AlmostCommutativeRing.rawRing R -Raw-AlmostCommutative⟶ R -raw-almostCommutative⟶ R = record { ⟦_⟧ = id ; +-homo = λ _ _ → refl ; *-homo = λ _ _ → refl ; -‿homo = λ _ → refl ; 0-homo = refl ; 1-homo = refl } where open AlmostCommutativeRing R -- A homomorphism induces a notion of equivalence on the raw ring. Induced-equivalence : ∀ {câ‚ câ‚‚ â„“} {Coeff : RawRing câ‚} {R : AlmostCommutativeRing câ‚‚ â„“} → Coeff -Raw-AlmostCommutative⟶ R → Rel (RawRing.Carrier Coeff) â„“ Induced-equivalence {R = R} morphism a b = ⟦ a ⟧ ≈ ⟦ b ⟧ where open AlmostCommutativeRing R open _-Raw-AlmostCommutative⟶_ morphism ------------------------------------------------------------------------ -- Conversions -- Commutative rings are almost commutative rings. fromCommutativeRing : ∀ {râ‚ râ‚‚} → CommutativeRing râ‚ râ‚‚ → AlmostCommutativeRing _ _ fromCommutativeRing CR = record { isAlmostCommutativeRing = record { isCommutativeSemiring = isCommutativeSemiring ; -‿cong = -‿cong ; -‿*-distribË¡ = -‿*-distribË¡ ; -‿+-comm = â»Â¹-∙-comm } } where open CommutativeRing CR import Algebra.Properties.Ring as R; open R ring import Algebra.Properties.AbelianGroup as AG; open AG +-abelianGroup -- Commutative semirings can be viewed as almost commutative rings by -- using identity as the "almost negation". fromCommutativeSemiring : ∀ {râ‚ râ‚‚} → CommutativeSemiring râ‚ râ‚‚ → AlmostCommutativeRing _ _ fromCommutativeSemiring CS = record { -_ = id ; isAlmostCommutativeRing = record { isCommutativeSemiring = isCommutativeSemiring ; -‿cong = id ; -‿*-distribË¡ = λ _ _ → refl ; -‿+-comm = λ _ _ → refl } } where open CommutativeSemiring CS agda-stdlib-0.12/src/Algebra/RingSolver/Lemmas.agda000066400000000000000000000113641270451047000220660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some boring lemmas used by the ring solver ------------------------------------------------------------------------ -- Note that these proofs use all "almost commutative ring" properties. open import Algebra open import Algebra.RingSolver.AlmostCommutativeRing module Algebra.RingSolver.Lemmas {râ‚ râ‚‚ r₃} (coeff : RawRing râ‚) (r : AlmostCommutativeRing râ‚‚ r₃) (morphism : coeff -Raw-AlmostCommutative⟶ r) where private module C = RawRing coeff open AlmostCommutativeRing r open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism import Relation.Binary.EqReasoning as EqR; open EqR setoid open import Function open import Data.Product lemmaâ‚€ : ∀ a b c x → (a + b) * x + c ≈ a * x + (b * x + c) lemmaâ‚€ a b c x = begin (a + b) * x + c ≈⟨ projâ‚‚ distrib _ _ _ ⟨ +-cong ⟩ refl ⟩ (a * x + b * x) + c ≈⟨ +-assoc _ _ _ ⟩ a * x + (b * x + c) ∎ lemmaâ‚ : ∀ a b c d x → (a + b) * x + (c + d) ≈ (a * x + c) + (b * x + d) lemmaâ‚ a b c d x = begin (a + b) * x + (c + d) ≈⟨ lemmaâ‚€ _ _ _ _ ⟩ a * x + (b * x + (c + d)) ≈⟨ refl ⟨ +-cong ⟩ sym (+-assoc _ _ _) ⟩ a * x + ((b * x + c) + d) ≈⟨ refl ⟨ +-cong ⟩ (+-comm _ _ ⟨ +-cong ⟩ refl) ⟩ a * x + ((c + b * x) + d) ≈⟨ refl ⟨ +-cong ⟩ +-assoc _ _ _ ⟩ a * x + (c + (b * x + d)) ≈⟨ sym $ +-assoc _ _ _ ⟩ (a * x + c) + (b * x + d) ∎ lemmaâ‚‚ : ∀ a b c x → a * c * x + b * c ≈ (a * x + b) * c lemmaâ‚‚ a b c x = begin a * c * x + b * c ≈⟨ lem ⟨ +-cong ⟩ refl ⟩ a * x * c + b * c ≈⟨ sym $ projâ‚‚ distrib _ _ _ ⟩ (a * x + b) * c ∎ where lem = begin a * c * x ≈⟨ *-assoc _ _ _ ⟩ a * (c * x) ≈⟨ refl ⟨ *-cong ⟩ *-comm _ _ ⟩ a * (x * c) ≈⟨ sym $ *-assoc _ _ _ ⟩ a * x * c ∎ lemma₃ : ∀ a b c x → a * b * x + a * c ≈ a * (b * x + c) lemma₃ a b c x = begin a * b * x + a * c ≈⟨ *-assoc _ _ _ ⟨ +-cong ⟩ refl ⟩ a * (b * x) + a * c ≈⟨ sym $ projâ‚ distrib _ _ _ ⟩ a * (b * x + c) ∎ lemmaâ‚„ : ∀ a b c d x → (a * c * x + (a * d + b * c)) * x + b * d ≈ (a * x + b) * (c * x + d) lemmaâ‚„ a b c d x = begin (a * c * x + (a * d + b * c)) * x + b * d ≈⟨ projâ‚‚ distrib _ _ _ ⟨ +-cong ⟩ refl ⟩ (a * c * x * x + (a * d + b * c) * x) + b * d ≈⟨ refl ⟨ +-cong ⟩ ((refl ⟨ +-cong ⟩ refl) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (a * c * x * x + (a * d + b * c) * x) + b * d ≈⟨ +-assoc _ _ _ ⟩ a * c * x * x + ((a * d + b * c) * x + b * d) ≈⟨ lem₠⟨ +-cong ⟩ (lemâ‚‚ ⟨ +-cong ⟩ refl) ⟩ a * x * (c * x) + (a * x * d + b * (c * x) + b * d) ≈⟨ refl ⟨ +-cong ⟩ +-assoc _ _ _ ⟩ a * x * (c * x) + (a * x * d + (b * (c * x) + b * d)) ≈⟨ sym $ +-assoc _ _ _ ⟩ a * x * (c * x) + a * x * d + (b * (c * x) + b * d) ≈⟨ sym $ projâ‚ distrib _ _ _ ⟨ +-cong ⟩ projâ‚ distrib _ _ _ ⟩ a * x * (c * x + d) + b * (c * x + d) ≈⟨ sym $ projâ‚‚ distrib _ _ _ ⟩ (a * x + b) * (c * x + d) ∎ where lemâ‚′ = begin a * c * x ≈⟨ *-assoc _ _ _ ⟩ a * (c * x) ≈⟨ refl ⟨ *-cong ⟩ *-comm _ _ ⟩ a * (x * c) ≈⟨ sym $ *-assoc _ _ _ ⟩ a * x * c ∎ lemâ‚ = begin a * c * x * x ≈⟨ lemâ‚′ ⟨ *-cong ⟩ refl ⟩ a * x * c * x ≈⟨ *-assoc _ _ _ ⟩ a * x * (c * x) ∎ lemâ‚‚ = begin (a * d + b * c) * x ≈⟨ projâ‚‚ distrib _ _ _ ⟩ a * d * x + b * c * x ≈⟨ *-assoc _ _ _ ⟨ +-cong ⟩ *-assoc _ _ _ ⟩ a * (d * x) + b * (c * x) ≈⟨ (refl ⟨ *-cong ⟩ *-comm _ _) ⟨ +-cong ⟩ refl ⟩ a * (x * d) + b * (c * x) ≈⟨ sym $ *-assoc _ _ _ ⟨ +-cong ⟩ refl ⟩ a * x * d + b * (c * x) ∎ lemmaâ‚… : ∀ x → (0# * x + 1#) * x + 0# ≈ x lemmaâ‚… x = begin (0# * x + 1#) * x + 0# ≈⟨ ((zeroË¡ _ ⟨ +-cong ⟩ refl) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (0# + 1#) * x + 0# ≈⟨ (projâ‚ +-identity _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ 1# * x + 0# ≈⟨ projâ‚‚ +-identity _ ⟩ 1# * x ≈⟨ projâ‚ *-identity _ ⟩ x ∎ lemma₆ : ∀ a x → 0# * x + a ≈ a lemma₆ a x = begin 0# * x + a ≈⟨ zeroË¡ _ ⟨ +-cong ⟩ refl ⟩ 0# + a ≈⟨ projâ‚ +-identity _ ⟩ a ∎ lemma₇ : ∀ x → - 1# * x ≈ - x lemma₇ x = begin - 1# * x ≈⟨ -‿*-distribË¡ _ _ ⟩ - (1# * x) ≈⟨ -‿cong (projâ‚ *-identity _) ⟩ - x ∎ agda-stdlib-0.12/src/Algebra/RingSolver/Natural-coefficients.agda000066400000000000000000000045001270451047000247070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver, using the natural numbers as the -- coefficient "ring" ------------------------------------------------------------------------ open import Algebra import Algebra.Operations open import Relation.Nullary module Algebra.RingSolver.Natural-coefficients {râ‚ râ‚‚} (R : CommutativeSemiring râ‚ râ‚‚) (dec : let open CommutativeSemiring R open Algebra.Operations semiring in ∀ m n → Dec (m × 1# ≈ n × 1#)) where import Algebra.RingSolver open import Algebra.RingSolver.AlmostCommutativeRing open import Data.Nat.Base as â„• open import Data.Product using (module Σ) open import Function import Relation.Binary.EqReasoning import Relation.Nullary.Decidable as Dec open CommutativeSemiring R open Algebra.Operations semiring open Relation.Binary.EqReasoning setoid private -- The coefficient "ring". â„•-ring : RawRing _ â„•-ring = record { Carrier = â„• ; _+_ = â„•._+_ ; _*_ = â„•._*_ ; -_ = id ; 0# = 0 ; 1# = 1 } -- There is a homomorphism from â„• to R. -- -- Note that _×′_ is used rather than _×_. If _×_ were used, then -- Function.Related.TypeIsomorphisms.test would fail to type-check. homomorphism : â„•-ring -Raw-AlmostCommutative⟶ fromCommutativeSemiring R homomorphism = record { ⟦_⟧ = λ n → n ×′ 1# ; +-homo = ×′-homo-+ 1# ; *-homo = ×′1-homo-* ; -‿homo = λ _ → refl ; 0-homo = refl ; 1-homo = refl } -- Equality of certain expressions can be decided. dec′ : ∀ m n → Dec (m ×′ 1# ≈ n ×′ 1#) dec′ m n = Dec.map′ to from (dec m n) where to : m × 1# ≈ n × 1# → m ×′ 1# ≈ n ×′ 1# to m≈n = begin m ×′ 1# ≈⟨ sym $ ×≈×′ m 1# ⟩ m × 1# ≈⟨ m≈n ⟩ n × 1# ≈⟨ ×≈×′ n 1# ⟩ n ×′ 1# ∎ from : m ×′ 1# ≈ n ×′ 1# → m × 1# ≈ n × 1# from m≈n = begin m × 1# ≈⟨ ×≈×′ m 1# ⟩ m ×′ 1# ≈⟨ m≈n ⟩ n ×′ 1# ≈⟨ sym $ ×≈×′ n 1# ⟩ n × 1# ∎ -- The instantiation. open Algebra.RingSolver _ _ homomorphism dec′ public agda-stdlib-0.12/src/Algebra/RingSolver/Simple.agda000066400000000000000000000012041270451047000220710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver with two copies of the same ring with -- decidable equality ------------------------------------------------------------------------ open import Algebra.RingSolver.AlmostCommutativeRing open import Relation.Binary module Algebra.RingSolver.Simple {râ‚ râ‚‚} (R : AlmostCommutativeRing râ‚ râ‚‚) (_≟_ : Decidable (AlmostCommutativeRing._≈_ R)) where open AlmostCommutativeRing R import Algebra.RingSolver as RS open RS rawRing R (-raw-almostCommutative⟶ R) _≟_ public agda-stdlib-0.12/src/Algebra/Structures.agda000066400000000000000000000341611270451047000207410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some algebraic structures (not packed up with sets, operations, -- etc.) ------------------------------------------------------------------------ open import Relation.Binary module Algebra.Structures where import Algebra.FunctionProperties as FunctionProperties open import Data.Product open import Function open import Level using (_⊔_) import Relation.Binary.EqReasoning as EqR open FunctionProperties using (Opâ‚; Opâ‚‚) ------------------------------------------------------------------------ -- One binary operation record IsSemigroup {a â„“} {A : Set a} (≈ : Rel A â„“) (∙ : Opâ‚‚ A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isEquivalence : IsEquivalence ≈ assoc : Associative ∙ ∙-cong : ∙ Preservesâ‚‚ ≈ ⟶ ≈ ⟶ ≈ open IsEquivalence isEquivalence public record IsMonoid {a â„“} {A : Set a} (≈ : Rel A â„“) (∙ : Opâ‚‚ A) (ε : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isSemigroup : IsSemigroup ≈ ∙ identity : Identity ε ∙ open IsSemigroup isSemigroup public record IsCommutativeMonoid {a â„“} {A : Set a} (≈ : Rel A â„“) (_∙_ : Opâ‚‚ A) (ε : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isSemigroup : IsSemigroup ≈ _∙_ identityË¡ : LeftIdentity ε _∙_ comm : Commutative _∙_ open IsSemigroup isSemigroup public identity : Identity ε _∙_ identity = (identityË¡ , identityʳ) where open EqR (record { isEquivalence = isEquivalence }) identityʳ : RightIdentity ε _∙_ identityʳ = λ x → begin (x ∙ ε) ≈⟨ comm x ε ⟩ (ε ∙ x) ≈⟨ identityË¡ x ⟩ x ∎ isMonoid : IsMonoid ≈ _∙_ ε isMonoid = record { isSemigroup = isSemigroup ; identity = identity } record IsGroup {a â„“} {A : Set a} (≈ : Rel A â„“) (_∙_ : Opâ‚‚ A) (ε : A) (_â»Â¹ : Opâ‚ A) : Set (a ⊔ â„“) where open FunctionProperties ≈ infixl 7 _-_ field isMonoid : IsMonoid ≈ _∙_ ε inverse : Inverse ε _â»Â¹ _∙_ â»Â¹-cong : _â»Â¹ Preserves ≈ ⟶ ≈ open IsMonoid isMonoid public _-_ : FunctionProperties.Opâ‚‚ A x - y = x ∙ (y â»Â¹) record IsAbelianGroup {a â„“} {A : Set a} (≈ : Rel A â„“) (∙ : Opâ‚‚ A) (ε : A) (â»Â¹ : Opâ‚ A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isGroup : IsGroup ≈ ∙ ε â»Â¹ comm : Commutative ∙ open IsGroup isGroup public isCommutativeMonoid : IsCommutativeMonoid ≈ ∙ ε isCommutativeMonoid = record { isSemigroup = isSemigroup ; identityË¡ = projâ‚ identity ; comm = comm } ------------------------------------------------------------------------ -- Two binary operations record IsNearSemiring {a â„“} {A : Set a} (≈ : Rel A â„“) (+ * : Opâ‚‚ A) (0# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field +-isMonoid : IsMonoid ≈ + 0# *-isSemigroup : IsSemigroup ≈ * distribʳ : * DistributesOverʳ + zeroË¡ : LeftZero 0# * open IsMonoid +-isMonoid public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ) open IsSemigroup *-isSemigroup public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ) record IsSemiringWithoutOne {a â„“} {A : Set a} (≈ : Rel A â„“) (+ * : Opâ‚‚ A) (0# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field +-isCommutativeMonoid : IsCommutativeMonoid ≈ + 0# *-isSemigroup : IsSemigroup ≈ * distrib : * DistributesOver + zero : Zero 0# * open IsCommutativeMonoid +-isCommutativeMonoid public hiding (identityË¡) renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ; isMonoid to +-isMonoid ; comm to +-comm ) open IsSemigroup *-isSemigroup public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ) isNearSemiring : IsNearSemiring ≈ + * 0# isNearSemiring = record { +-isMonoid = +-isMonoid ; *-isSemigroup = *-isSemigroup ; distribʳ = projâ‚‚ distrib ; zeroË¡ = projâ‚ zero } record IsSemiringWithoutAnnihilatingZero {a â„“} {A : Set a} (≈ : Rel A â„“) (+ * : Opâ‚‚ A) (0# 1# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field -- Note that these structures do have an additive unit, but this -- unit does not necessarily annihilate multiplication. +-isCommutativeMonoid : IsCommutativeMonoid ≈ + 0# *-isMonoid : IsMonoid ≈ * 1# distrib : * DistributesOver + open IsCommutativeMonoid +-isCommutativeMonoid public hiding (identityË¡) renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ; isMonoid to +-isMonoid ; comm to +-comm ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; isSemigroup to *-isSemigroup ; identity to *-identity ) record IsSemiring {a â„“} {A : Set a} (≈ : Rel A â„“) (+ * : Opâ‚‚ A) (0# 1# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero ≈ + * 0# 1# zero : Zero 0# * open IsSemiringWithoutAnnihilatingZero isSemiringWithoutAnnihilatingZero public isSemiringWithoutOne : IsSemiringWithoutOne ≈ + * 0# isSemiringWithoutOne = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isSemigroup = *-isSemigroup ; distrib = distrib ; zero = zero } open IsSemiringWithoutOne isSemiringWithoutOne public using (isNearSemiring) record IsCommutativeSemiringWithoutOne {a â„“} {A : Set a} (≈ : Rel A â„“) (+ * : Opâ‚‚ A) (0# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isSemiringWithoutOne : IsSemiringWithoutOne ≈ + * 0# *-comm : Commutative * open IsSemiringWithoutOne isSemiringWithoutOne public record IsCommutativeSemiring {a â„“} {A : Set a} (≈ : Rel A â„“) (_+_ _*_ : Opâ‚‚ A) (0# 1# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field +-isCommutativeMonoid : IsCommutativeMonoid ≈ _+_ 0# *-isCommutativeMonoid : IsCommutativeMonoid ≈ _*_ 1# distribʳ : _*_ DistributesOverʳ _+_ zeroË¡ : LeftZero 0# _*_ private module +-CM = IsCommutativeMonoid +-isCommutativeMonoid open module *-CM = IsCommutativeMonoid *-isCommutativeMonoid public using () renaming (comm to *-comm) open EqR (record { isEquivalence = +-CM.isEquivalence }) distrib : _*_ DistributesOver _+_ distrib = (distribË¡ , distribʳ) where distribË¡ : _*_ DistributesOverË¡ _+_ distribË¡ x y z = begin (x * (y + z)) ≈⟨ *-comm x (y + z) ⟩ ((y + z) * x) ≈⟨ distribʳ x y z ⟩ ((y * x) + (z * x)) ≈⟨ *-comm y x ⟨ +-CM.∙-cong ⟩ *-comm z x ⟩ ((x * y) + (x * z)) ∎ zero : Zero 0# _*_ zero = (zeroË¡ , zeroʳ) where zeroʳ : RightZero 0# _*_ zeroʳ x = begin (x * 0#) ≈⟨ *-comm x 0# ⟩ (0# * x) ≈⟨ zeroË¡ x ⟩ 0# ∎ isSemiring : IsSemiring ≈ _+_ _*_ 0# 1# isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-CM.isMonoid ; distrib = distrib } ; zero = zero } open IsSemiring isSemiring public hiding (distrib; zero; +-isCommutativeMonoid) isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne ≈ _+_ _*_ 0# isCommutativeSemiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne ; *-comm = *-CM.comm } record IsRing {a â„“} {A : Set a} (≈ : Rel A â„“) (_+_ _*_ : Opâ‚‚ A) (-_ : Opâ‚ A) (0# 1# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field +-isAbelianGroup : IsAbelianGroup ≈ _+_ 0# -_ *-isMonoid : IsMonoid ≈ _*_ 1# distrib : _*_ DistributesOver _+_ open IsAbelianGroup +-isAbelianGroup public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; isSemigroup to +-isSemigroup ; identity to +-identity ; isMonoid to +-isMonoid ; inverse to -‿inverse ; â»Â¹-cong to -‿cong ; isGroup to +-isGroup ; comm to +-comm ; isCommutativeMonoid to +-isCommutativeMonoid ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; isSemigroup to *-isSemigroup ; identity to *-identity ) zero : Zero 0# _*_ zero = (zeroË¡ , zeroʳ) where open EqR (record { isEquivalence = isEquivalence }) zeroË¡ : LeftZero 0# _*_ zeroË¡ x = begin (0# * x) ≈⟨ sym $ projâ‚‚ +-identity _ ⟩ ((0# * x) + 0#) ≈⟨ refl ⟨ +-cong ⟩ sym (projâ‚‚ -‿inverse _) ⟩ ((0# * x) + ((0# * x) + (- (0# * x)))) ≈⟨ sym $ +-assoc _ _ _ ⟩ (((0# * x) + (0# * x)) + (- (0# * x))) ≈⟨ sym (projâ‚‚ distrib _ _ _) ⟨ +-cong ⟩ refl ⟩ (((0# + 0#) * x) + (- (0# * x))) ≈⟨ (projâ‚‚ +-identity _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ ((0# * x) + (- (0# * x))) ≈⟨ projâ‚‚ -‿inverse _ ⟩ 0# ∎ zeroʳ : RightZero 0# _*_ zeroʳ x = begin (x * 0#) ≈⟨ sym $ projâ‚‚ +-identity _ ⟩ ((x * 0#) + 0#) ≈⟨ refl ⟨ +-cong ⟩ sym (projâ‚‚ -‿inverse _) ⟩ ((x * 0#) + ((x * 0#) + (- (x * 0#)))) ≈⟨ sym $ +-assoc _ _ _ ⟩ (((x * 0#) + (x * 0#)) + (- (x * 0#))) ≈⟨ sym (projâ‚ distrib _ _ _) ⟨ +-cong ⟩ refl ⟩ ((x * (0# + 0#)) + (- (x * 0#))) ≈⟨ (refl ⟨ *-cong ⟩ projâ‚‚ +-identity _) ⟨ +-cong ⟩ refl ⟩ ((x * 0#) + (- (x * 0#))) ≈⟨ projâ‚‚ -‿inverse _ ⟩ 0# ∎ isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero ≈ _+_ _*_ 0# 1# isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-isMonoid ; distrib = distrib } isSemiring : IsSemiring ≈ _+_ _*_ 0# 1# isSemiring = record { isSemiringWithoutAnnihilatingZero = isSemiringWithoutAnnihilatingZero ; zero = zero } open IsSemiring isSemiring public using (isNearSemiring; isSemiringWithoutOne) record IsCommutativeRing {a â„“} {A : Set a} (≈ : Rel A â„“) (+ * : Opâ‚‚ A) (- : Opâ‚ A) (0# 1# : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isRing : IsRing ≈ + * - 0# 1# *-comm : Commutative * open IsRing isRing public isCommutativeSemiring : IsCommutativeSemiring ≈ + * 0# 1# isCommutativeSemiring = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isCommutativeMonoid = record { isSemigroup = *-isSemigroup ; identityË¡ = projâ‚ *-identity ; comm = *-comm } ; distribʳ = projâ‚‚ distrib ; zeroË¡ = projâ‚ zero } open IsCommutativeSemiring isCommutativeSemiring public using ( *-isCommutativeMonoid ; isCommutativeSemiringWithoutOne ) record IsLattice {a â„“} {A : Set a} (≈ : Rel A â„“) (∨ ∧ : Opâ‚‚ A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isEquivalence : IsEquivalence ≈ ∨-comm : Commutative ∨ ∨-assoc : Associative ∨ ∨-cong : ∨ Preservesâ‚‚ ≈ ⟶ ≈ ⟶ ≈ ∧-comm : Commutative ∧ ∧-assoc : Associative ∧ ∧-cong : ∧ Preservesâ‚‚ ≈ ⟶ ≈ ⟶ ≈ absorptive : Absorptive ∨ ∧ open IsEquivalence isEquivalence public record IsDistributiveLattice {a â„“} {A : Set a} (≈ : Rel A â„“) (∨ ∧ : Opâ‚‚ A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isLattice : IsLattice ≈ ∨ ∧ ∨-∧-distribʳ : ∨ DistributesOverʳ ∧ open IsLattice isLattice public record IsBooleanAlgebra {a â„“} {A : Set a} (≈ : Rel A â„“) (∨ ∧ : Opâ‚‚ A) (¬ : Opâ‚ A) (⊤ ⊥ : A) : Set (a ⊔ â„“) where open FunctionProperties ≈ field isDistributiveLattice : IsDistributiveLattice ≈ ∨ ∧ ∨-complementʳ : RightInverse ⊤ ¬ ∨ ∧-complementʳ : RightInverse ⊥ ¬ ∧ ¬-cong : ¬ Preserves ≈ ⟶ ≈ open IsDistributiveLattice isDistributiveLattice public agda-stdlib-0.12/src/Category/000077500000000000000000000000001270451047000161535ustar00rootroot00000000000000agda-stdlib-0.12/src/Category/Applicative.agda000066400000000000000000000011721270451047000212330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. module Category.Applicative where open import Data.Unit open import Category.Applicative.Indexed RawApplicative : ∀ {f} → (Set f → Set f) → Set _ RawApplicative F = RawIApplicative {I = ⊤} (λ _ _ → F) module RawApplicative {f} {F : Set f → Set f} (app : RawApplicative F) where open RawIApplicative app public agda-stdlib-0.12/src/Category/Applicative/000077500000000000000000000000001270451047000204145ustar00rootroot00000000000000agda-stdlib-0.12/src/Category/Applicative/Indexed.agda000066400000000000000000000046711270451047000226220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. module Category.Applicative.Indexed where open import Category.Functor open import Data.Product open import Function open import Level open import Relation.Binary.PropositionalEquality as P using (_≡_) IFun : ∀ {i} → Set i → (â„“ : Level) → Set _ IFun I â„“ = I → I → Set â„“ → Set â„“ record RawIApplicative {i f} {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field pure : ∀ {i A} → A → F i i A _⊛_ : ∀ {i j k A B} → F i j (A → B) → F j k A → F i k B rawFunctor : ∀ {i j} → RawFunctor (F i j) rawFunctor = record { _<$>_ = λ g x → pure g ⊛ x } private open module RF {i j : I} = RawFunctor (rawFunctor {i = i} {j = j}) public _<⊛_ : ∀ {i j k A B} → F i j A → F j k B → F i k A x <⊛ y = const <$> x ⊛ y _⊛>_ : ∀ {i j k A B} → F i j A → F j k B → F i k B x ⊛> y = flip const <$> x ⊛ y _⊗_ : ∀ {i j k A B} → F i j A → F j k B → F i k (A × B) x ⊗ y = (_,_) <$> x ⊛ y zipWith : ∀ {i j k A B C} → (A → B → C) → F i j A → F j k B → F i k C zipWith f x y = f <$> x ⊛ y -- Applicative functor morphisms, specialised to propositional -- equality. record Morphism {i f} {I : Set i} {Fâ‚ Fâ‚‚ : IFun I f} (Aâ‚ : RawIApplicative Fâ‚) (Aâ‚‚ : RawIApplicative Fâ‚‚) : Set (i ⊔ suc f) where module Aâ‚ = RawIApplicative Aâ‚ module Aâ‚‚ = RawIApplicative Aâ‚‚ field op : ∀ {i j X} → Fâ‚ i j X → Fâ‚‚ i j X op-pure : ∀ {i X} (x : X) → op (Aâ‚.pure {i = i} x) ≡ Aâ‚‚.pure x op-⊛ : ∀ {i j k X Y} (f : Fâ‚ i j (X → Y)) (x : Fâ‚ j k X) → op (Aâ‚._⊛_ f x) ≡ Aâ‚‚._⊛_ (op f) (op x) op-<$> : ∀ {i j X Y} (f : X → Y) (x : Fâ‚ i j X) → op (Aâ‚._<$>_ f x) ≡ Aâ‚‚._<$>_ f (op x) op-<$> f x = begin op (Aâ‚._⊛_ (Aâ‚.pure f) x) ≡⟨ op-⊛ _ _ ⟩ Aâ‚‚._⊛_ (op (Aâ‚.pure f)) (op x) ≡⟨ P.congâ‚‚ Aâ‚‚._⊛_ (op-pure _) P.refl ⟩ Aâ‚‚._⊛_ (Aâ‚‚.pure f) (op x) ∎ where open P.≡-Reasoning agda-stdlib-0.12/src/Category/Applicative/Predicate.agda000066400000000000000000000026161270451047000231370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. module Category.Applicative.Predicate where open import Category.Functor.Predicate open import Data.Product open import Function open import Level open import Relation.Unary open import Relation.Unary.PredicateTransformer using (Pt) ------------------------------------------------------------------------ record RawPApplicative {i â„“} {I : Set i} (F : Pt I â„“) : Set (i ⊔ suc â„“) where infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field pure : ∀ {P} → P ⊆ F P _⊛_ : ∀ {P Q} → F (P ⇒ Q) ⊆ F P ⇒ F Q rawPFunctor : RawPFunctor F rawPFunctor = record { _<$>_ = λ g x → pure g ⊛ x } private open module RF = RawPFunctor rawPFunctor public _<⊛_ : ∀ {P Q} → F P ⊆ const (∀ {j} → F Q j) ⇒ F P x <⊛ y = const <$> x ⊛ y _⊛>_ : ∀ {P Q} → const (∀ {i} → F P i) ⊆ F Q ⇒ F Q x ⊛> y = flip const <$> x ⊛ y _⊗_ : ∀ {P Q} → F P ⊆ F Q ⇒ F (P ∩ Q) x ⊗ y = (_,_) <$> x ⊛ y zipWith : ∀ {P Q R} → (P ⊆ Q ⇒ R) → F P ⊆ F Q ⇒ F R zipWith f x y = f <$> x ⊛ y agda-stdlib-0.12/src/Category/Functor.agda000066400000000000000000000010441270451047000204100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. module Category.Functor where open import Function open import Level record RawFunctor {â„“} (F : Set â„“ → Set â„“) : Set (suc â„“) where infixl 4 _<$>_ _<$_ field _<$>_ : ∀ {A B} → (A → B) → F A → F B _<$_ : ∀ {A B} → A → F B → F A x <$ y = const x <$> y agda-stdlib-0.12/src/Category/Functor/000077500000000000000000000000001270451047000175735ustar00rootroot00000000000000agda-stdlib-0.12/src/Category/Functor/Predicate.agda000066400000000000000000000014331270451047000223120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. module Category.Functor.Predicate where open import Function open import Level open import Relation.Unary open import Relation.Unary.PredicateTransformer using (PT) record RawPFunctor {i j â„“â‚ â„“â‚‚} {I : Set i} {J : Set j} (F : PT I J â„“â‚ â„“â‚‚) : Set (i ⊔ j ⊔ suc ℓ₠⊔ suc â„“â‚‚) where infixl 4 _<$>_ _<$_ field _<$>_ : ∀ {P Q} → P ⊆ Q → F P ⊆ F Q _<$_ : ∀ {P Q} → (∀ {i} → P i) → F Q ⊆ F P x <$ y = const x <$> y agda-stdlib-0.12/src/Category/Monad.agda000066400000000000000000000020321270451047000200240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. module Category.Monad where open import Function open import Category.Monad.Indexed open import Data.Unit RawMonad : ∀ {f} → (Set f → Set f) → Set _ RawMonad M = RawIMonad {I = ⊤} (λ _ _ → M) RawMonadZero : ∀ {f} → (Set f → Set f) → Set _ RawMonadZero M = RawIMonadZero {I = ⊤} (λ _ _ → M) RawMonadPlus : ∀ {f} → (Set f → Set f) → Set _ RawMonadPlus M = RawIMonadPlus {I = ⊤} (λ _ _ → M) module RawMonad {f} {M : Set f → Set f} (Mon : RawMonad M) where open RawIMonad Mon public module RawMonadZero {f} {M : Set f → Set f} (Mon : RawMonadZero M) where open RawIMonadZero Mon public module RawMonadPlus {f} {M : Set f → Set f} (Mon : RawMonadPlus M) where open RawIMonadPlus Mon public agda-stdlib-0.12/src/Category/Monad/000077500000000000000000000000001270451047000172115ustar00rootroot00000000000000agda-stdlib-0.12/src/Category/Monad/Continuation.agda000066400000000000000000000041771270451047000225120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A delimited continuation monad ------------------------------------------------------------------------ module Category.Monad.Continuation where open import Category.Applicative open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Identity open import Category.Monad.Indexed open import Function open import Level ------------------------------------------------------------------------ -- Delimited continuation monads DContT : ∀ {i f} {I : Set i} → (I → Set f) → (Set f → Set f) → IFun I f DContT K M râ‚‚ râ‚ a = (a → M (K râ‚)) → M (K râ‚‚) DCont : ∀ {i f} {I : Set i} → (I → Set f) → IFun I f DCont K = DContT K Identity DContTIMonad : ∀ {i f} {I : Set i} (K : I → Set f) {M} → RawMonad M → RawIMonad (DContT K M) DContTIMonad K Mon = record { return = λ a k → k a ; _>>=_ = λ c f k → c (flip f k) } where open RawMonad Mon DContIMonad : ∀ {i f} {I : Set i} (K : I → Set f) → RawIMonad (DCont K) DContIMonad K = DContTIMonad K IdentityMonad ------------------------------------------------------------------------ -- Delimited continuation operations record RawIMonadDCont {i f} {I : Set i} (K : I → Set f) (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M reset : ∀ {râ‚ râ‚‚ r₃} → M râ‚ râ‚‚ (K râ‚‚) → M r₃ r₃ (K râ‚) shift : ∀ {a râ‚ râ‚‚ r₃ râ‚„} → ((a → M râ‚ râ‚ (K râ‚‚)) → M r₃ râ‚„ (K râ‚„)) → M r₃ râ‚‚ a open RawIMonad monad public DContTIMonadDCont : ∀ {i f} {I : Set i} (K : I → Set f) {M} → RawMonad M → RawIMonadDCont K (DContT K M) DContTIMonadDCont K Mon = record { monad = DContTIMonad K Mon ; reset = λ e k → e return >>= k ; shift = λ e k → e (λ a k' → (k a) >>= k') return } where open RawIMonad Mon DContIMonadDCont : ∀ {i f} {I : Set i} (K : I → Set f) → RawIMonadDCont K (DCont K) DContIMonadDCont K = DContTIMonadDCont K IdentityMonad agda-stdlib-0.12/src/Category/Monad/Identity.agda000066400000000000000000000007051270451047000216220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The identity monad ------------------------------------------------------------------------ module Category.Monad.Identity where open import Category.Monad Identity : ∀ {f} → Set f → Set f Identity A = A IdentityMonad : ∀ {f} → RawMonad (Identity {f}) IdentityMonad = record { return = λ x → x ; _>>=_ = λ x f → f x } agda-stdlib-0.12/src/Category/Monad/Indexed.agda000066400000000000000000000035061270451047000214130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. module Category.Monad.Indexed where open import Category.Applicative.Indexed open import Function open import Level record RawIMonad {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where infixl 1 _>>=_ _>>_ _>=>_ infixr 1 _=<<_ _<=<_ field return : ∀ {i A} → A → M i i A _>>=_ : ∀ {i j k A B} → M i j A → (A → M j k B) → M i k B _>>_ : ∀ {i j k A B} → M i j A → M j k B → M i k B mâ‚ >> mâ‚‚ = mâ‚ >>= λ _ → mâ‚‚ _=<<_ : ∀ {i j k A B} → (A → M j k B) → M i j A → M i k B f =<< c = c >>= f _>=>_ : ∀ {i j k a} {A : Set a} {B C} → (A → M i j B) → (B → M j k C) → (A → M i k C) f >=> g = _=<<_ g ∘ f _<=<_ : ∀ {i j k B C a} {A : Set a} → (B → M j k C) → (A → M i j B) → (A → M i k C) g <=< f = f >=> g join : ∀ {i j k A} → M i j (M j k A) → M i k A join m = m >>= id rawIApplicative : RawIApplicative M rawIApplicative = record { pure = return ; _⊛_ = λ f x → f >>= λ f' → x >>= λ x' → return (f' x') } open RawIApplicative rawIApplicative public record RawIMonadZero {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M ∅ : ∀ {i j A} → M i j A open RawIMonad monad public record RawIMonadPlus {i f} {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where infixr 3 _∣_ field monadZero : RawIMonadZero M _∣_ : ∀ {i j A} → M i j A → M i j A → M i j A open RawIMonadZero monadZero public agda-stdlib-0.12/src/Category/Monad/Partiality.agda000066400000000000000000001057341270451047000221630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The partiality monad ------------------------------------------------------------------------ module Category.Monad.Partiality where open import Coinduction open import Category.Monad open import Data.Bool.Base using (Bool; false; true) open import Data.Nat using (â„•; zero; suc; _+_) open import Data.Product as Prod hiding (map) open import Data.Sum hiding (map) open import Function open import Function.Equivalence using (_⇔_; equivalence) open import Level using (_⊔_) open import Relation.Binary as B hiding (Rel) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary open import Relation.Nullary.Decidable hiding (map) open import Relation.Nullary.Negation ------------------------------------------------------------------------ -- The partiality monad data _⊥ {a} (A : Set a) : Set a where now : (x : A) → A ⊥ later : (x : ∞ (A ⊥)) → A ⊥ monad : ∀ {f} → RawMonad {f = f} _⊥ monad = record { return = now ; _>>=_ = _>>=_ } where _>>=_ : ∀ {A B} → A ⊥ → (A → B ⊥) → B ⊥ now x >>= f = f x later x >>= f = later (♯ (â™­ x >>= f)) private module M {f} = RawMonad (monad {f}) -- Non-termination. never : ∀ {a} {A : Set a} → A ⊥ never = later (♯ never) -- run x for n steps peels off at most n "later" constructors from x. run_for_steps : ∀ {a} {A : Set a} → A ⊥ → â„• → A ⊥ run now x for n steps = now x run later x for zero steps = later x run later x for suc n steps = run â™­ x for n steps -- Is the computation done? isNow : ∀ {a} {A : Set a} → A ⊥ → Bool isNow (now x) = true isNow (later x) = false ------------------------------------------------------------------------ -- Kinds -- The partiality monad comes with two forms of equality (weak and -- strong) and one ordering. Strong equality is stronger than the -- ordering, which is stronger than weak equality. -- The three relations are defined using a single data type, indexed -- by a "kind". data OtherKind : Set where geq weak : OtherKind data Kind : Set where strong : Kind other : (k : OtherKind) → Kind -- Kind equality is decidable. infix 4 _≟-Kind_ _≟-Kind_ : Decidable (_≡_ {A = Kind}) _≟-Kind_ strong strong = yes P.refl _≟-Kind_ strong (other k) = no λ() _≟-Kind_ (other k) strong = no λ() _≟-Kind_ (other geq) (other geq) = yes P.refl _≟-Kind_ (other geq) (other weak) = no λ() _≟-Kind_ (other weak) (other geq) = no λ() _≟-Kind_ (other weak) (other weak) = yes P.refl -- A predicate which is satisfied only for equalities. Note that, for -- concrete inputs, this predicate evaluates to ⊤ or ⊥. Equality : Kind → Set Equality k = False (k ≟-Kind other geq) ------------------------------------------------------------------------ -- Equality/ordering module Equality {a â„“} {A : Set a} -- The "return type". (_∼_ : A → A → Set â„“) where -- The three relations. data Rel : Kind → A ⊥ → A ⊥ → Set (a ⊔ â„“) where now : ∀ {k x y} (x∼y : x ∼ y) → Rel k (now x) (now y) later : ∀ {k x y} (x∼y : ∞ (Rel k (â™­ x) (â™­ y))) → Rel k (later x) (later y) laterʳ : ∀ {x y} (x≈y : Rel (other weak) x (â™­ y) ) → Rel (other weak) x (later y) laterË¡ : ∀ {k x y} (x∼y : Rel (other k) (â™­ x) y ) → Rel (other k) (later x) y infix 4 _≅_ _≳_ _≲_ _≈_ _≅_ : A ⊥ → A ⊥ → Set _ _≅_ = Rel strong _≳_ : A ⊥ → A ⊥ → Set _ _≳_ = Rel (other geq) _≲_ : A ⊥ → A ⊥ → Set _ _≲_ = flip _≳_ _≈_ : A ⊥ → A ⊥ → Set _ _≈_ = Rel (other weak) -- x ⇓ y means that x terminates with y. infix 4 _⇓[_]_ _⇓_ _⇓[_]_ : A ⊥ → Kind → A → Set _ x ⇓[ k ] y = Rel k x (now y) _⇓_ : A ⊥ → A → Set _ x ⇓ y = x ⇓[ other weak ] y -- x ⇓ means that x terminates. infix 4 _⇓ _⇓ : A ⊥ → Set _ x ⇓ = ∃ λ v → x ⇓ v -- x ⇑ means that x does not terminate. infix 4 _⇑[_] _⇑ _⇑[_] : A ⊥ → Kind → Set _ x ⇑[ k ] = Rel k x never _⇑ : A ⊥ → Set _ x ⇑ = x ⇑[ other weak ] ------------------------------------------------------------------------ -- Lemmas relating the three relations module _ {a â„“} {A : Set a} {_∼_ : A → A → Set â„“} where open Equality _∼_ using (Rel; _≅_; _≳_; _≲_; _≈_; _⇓[_]_; _⇑[_]) open Equality.Rel -- All relations include strong equality. ≅⇒ : ∀ {k} {x y : A ⊥} → x ≅ y → Rel k x y ≅⇒ (now x∼y) = now x∼y ≅⇒ (later x≅y) = later (♯ ≅⇒ (â™­ x≅y)) -- The weak equality includes the ordering. ≳⇒ : ∀ {k} {x y : A ⊥} → x ≳ y → Rel (other k) x y ≳⇒ (now x∼y) = now x∼y ≳⇒ (later x≳y) = later (♯ ≳⇒ (â™­ x≳y)) ≳⇒ (laterË¡ x≳y) = laterË¡ (≳⇒ x≳y ) -- Weak equality includes the other relations. ⇒≈ : ∀ {k} {x y : A ⊥} → Rel k x y → x ≈ y ⇒≈ {strong} = ≅⇒ ⇒≈ {other geq} = ≳⇒ ⇒≈ {other weak} = id -- The relations agree for non-terminating computations. never⇒never : ∀ {kâ‚ kâ‚‚} {x : A ⊥} → Rel kâ‚ x never → Rel kâ‚‚ x never never⇒never (later x∼never) = later (♯ never⇒never (â™­ x∼never)) never⇒never (laterʳ x≈never) = never⇒never x≈never never⇒never (laterË¡ x∼never) = later (♯ never⇒never x∼never) -- The "other" relations agree when the right-hand side is a value. now⇒now : ∀ {kâ‚ kâ‚‚} {x} {y : A} → Rel (other kâ‚) x (now y) → Rel (other kâ‚‚) x (now y) now⇒now (now x∼y) = now x∼y now⇒now (laterË¡ x∼now) = laterË¡ (now⇒now x∼now) ------------------------------------------------------------------------ -- Later can be dropped laterʳâ»Â¹ : ∀ {k} {x : A ⊥} {y} → Rel (other k) x (later y) → Rel (other k) x (â™­ y) laterʳâ»Â¹ (later x∼y) = laterË¡ (â™­ x∼y) laterʳâ»Â¹ (laterʳ x≈y) = x≈y laterʳâ»Â¹ (laterË¡ x∼ly) = laterË¡ (laterʳâ»Â¹ x∼ly) laterË¡â»Â¹ : ∀ {x} {y : A ⊥} → later x ≈ y → â™­ x ≈ y laterË¡â»Â¹ (later x≈y) = laterʳ (â™­ x≈y) laterË¡â»Â¹ (laterʳ lx≈y) = laterʳ (laterË¡â»Â¹ lx≈y) laterË¡â»Â¹ (laterË¡ x≈y) = x≈y laterâ»Â¹ : ∀ {k} {x y : ∞ (A ⊥)} → Rel k (later x) (later y) → Rel k (â™­ x) (â™­ y) laterâ»Â¹ (later x∼y) = â™­ x∼y laterâ»Â¹ (laterʳ lx≈y) = laterË¡â»Â¹ lx≈y laterâ»Â¹ (laterË¡ x∼ly) = laterʳâ»Â¹ x∼ly ------------------------------------------------------------------------ -- The relations are equivalences or partial orders, given suitable -- assumptions about the underlying relation module Equivalence where -- Reflexivity. refl : Reflexive _∼_ → ∀ {k} → Reflexive (Rel k) refl refl-∼ {x = now v} = now refl-∼ refl refl-∼ {x = later x} = later (♯ refl refl-∼) -- Symmetry. sym : Symmetric _∼_ → ∀ {k} → Equality k → Symmetric (Rel k) sym sym-∼ eq (now x∼y) = now (sym-∼ x∼y) sym sym-∼ eq (later x∼y) = later (♯ sym sym-∼ eq (â™­ x∼y)) sym sym-∼ eq (laterʳ x≈y) = laterË¡ (sym sym-∼ eq x≈y ) sym sym-∼ eq (laterË¡ {weak} x≈y) = laterʳ (sym sym-∼ eq x≈y ) sym sym-∼ () (laterË¡ {geq} x≳y) -- Transitivity. private module Trans (trans-∼ : Transitive _∼_) where now-trans : ∀ {k x y} {v : A} → Rel k x y → Rel k y (now v) → Rel k x (now v) now-trans (now x∼y) (now y∼z) = now (trans-∼ x∼y y∼z) now-trans (laterË¡ x∼y) y∼z = laterË¡ (now-trans x∼y y∼z) now-trans x∼ly (laterË¡ y∼z) = now-trans (laterʳâ»Â¹ x∼ly) y∼z mutual later-trans : ∀ {k} {x y : A ⊥} {z} → Rel k x y → Rel k y (later z) → Rel k x (later z) later-trans (later x∼y) ly∼lz = later (♯ trans (â™­ x∼y) (laterâ»Â¹ ly∼lz)) later-trans (laterË¡ x∼y) y∼lz = later (♯ trans x∼y (laterʳâ»Â¹ y∼lz)) later-trans (laterʳ x≈y) ly≈lz = later-trans x≈y (laterË¡â»Â¹ ly≈lz) later-trans x≈y (laterʳ y≈z) = laterʳ ( trans x≈y y≈z ) trans : ∀ {k} {x y z : A ⊥} → Rel k x y → Rel k y z → Rel k x z trans {z = now v} x∼y y∼v = now-trans x∼y y∼v trans {z = later z} x∼y y∼lz = later-trans x∼y y∼lz open Trans public using (trans) -- All the relations are preorders. preorder : IsPreorder _≡_ _∼_ → Kind → Preorder _ _ _ preorder pre k = record { Carrier = A ⊥ ; _≈_ = _≡_ ; _∼_ = Rel k ; isPreorder = record { isEquivalence = P.isEquivalence ; reflexive = refl′ ; trans = Equivalence.trans (IsPreorder.trans pre) } } where refl′ : ∀ {k} {x y : A ⊥} → x ≡ y → Rel k x y refl′ P.refl = Equivalence.refl (IsPreorder.refl pre) private preorder′ : IsEquivalence _∼_ → Kind → Preorder _ _ _ preorder′ equiv = preorder (Setoid.isPreorder (record { isEquivalence = equiv })) -- The two equalities are equivalence relations. setoid : IsEquivalence _∼_ → (k : Kind) {eq : Equality k} → Setoid _ _ setoid equiv k {eq} = record { Carrier = A ⊥ ; _≈_ = Rel k ; isEquivalence = record { refl = Pre.refl ; sym = Equivalence.sym (IsEquivalence.sym equiv) eq ; trans = Pre.trans } } where module Pre = Preorder (preorder′ equiv k) -- The order is a partial order, with strong equality as the -- underlying equality. ≳-poset : IsEquivalence _∼_ → Poset _ _ _ ≳-poset equiv = record { Carrier = A ⊥ ; _≈_ = _≅_ ; _≤_ = _≳_ ; isPartialOrder = record { antisym = antisym ; isPreorder = record { isEquivalence = S.isEquivalence ; reflexive = ≅⇒ ; trans = Pre.trans } } } where module S = Setoid (setoid equiv strong) module Pre = Preorder (preorder′ equiv (other geq)) antisym : {x y : A ⊥} → x ≳ y → x ≲ y → x ≅ y antisym (now x∼y) (now _) = now x∼y antisym (later x≳y) (later x≲y) = later (♯ antisym (â™­ x≳y) (â™­ x≲y)) antisym (later x≳y) (laterË¡ x≲ly) = later (♯ antisym (â™­ x≳y) (laterʳâ»Â¹ x≲ly)) antisym (laterË¡ x≳ly) (later x≲y) = later (♯ antisym (laterʳâ»Â¹ x≳ly) (â™­ x≲y)) antisym (laterË¡ x≳ly) (laterË¡ x≲ly) = later (♯ antisym (laterʳâ»Â¹ x≳ly) (laterʳâ»Â¹ x≲ly)) -- Equational reasoning. module Reasoning (isEquivalence : IsEquivalence _∼_) where private module Pre {k} = Preorder (preorder′ isEquivalence k) module S {k eq} = Setoid (setoid isEquivalence k {eq}) infix 3 _∎ infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≈⟨_⟩_ _≡⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≡ y → Rel k y z → Rel k x z _ ≡⟨ P.refl ⟩ y∼z = y∼z _≅⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≅ y → Rel k y z → Rel k x z _ ≅⟨ x≅y ⟩ y∼z = Pre.trans (≅⇒ x≅y) y∼z _≳⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≳ y → Rel (other k) y z → Rel (other k) x z _ ≳⟨ x≳y ⟩ y∼z = Pre.trans (≳⇒ x≳y) y∼z _≈⟨_⟩_ : ∀ x {y z : A ⊥} → x ≈ y → y ≈ z → x ≈ z _ ≈⟨ x≈y ⟩ y≈z = Pre.trans x≈y y≈z sym : ∀ {k} {eq : Equality k} {x y : A ⊥} → Rel k x y → Rel k y x sym {eq = eq} = S.sym {eq = eq} _∎ : ∀ {k} (x : A ⊥) → Rel k x x x ∎ = Pre.refl ------------------------------------------------------------------------ -- Lemmas related to now and never -- Now is not never. now≉never : ∀ {k} {x : A} → ¬ Rel k (now x) never now≉never (laterʳ hyp) = now≉never hyp -- A partial value is either now or never (classically, when the -- underlying relation is reflexive). now-or-never : Reflexive _∼_ → ∀ {k} (x : A ⊥) → ¬ ¬ ((∃ λ y → x ⇓[ other k ] y) ⊎ x ⇑[ other k ]) now-or-never refl x = helper <$> excluded-middle where open RawMonad ¬¬-Monad not-now-is-never : (x : A ⊥) → (∄ λ y → x ≳ now y) → x ≳ never not-now-is-never (now x) hyp with hyp (, now refl) ... | () not-now-is-never (later x) hyp = later (♯ not-now-is-never (â™­ x) (hyp ∘ Prod.map id laterË¡)) helper : Dec (∃ λ y → x ≳ now y) → _ helper (yes ≳now) = injâ‚ $ Prod.map id ≳⇒ ≳now helper (no ≵now) = injâ‚‚ $ ≳⇒ $ not-now-is-never x ≵now ------------------------------------------------------------------------ -- Map-like results -- Map. map : ∀ {_∼′_ : A → A → Set a} {k} → _∼′_ ⇒ _∼_ → Equality.Rel _∼′_ k ⇒ Equality.Rel _∼_ k map ∼′⇒∼ (now x∼y) = now (∼′⇒∼ x∼y) map ∼′⇒∼ (later x∼y) = later (♯ map ∼′⇒∼ (â™­ x∼y)) map ∼′⇒∼ (laterʳ x≈y) = laterʳ (map ∼′⇒∼ x≈y) map ∼′⇒∼ (laterË¡ x∼y) = laterË¡ (map ∼′⇒∼ x∼y) -- If a statement can be proved using propositional equality as the -- underlying relation, then it can also be proved for any other -- reflexive underlying relation. ≡⇒ : Reflexive _∼_ → ∀ {k x y} → Equality.Rel _≡_ k x y → Rel k x y ≡⇒ refl-∼ = map (flip (P.subst (_∼_ _)) refl-∼) ------------------------------------------------------------------------ -- Steps -- The number of later constructors (steps) in the terminating -- computation x. steps : ∀ {k} {x : A ⊥} {y} → x ⇓[ k ] y → â„• steps (now _) = zero steps .{x = later x} (laterË¡ {x = x} x⇓) = suc (steps {x = â™­ x} x⇓) module Steps {trans-∼ : Transitive _∼_} where left-identity : ∀ {k x y} {z : A} (x≅y : x ≅ y) (y⇓z : y ⇓[ k ] z) → steps (Equivalence.trans trans-∼ (≅⇒ x≅y) y⇓z) ≡ steps y⇓z left-identity (now _) (now _) = P.refl left-identity (later x≅y) (laterË¡ y⇓z) = P.cong suc $ left-identity (â™­ x≅y) y⇓z right-identity : ∀ {k x} {y z : A} (x⇓y : x ⇓[ k ] y) (y≈z : now y ⇓[ k ] z) → steps (Equivalence.trans trans-∼ x⇓y y≈z) ≡ steps x⇓y right-identity (now x∼y) (now y∼z) = P.refl right-identity (laterË¡ x∼y) (now y∼z) = P.cong suc $ right-identity x∼y (now y∼z) ------------------------------------------------------------------------ -- Laws related to bind -- Never is a left and right "zero" of bind. left-zero : {B : Set a} (f : B → A ⊥) → let open M in (never >>= f) ≅ never left-zero f = later (♯ left-zero f) right-zero : ∀ {B} (x : B ⊥) → let open M in (x >>= λ _ → never) ≅ never right-zero (later x) = later (♯ right-zero (â™­ x)) right-zero (now x) = never≅never where never≅never : never ≅ never never≅never = later (♯ never≅never) -- Now is a left and right identity of bind (for a reflexive -- underlying relation). left-identity : Reflexive _∼_ → ∀ {B} (x : B) (f : B → A ⊥) → let open M in (now x >>= f) ≅ f x left-identity refl-∼ x f = Equivalence.refl refl-∼ right-identity : Reflexive _∼_ → (x : A ⊥) → let open M in (x >>= now) ≅ x right-identity refl (now x) = now refl right-identity refl (later x) = later (♯ right-identity refl (â™­ x)) -- Bind is associative (for a reflexive underlying relation). associative : Reflexive _∼_ → ∀ {B C} (x : C ⊥) (f : C → B ⊥) (g : B → A ⊥) → let open M in (x >>= f >>= g) ≅ (x >>= λ y → f y >>= g) associative refl-∼ (now x) f g = Equivalence.refl refl-∼ associative refl-∼ (later x) f g = later (♯ associative refl-∼ (â™­ x) f g) module _ {s â„“} {A B : Set s} {_∼A_ : A → A → Set â„“} {_∼B_ : B → B → Set â„“} where open Equality private open module EqA = Equality _∼A_ using () renaming (_⇓[_]_ to _⇓[_]A_; _⇑[_] to _⇑[_]A) open module EqB = Equality _∼B_ using () renaming (_⇓[_]_ to _⇓[_]B_; _⇑[_] to _⇑[_]B) -- Bind preserves all the relations. _>>=-cong_ : ∀ {k} {xâ‚ xâ‚‚ : A ⊥} {fâ‚ fâ‚‚ : A → B ⊥} → let open M in Rel _∼A_ k xâ‚ xâ‚‚ → (∀ {xâ‚ xâ‚‚} → x₠∼A xâ‚‚ → Rel _∼B_ k (fâ‚ xâ‚) (fâ‚‚ xâ‚‚)) → Rel _∼B_ k (xâ‚ >>= fâ‚) (xâ‚‚ >>= fâ‚‚) now xâ‚∼xâ‚‚ >>=-cong fâ‚∼fâ‚‚ = fâ‚∼fâ‚‚ xâ‚∼xâ‚‚ later xâ‚∼xâ‚‚ >>=-cong fâ‚∼fâ‚‚ = later (♯ (â™­ xâ‚∼xâ‚‚ >>=-cong fâ‚∼fâ‚‚)) laterʳ xâ‚≈xâ‚‚ >>=-cong fâ‚≈fâ‚‚ = laterʳ (xâ‚≈xâ‚‚ >>=-cong fâ‚≈fâ‚‚) laterË¡ xâ‚∼xâ‚‚ >>=-cong fâ‚∼fâ‚‚ = laterË¡ (xâ‚∼xâ‚‚ >>=-cong fâ‚∼fâ‚‚) -- Inversion lemmas for bind. >>=-inversion-⇓ : Reflexive _∼A_ → ∀ {k} x {f : A → B ⊥} {y} → let open M in (x>>=f⇓ : (x >>= f) ⇓[ k ]B y) → ∃ λ z → ∃₂ λ (x⇓ : x ⇓[ k ]A z) (fz⇓ : f z ⇓[ k ]B y) → steps x⇓ + steps fz⇓ ≡ steps x>>=f⇓ >>=-inversion-⇓ refl (now x) fx⇓ = (x , now refl , fx⇓ , P.refl) >>=-inversion-⇓ refl (later x) (laterË¡ x>>=f⇓) = Prod.map id (Prod.map laterË¡ (Prod.map id (P.cong suc))) $ >>=-inversion-⇓ refl (â™­ x) x>>=f⇓ >>=-inversion-⇑ : IsEquivalence _∼A_ → ∀ {k} x {f : A → B ⊥} → let open M in Rel _∼B_ (other k) (x >>= f) never → ¬ ¬ (x ⇑[ other k ]A ⊎ ∃ λ y → x ⇓[ other k ]A y × f y ⇑[ other k ]B) >>=-inversion-⇑ eqA {k} x {f} ∼never = helper <$> now-or-never IsEqA.refl x where open RawMonad ¬¬-Monad using (_<$>_) open M using (_>>=_) open Reasoning eqA module IsEqA = IsEquivalence eqA k≳ = other geq is-never : ∀ {x y} → x ⇓[ k≳ ]A y → (x >>= f) ⇑[ k≳ ]B → ∃ λ z → (y ∼A z) × f z ⇑[ k≳ ]B is-never (now x∼y) = λ fx⇑ → (_ , IsEqA.sym x∼y , fx⇑) is-never (laterË¡ ≳now) = is-never ≳now ∘ laterâ»Â¹ helper : (∃ λ y → x ⇓[ k≳ ]A y) ⊎ x ⇑[ k≳ ]A → x ⇑[ other k ]A ⊎ ∃ λ y → x ⇓[ other k ]A y × f y ⇑[ other k ]B helper (injâ‚‚ ≳never) = injâ‚ (≳⇒ ≳never) helper (injâ‚ (y , ≳now)) with is-never ≳now (never⇒never ∼never) ... | (z , y∼z , fz⇑) = injâ‚‚ (z , ≳⇒ (x ≳⟨ ≳now ⟩ now y ≅⟨ now y∼z ⟩ now z ∎) , ≳⇒ fz⇑) module _ {â„“} {A B : Set â„“} {_∼_ : B → B → Set â„“} where open Equality -- A variant of _>>=-cong_. _≡->>=-cong_ : ∀ {k} {xâ‚ xâ‚‚ : A ⊥} {fâ‚ fâ‚‚ : A → B ⊥} → let open M in Rel _≡_ k xâ‚ xâ‚‚ → (∀ x → Rel _∼_ k (fâ‚ x) (fâ‚‚ x)) → Rel _∼_ k (xâ‚ >>= fâ‚) (xâ‚‚ >>= fâ‚‚) _≡->>=-cong_ {k} {fâ‚ = fâ‚} {fâ‚‚} xâ‚≈xâ‚‚ fâ‚≈fâ‚‚ = xâ‚≈xâ‚‚ >>=-cong λ {x} x≡x′ → P.subst (λ y → Rel _∼_ k (fâ‚ x) (fâ‚‚ y)) x≡x′ (fâ‚≈fâ‚‚ x) ------------------------------------------------------------------------ -- Productivity checker workaround -- The monad can be awkward to use, due to the limitations of guarded -- coinduction. The following code provides a (limited) workaround. module Workaround {a} where infixl 1 _>>=_ data _⊥P : Set a → Set (Level.suc a) where now : ∀ {A} (x : A) → A ⊥P later : ∀ {A} (x : ∞ (A ⊥P)) → A ⊥P _>>=_ : ∀ {A B} (x : A ⊥P) (f : A → B ⊥P) → B ⊥P private data _⊥W : Set a → Set (Level.suc a) where now : ∀ {A} (x : A) → A ⊥W later : ∀ {A} (x : A ⊥P) → A ⊥W mutual _>>=W_ : ∀ {A B} → A ⊥W → (A → B ⊥P) → B ⊥W now x >>=W f = whnf (f x) later x >>=W f = later (x >>= f) whnf : ∀ {A} → A ⊥P → A ⊥W whnf (now x) = now x whnf (later x) = later (â™­ x) whnf (x >>= f) = whnf x >>=W f mutual private ⟦_⟧W : ∀ {A} → A ⊥W → A ⊥ ⟦ now x ⟧W = now x ⟦ later x ⟧W = later (♯ ⟦ x ⟧P) ⟦_⟧P : ∀ {A} → A ⊥P → A ⊥ ⟦ x ⟧P = ⟦ whnf x ⟧W -- The definitions above make sense. ⟦_⟧P is homomorphic with -- respect to now, later and _>>=_. module Correct where private open module Eq {A : Set a} = Equality {A = A} _≡_ open module R {A : Set a} = Reasoning (P.isEquivalence {A = A}) now-hom : ∀ {A} (x : A) → ⟦ now x ⟧P ≅ now x now-hom x = now x ∎ later-hom : ∀ {A} (x : ∞ (A ⊥P)) → ⟦ later x ⟧P ≅ later (♯ ⟦ â™­ x ⟧P) later-hom x = later (♯ (⟦ â™­ x ⟧P ∎)) mutual private >>=-homW : ∀ {A B} (x : B ⊥W) (f : B → A ⊥P) → ⟦ x >>=W f ⟧W ≅ M._>>=_ ⟦ x ⟧W (λ y → ⟦ f y ⟧P) >>=-homW (now x) f = ⟦ f x ⟧P ∎ >>=-homW (later x) f = later (♯ >>=-hom x f) >>=-hom : ∀ {A B} (x : B ⊥P) (f : B → A ⊥P) → ⟦ x >>= f ⟧P ≅ M._>>=_ ⟦ x ⟧P (λ y → ⟦ f y ⟧P) >>=-hom x f = >>=-homW (whnf x) f ------------------------------------------------------------------------ -- An alternative, but equivalent, formulation of equality/ordering module AlternativeEquality {a â„“} where private El : Setoid a â„“ → Set _ El = Setoid.Carrier Eq : ∀ S → B.Rel (El S) _ Eq = Setoid._≈_ open Equality using (Rel) open Equality.Rel infix 4 _∣_≅P_ _∣_≳P_ _∣_≈P_ infix 3 _∎ infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≳⟨_⟩≅_ _≳⟨_⟩≈_ _≈⟨_⟩≅_ _≈⟨_⟩≲_ infixl 1 _>>=_ mutual -- Proof "programs". _∣_≅P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≅P_ = flip RelP strong _∣_≳P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≳P_ = flip RelP (other geq) _∣_≈P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≈P_ = flip RelP (other weak) data RelP S : Kind → B.Rel (El S ⊥) (Level.suc (a ⊔ â„“)) where -- Congruences. now : ∀ {k x y} (xRy : x ⟨ Eq S ⟩ y) → RelP S k (now x) (now y) later : ∀ {k x y} (x∼y : ∞ (RelP S k (â™­ x) (â™­ y))) → RelP S k (later x) (later y) _>>=_ : ∀ {S′ : Setoid a â„“} {k} {xâ‚ xâ‚‚} {fâ‚ fâ‚‚ : El S′ → El S ⊥} → let open M in (xâ‚∼xâ‚‚ : RelP S′ k xâ‚ xâ‚‚) (fâ‚∼fâ‚‚ : ∀ {x y} → x ⟨ Eq S′ ⟩ y → RelP S k (fâ‚ x) (fâ‚‚ y)) → RelP S k (xâ‚ >>= fâ‚) (xâ‚‚ >>= fâ‚‚) -- Ordering/weak equality. laterʳ : ∀ {x y} (x≈y : RelP S (other weak) x (â™­ y)) → RelP S (other weak) x (later y) laterË¡ : ∀ {k x y} (x∼y : RelP S (other k) (â™­ x) y) → RelP S (other k) (later x) y -- Equational reasoning. Note that including full transitivity -- for weak equality would make _∣_≈P_ trivial; a similar -- problem applies to _∣_≳P_ (A ∣ never ≳P now x would be -- provable). Instead the definition of RelP includes limited -- notions of transitivity, similar to weak bisimulation up-to -- various things. _∎ : ∀ {k} x → RelP S k x x sym : ∀ {k x y} {eq : Equality k} (x∼y : RelP S k x y) → RelP S k y x _≡⟨_⟩_ : ∀ {k} x {y z} (x≡y : x ≡ y) (y∼z : RelP S k y z) → RelP S k x z _≅⟨_⟩_ : ∀ {k} x {y z} (x≅y : S ∣ x ≅P y) (y∼z : RelP S k y z) → RelP S k x z _≳⟨_⟩_ : let open Equality (Eq S) in ∀ x {y z} (x≳y : x ≳ y) (y≳z : S ∣ y ≳P z) → S ∣ x ≳P z _≳⟨_⟩≅_ : ∀ x {y z} (x≳y : S ∣ x ≳P y) (y≅z : S ∣ y ≅P z) → S ∣ x ≳P z _≳⟨_⟩≈_ : ∀ x {y z} (x≳y : S ∣ x ≳P y) (y≈z : S ∣ y ≈P z) → S ∣ x ≈P z _≈⟨_⟩≅_ : ∀ x {y z} (x≈y : S ∣ x ≈P y) (y≅z : S ∣ y ≅P z) → S ∣ x ≈P z _≈⟨_⟩≲_ : ∀ x {y z} (x≈y : S ∣ x ≈P y) (y≲z : S ∣ z ≳P y) → S ∣ x ≈P z -- If any of the following transitivity-like rules were added to -- RelP, then RelP and Rel would no longer be equivalent: -- -- x ≳P y → y ≳P z → x ≳P z -- x ≳P y → y ≳ z → x ≳P z -- x ≲P y → y ≈P z → x ≈P z -- x ≈P y → y ≳P z → x ≈P z -- x ≲ y → y ≈P z → x ≈P z -- x ≈P y → y ≳ z → x ≈P z -- x ≈P y → y ≈P z → x ≈P z -- x ≈P y → y ≈ z → x ≈P z -- x ≈ y → y ≈P z → x ≈P z -- -- The reason is that any of these rules would make it possible -- to derive that never and now x are related. -- RelP is complete with respect to Rel. complete : ∀ {S k} {x y : El S ⊥} → Equality.Rel (Eq S) k x y → RelP S k x y complete (now xRy) = now xRy complete (later x∼y) = later (♯ complete (â™­ x∼y)) complete (laterʳ x≈y) = laterʳ (complete x≈y) complete (laterË¡ x∼y) = laterË¡ (complete x∼y) -- RelP is sound with respect to Rel. private -- Proof WHNFs. data RelW S : Kind → B.Rel (El S ⊥) (Level.suc (a ⊔ â„“)) where now : ∀ {k x y} (xRy : x ⟨ Eq S ⟩ y) → RelW S k (now x) (now y) later : ∀ {k x y} (x∼y : RelP S k (â™­ x) (â™­ y)) → RelW S k (later x) (later y) laterʳ : ∀ {x y} (x≈y : RelW S (other weak) x (â™­ y)) → RelW S (other weak) x (later y) laterË¡ : ∀ {k x y} (x∼y : RelW S (other k) (â™­ x) y) → RelW S (other k) (later x) y -- WHNFs can be turned into programs. program : ∀ {S k x y} → RelW S k x y → RelP S k x y program (now xRy) = now xRy program (later x∼y) = later (♯ x∼y) program (laterË¡ x∼y) = laterË¡ (program x∼y) program (laterʳ x≈y) = laterʳ (program x≈y) -- Lemmas for WHNFs. _>>=W_ : ∀ {A B k xâ‚ xâ‚‚} {fâ‚ fâ‚‚ : El A → El B ⊥} → RelW A k xâ‚ xâ‚‚ → (∀ {x y} → x ⟨ Eq A ⟩ y → RelW B k (fâ‚ x) (fâ‚‚ y)) → RelW B k (M._>>=_ xâ‚ fâ‚) (M._>>=_ xâ‚‚ fâ‚‚) now xRy >>=W fâ‚∼fâ‚‚ = fâ‚∼fâ‚‚ xRy later x∼y >>=W fâ‚∼fâ‚‚ = later (x∼y >>= program ∘ fâ‚∼fâ‚‚) laterʳ x≈y >>=W fâ‚≈fâ‚‚ = laterʳ (x≈y >>=W fâ‚≈fâ‚‚) laterË¡ x∼y >>=W fâ‚∼fâ‚‚ = laterË¡ (x∼y >>=W fâ‚∼fâ‚‚) reflW : ∀ {S k} x → RelW S k x x reflW {S} (now x) = now (Setoid.refl S) reflW (later x) = later (â™­ x ∎) symW : ∀ {S k x y} → Equality k → RelW S k x y → RelW S k y x symW {S} eq (now xRy) = now (Setoid.sym S xRy) symW eq (later x≈y) = later (sym {eq = eq} x≈y) symW eq (laterʳ x≈y) = laterË¡ (symW eq x≈y) symW eq (laterË¡ {weak} x≈y) = laterʳ (symW eq x≈y) symW () (laterË¡ {geq} x≈y) trans≅W : ∀ {S x y z} → RelW S strong x y → RelW S strong y z → RelW S strong x z trans≅W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≅W (later x≅y) (later y≅z) = later (_ ≅⟨ x≅y ⟩ y≅z) trans≳-W : ∀ {S x y z} → let open Equality (Eq S) in x ≳ y → RelW S (other geq) y z → RelW S (other geq) x z trans≳-W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≳-W (later x≳y) (later y≳z) = later (_ ≳⟨ â™­ x≳y ⟩ y≳z) trans≳-W (later x≳y) (laterË¡ y≳z) = laterË¡ (trans≳-W (â™­ x≳y) y≳z) trans≳-W (laterË¡ x≳y) y≳z = laterË¡ (trans≳-W x≳y y≳z) -- Strong equality programs can be turned into WHNFs. whnf≅ : ∀ {S x y} → S ∣ x ≅P y → RelW S strong x y whnf≅ (now xRy) = now xRy whnf≅ (later x≅y) = later (â™­ x≅y) whnf≅ (xâ‚≅xâ‚‚ >>= fâ‚≅fâ‚‚) = whnf≅ xâ‚≅xâ‚‚ >>=W λ xRy → whnf≅ (fâ‚≅fâ‚‚ xRy) whnf≅ (x ∎) = reflW x whnf≅ (sym x≅y) = symW _ (whnf≅ x≅y) whnf≅ (x ≡⟨ P.refl ⟩ y≅z) = whnf≅ y≅z whnf≅ (x ≅⟨ x≅y ⟩ y≅z) = trans≅W (whnf≅ x≅y) (whnf≅ y≅z) -- More transitivity lemmas. _⟨_⟩≅_ : ∀ {S k} x {y z} → RelP S k x y → S ∣ y ≅P z → RelP S k x z _⟨_⟩≅_ {k = strong} x x≅y y≅z = x ≅⟨ x≅y ⟩ y≅z _⟨_⟩≅_ {k = other geq} x x≳y y≅z = x ≳⟨ x≳y ⟩≅ y≅z _⟨_⟩≅_ {k = other weak} x x≈y y≅z = x ≈⟨ x≈y ⟩≅ y≅z trans∼≅W : ∀ {S k x y z} → RelW S k x y → RelW S strong y z → RelW S k x z trans∼≅W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans∼≅W (later x∼y) (later y≅z) = later (_ ⟨ x∼y ⟩≅ y≅z) trans∼≅W (laterʳ x≈y) (later y≅z) = laterʳ (trans∼≅W x≈y (whnf≅ y≅z)) trans∼≅W (laterË¡ x∼y) y≅z = laterË¡ (trans∼≅W x∼y y≅z) trans≅∼W : ∀ {S k x y z} → RelW S strong x y → RelW S k y z → RelW S k x z trans≅∼W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≅∼W (later x≅y) (later y∼z) = later (_ ≅⟨ x≅y ⟩ y∼z) trans≅∼W (later x≅y) (laterË¡ y∼z) = laterË¡ (trans≅∼W (whnf≅ x≅y) y∼z) trans≅∼W x≅y (laterʳ ly≈z) = laterʳ (trans≅∼W x≅y ly≈z) -- Order programs can be turned into WHNFs. whnf≳ : ∀ {S x y} → S ∣ x ≳P y → RelW S (other geq) x y whnf≳ (now xRy) = now xRy whnf≳ (later x∼y) = later (â™­ x∼y) whnf≳ (laterË¡ x≲y) = laterË¡ (whnf≳ x≲y) whnf≳ (xâ‚∼xâ‚‚ >>= fâ‚∼fâ‚‚) = whnf≳ xâ‚∼xâ‚‚ >>=W λ xRy → whnf≳ (fâ‚∼fâ‚‚ xRy) whnf≳ (x ∎) = reflW x whnf≳ (sym {eq = ()} x≅y) whnf≳ (x ≡⟨ P.refl ⟩ y≳z) = whnf≳ y≳z whnf≳ (x ≅⟨ x≅y ⟩ y≳z) = trans≅∼W (whnf≅ x≅y) (whnf≳ y≳z) whnf≳ (x ≳⟨ x≳y ⟩ y≳z) = trans≳-W x≳y (whnf≳ y≳z) whnf≳ (x ≳⟨ x≳y ⟩≅ y≅z) = trans∼≅W (whnf≳ x≳y) (whnf≅ y≅z) -- Another transitivity lemma. trans≳≈W : ∀ {S x y z} → RelW S (other geq) x y → RelW S (other weak) y z → RelW S (other weak) x z trans≳≈W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≳≈W (later x≳y) (later y≈z) = later (_ ≳⟨ x≳y ⟩≈ y≈z) trans≳≈W (laterË¡ x≳y) y≈z = laterË¡ (trans≳≈W x≳y y≈z) trans≳≈W x≳y (laterʳ y≈z) = laterʳ (trans≳≈W x≳y y≈z) trans≳≈W (later x≳y) (laterË¡ y≈z) = laterË¡ (trans≳≈W (whnf≳ x≳y) y≈z) -- All programs can be turned into WHNFs. whnf : ∀ {S k x y} → RelP S k x y → RelW S k x y whnf (now xRy) = now xRy whnf (later x∼y) = later (â™­ x∼y) whnf (laterʳ x≈y) = laterʳ (whnf x≈y) whnf (laterË¡ x∼y) = laterË¡ (whnf x∼y) whnf (xâ‚∼xâ‚‚ >>= fâ‚∼fâ‚‚) = whnf xâ‚∼xâ‚‚ >>=W λ xRy → whnf (fâ‚∼fâ‚‚ xRy) whnf (x ∎) = reflW x whnf (sym {eq = eq} x≈y) = symW eq (whnf x≈y) whnf (x ≡⟨ P.refl ⟩ y∼z) = whnf y∼z whnf (x ≅⟨ x≅y ⟩ y∼z) = trans≅∼W (whnf x≅y) (whnf y∼z) whnf (x ≳⟨ x≳y ⟩ y≳z) = trans≳-W x≳y (whnf y≳z) whnf (x ≳⟨ x≳y ⟩≅ y≅z) = trans∼≅W (whnf x≳y) (whnf y≅z) whnf (x ≳⟨ x≳y ⟩≈ y≈z) = trans≳≈W (whnf x≳y) (whnf y≈z) whnf (x ≈⟨ x≈y ⟩≅ y≅z) = trans∼≅W (whnf x≈y) (whnf y≅z) whnf (x ≈⟨ x≈y ⟩≲ y≲z) = symW _ (trans≳≈W (whnf y≲z) (symW _ (whnf x≈y))) mutual -- Soundness. private soundW : ∀ {S k x y} → RelW S k x y → Rel (Eq S) k x y soundW (now xRy) = now xRy soundW (later x∼y) = later (♯ sound x∼y) soundW (laterʳ x≈y) = laterʳ (soundW x≈y) soundW (laterË¡ x∼y) = laterË¡ (soundW x∼y) sound : ∀ {S k x y} → RelP S k x y → Rel (Eq S) k x y sound x∼y = soundW (whnf x∼y) -- RelP and Rel are equivalent (when the underlying relation is an -- equivalence). correct : ∀ {S k x y} → RelP S k x y ⇔ Rel (Eq S) k x y correct = equivalence sound complete ------------------------------------------------------------------------ -- Another lemma -- Bind is "idempotent". idempotent : ∀ {â„“} {A : Set â„“} (B : Setoid â„“ â„“) → let open M; open Setoid B using (_≈_; Carrier); open Equality _≈_ in (x : A ⊥) (f : A → A → Carrier ⊥) → (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳ (x >>= λ y′ → f y′ y′) idempotent {A = A} B x f = sound (idem x) where open AlternativeEquality hiding (_>>=_) open M open Equality.Rel using (laterË¡) open Equivalence using (refl) idem : (x : A ⊥) → B ∣ (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳P (x >>= λ y′ → f y′ y′) idem (now x) = f x x ∎ idem (later x) = later (♯ ( (â™­ x >>= λ y′ → later x >>= λ y″ → f y′ y″) ≳⟨ (refl P.refl {x = â™­ x} ≡->>=-cong λ _ → laterË¡ (refl (Setoid.refl B))) ⟩ (â™­ x >>= λ y′ → â™­ x >>= λ y″ → f y′ y″) ≳⟨ idem (â™­ x) ⟩≅ (â™­ x >>= λ y′ → f y′ y′) ∎)) ------------------------------------------------------------------------ -- Example private module Example where open Data.Nat open Workaround -- McCarthy's f91: f91′ : â„• → â„• ⊥P f91′ n with n ≤? 100 ... | yes _ = later (♯ (f91′ (11 + n) >>= f91′)) ... | no _ = now (n ∸ 10) f91 : â„• → â„• ⊥ f91 n = ⟦ f91′ n ⟧P agda-stdlib-0.12/src/Category/Monad/Partiality/000077500000000000000000000000001270451047000213335ustar00rootroot00000000000000agda-stdlib-0.12/src/Category/Monad/Partiality/All.agda000066400000000000000000000144451270451047000226710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An All predicate for the partiality monad ------------------------------------------------------------------------ module Category.Monad.Partiality.All where open import Category.Monad open import Category.Monad.Partiality as Partiality using (_⊥; ⇒≈) open import Coinduction open import Function open import Level open import Relation.Binary using (_Respects_; IsEquivalence) open import Relation.Binary.PropositionalEquality as P using (_≡_) open Partiality._⊥ open Partiality.Equality using (Rel) open Partiality.Equality.Rel private open module E {a} {A : Set a} = Partiality.Equality (_≡_ {A = A}) using (_≅_; _≳_) open module M {f} = RawMonad (Partiality.monad {f = f}) using (_>>=_) ------------------------------------------------------------------------ -- All, along with some lemmas -- All P x means that if x terminates with the value v, then P v -- holds. data All {a p} {A : Set a} (P : A → Set p) : A ⊥ → Set (a ⊔ p) where now : ∀ {v} (p : P v) → All P (now v) later : ∀ {x} (p : ∞ (All P (â™­ x))) → All P (later x) -- Bind preserves All in the following way: _>>=-cong_ : ∀ {â„“ p q} {A B : Set â„“} {P : A → Set p} {Q : B → Set q} {x : A ⊥} {f : A → B ⊥} → All P x → (∀ {x} → P x → All Q (f x)) → All Q (x >>= f) now p >>=-cong f = f p later p >>=-cong f = later (♯ (â™­ p >>=-cong f)) -- All respects all the relations, given that the predicate respects -- the underlying relation. respects : ∀ {k a p â„“} {A : Set a} {P : A → Set p} {_∼_ : A → A → Set â„“} → P Respects _∼_ → All P Respects Rel _∼_ k respects resp (now x∼y) (now p) = now (resp x∼y p) respects resp (later x∼y) (later p) = later (♯ respects resp (â™­ x∼y) (â™­ p)) respects resp (laterË¡ x∼y) (later p) = respects resp x∼y (â™­ p) respects resp (laterʳ x≈y) p = later (♯ respects resp x≈y p) respects-flip : ∀ {k a p â„“} {A : Set a} {P : A → Set p} {_∼_ : A → A → Set â„“} → P Respects flip _∼_ → All P Respects flip (Rel _∼_ k) respects-flip resp (now x∼y) (now p) = now (resp x∼y p) respects-flip resp (later x∼y) (later p) = later (♯ respects-flip resp (â™­ x∼y) (â™­ p)) respects-flip resp (laterË¡ x∼y) p = later (♯ respects-flip resp x∼y p) respects-flip resp (laterʳ x≈y) (later p) = respects-flip resp x≈y (â™­ p) -- "Equational" reasoning. module Reasoning {a p â„“} {A : Set a} {P : A → Set p} {_∼_ : A → A → Set â„“} (resp : P Respects flip _∼_) where infix 3 finally infixr 2 _≡⟨_⟩_ _∼⟨_⟩_ _≡⟨_⟩_ : ∀ x {y} → x ≡ y → All P y → All P x _ ≡⟨ P.refl ⟩ p = p _∼⟨_⟩_ : ∀ {k} x {y} → Rel _∼_ k x y → All P y → All P x _ ∼⟨ x∼y ⟩ p = respects-flip resp (⇒≈ x∼y) p -- A cosmetic combinator. finally : (x : A ⊥) → All P x → All P x finally _ p = p syntax finally x p = x ⟨ p ⟩ -- "Equational" reasoning with _∼_ instantiated to propositional -- equality. module Reasoning-≡ {a p} {A : Set a} {P : A → Set p} = Reasoning {P = P} {_∼_ = _≡_} (P.subst P ∘ P.sym) ------------------------------------------------------------------------ -- An alternative, but equivalent, formulation of All module Alternative {a p : Level} where infix 3 _⟨_⟩P infixr 2 _≅⟨_⟩P_ _≳⟨_⟩P_ -- All "programs". data AllP {A : Set a} (P : A → Set p) : A ⊥ → Set (suc (a ⊔ p)) where now : ∀ {x} (p : P x) → AllP P (now x) later : ∀ {x} (p : ∞ (AllP P (â™­ x))) → AllP P (later x) _>>=-congP_ : ∀ {B : Set a} {Q : B → Set p} {x f} (p-x : AllP Q x) (p-f : ∀ {v} → Q v → AllP P (f v)) → AllP P (x >>= f) _≅⟨_⟩P_ : ∀ x {y} (x≅y : x ≅ y) (p : AllP P y) → AllP P x _≳⟨_⟩P_ : ∀ x {y} (x≳y : x ≳ y) (p : AllP P y) → AllP P x _⟨_⟩P : ∀ x (p : AllP P x) → AllP P x private -- WHNFs. data AllW {A} (P : A → Set p) : A ⊥ → Set (suc (a ⊔ p)) where now : ∀ {x} (p : P x) → AllW P (now x) later : ∀ {x} (p : AllP P (â™­ x)) → AllW P (later x) -- A function which turns WHNFs into programs. program : ∀ {A} {P : A → Set p} {x} → AllW P x → AllP P x program (now p) = now p program (later p) = later (♯ p) -- Functions which turn programs into WHNFs. trans-≅ : ∀ {A} {P : A → Set p} {x y : A ⊥} → x ≅ y → AllW P y → AllW P x trans-≅ (now P.refl) (now p) = now p trans-≅ (later x≅y) (later p) = later (_ ≅⟨ â™­ x≅y ⟩P p) trans-≳ : ∀ {A} {P : A → Set p} {x y : A ⊥} → x ≳ y → AllW P y → AllW P x trans-≳ (now P.refl) (now p) = now p trans-≳ (later x≳y) (later p) = later (_ ≳⟨ â™­ x≳y ⟩P p) trans-≳ (laterË¡ x≳y) p = later (_ ≳⟨ x≳y ⟩P program p) mutual _>>=-congW_ : ∀ {A B} {P : A → Set p} {Q : B → Set p} {x f} → AllW P x → (∀ {v} → P v → AllP Q (f v)) → AllW Q (x >>= f) now p >>=-congW p-f = whnf (p-f p) later p >>=-congW p-f = later (p >>=-congP p-f) whnf : ∀ {A} {P : A → Set p} {x} → AllP P x → AllW P x whnf (now p) = now p whnf (later p) = later (â™­ p) whnf (p-x >>=-congP p-f) = whnf p-x >>=-congW p-f whnf (_ ≅⟨ x≅y ⟩P p) = trans-≅ x≅y (whnf p) whnf (_ ≳⟨ x≳y ⟩P p) = trans-≳ x≳y (whnf p) whnf (_ ⟨ p ⟩P) = whnf p -- AllP P is sound and complete with respect to All P. sound : ∀ {A} {P : A → Set p} {x} → AllP P x → All P x sound = λ p → soundW (whnf p) where soundW : ∀ {A} {P : A → Set p} {x} → AllW P x → All P x soundW (now p) = now p soundW (later p) = later (♯ sound p) complete : ∀ {A} {P : A → Set p} {x} → All P x → AllP P x complete (now p) = now p complete (later p) = later (♯ complete (â™­ p)) agda-stdlib-0.12/src/Category/Monad/Predicate.agda000066400000000000000000000035461270451047000217370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. module Category.Monad.Predicate where open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Indexed open import Data.Unit open import Data.Product open import Function open import Level open import Relation.Binary.PropositionalEquality open import Relation.Unary open import Relation.Unary.PredicateTransformer using (Pt) ------------------------------------------------------------------------ record RawPMonad {i â„“} {I : Set i} (M : Pt I (i ⊔ â„“)) : Set (suc i ⊔ suc â„“) where infixl 1 _?>=_ _?>_ _>?>_ infixr 1 _==_ : ∀ {P Q} → M P ⊆ const (P ⊆ M Q) ⇒ M Q m ?>= f = f ==′_ : ∀ {P Q} → M P ⊆ const (∀ j → {_ : P j} → j ∈ M Q) ⇒ M Q m ?>=′ f = m ?>= λ {j} p → f j {p} _?>_ : ∀ {P Q} → M P ⊆ const (∀ {j} → j ∈ M Q) ⇒ M Q mâ‚ ?> mâ‚‚ = mâ‚ ?>= λ _ → mâ‚‚ join? : ∀ {P} → M (M P) ⊆ M P join? m = m ?>= id _>?>_ : {P Q R : _} → P ⊆ M Q → Q ⊆ M R → P ⊆ M R f >?> g = _=?> g -- ``Angelic'' operations (the player knows the state). rawIMonad : RawIMonad (λ i j A → i ∈ M (const A ∩ ï½› j ï½)) rawIMonad = record { return = λ x → return? (x , refl) ; _>>=_ = λ m k → m ?>= λ { {._} (x , refl) → k x } } open RawIMonad rawIMonad public agda-stdlib-0.12/src/Category/Monad/State.agda000066400000000000000000000077651270451047000211260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The state monad ------------------------------------------------------------------------ module Category.Monad.State where open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Identity open import Category.Monad.Indexed open import Data.Product open import Data.Unit open import Function open import Level ------------------------------------------------------------------------ -- Indexed state monads IStateT : ∀ {i f} {I : Set i} → (I → Set f) → (Set f → Set f) → IFun I f IStateT S M i j A = S i → M (A × S j) StateTIMonad : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonad M → RawIMonad (IStateT S M) StateTIMonad S Mon = record { return = λ x s → return (x , s) ; _>>=_ = λ m f s → m s >>= uncurry f } where open RawMonad Mon StateTIMonadZero : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonadZero M → RawIMonadZero (IStateT S M) StateTIMonadZero S Mon = record { monad = StateTIMonad S (RawMonadZero.monad Mon) ; ∅ = const ∅ } where open RawMonadZero Mon StateTIMonadPlus : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonadPlus M → RawIMonadPlus (IStateT S M) StateTIMonadPlus S Mon = record { monadZero = StateTIMonadZero S (RawIMonadPlus.monadZero Mon) ; _∣_ = λ mâ‚ mâ‚‚ s → mâ‚ s ∣ mâ‚‚ s } where open RawMonadPlus Mon ------------------------------------------------------------------------ -- State monad operations record RawIMonadState {i f} {I : Set i} (S : I → Set f) (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M get : ∀ {i} → M i i (S i) put : ∀ {i j} → S j → M i j (Lift ⊤) open RawIMonad monad public modify : ∀ {i j} → (S i → S j) → M i j (Lift ⊤) modify f = get >>= put ∘ f StateTIMonadState : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonad M → RawIMonadState S (IStateT S M) StateTIMonadState S Mon = record { monad = StateTIMonad S Mon ; get = λ s → return (s , s) ; put = λ s _ → return (_ , s) } where open RawIMonad Mon ------------------------------------------------------------------------ -- Ordinary state monads RawMonadState : ∀ {f} → Set f → (Set f → Set f) → Set _ RawMonadState S M = RawIMonadState {I = ⊤} (λ _ → S) (λ _ _ → M) module RawMonadState {f} {S : Set f} {M : Set f → Set f} (Mon : RawMonadState S M) where open RawIMonadState Mon public StateT : ∀ {f} → Set f → (Set f → Set f) → Set f → Set f StateT S M = IStateT {I = ⊤} (λ _ → S) M _ _ StateTMonad : ∀ {f} (S : Set f) {M} → RawMonad M → RawMonad (StateT S M) StateTMonad S = StateTIMonad (λ _ → S) StateTMonadZero : ∀ {f} (S : Set f) {M} → RawMonadZero M → RawMonadZero (StateT S M) StateTMonadZero S = StateTIMonadZero (λ _ → S) StateTMonadPlus : ∀ {f} (S : Set f) {M} → RawMonadPlus M → RawMonadPlus (StateT S M) StateTMonadPlus S = StateTIMonadPlus (λ _ → S) StateTMonadState : ∀ {f} (S : Set f) {M} → RawMonad M → RawMonadState S (StateT S M) StateTMonadState S = StateTIMonadState (λ _ → S) State : ∀ {f} → Set f → Set f → Set f State S = StateT S Identity StateMonad : ∀ {f} (S : Set f) → RawMonad (State S) StateMonad S = StateTMonad S IdentityMonad StateMonadState : ∀ {f} (S : Set f) → RawMonadState S (State S) StateMonadState S = StateTMonadState S IdentityMonad LiftMonadState : ∀ {f Sâ‚} (Sâ‚‚ : Set f) {M} → RawMonadState Sâ‚ M → RawMonadState Sâ‚ (StateT Sâ‚‚ M) LiftMonadState Sâ‚‚ Mon = record { monad = StateTIMonad (λ _ → Sâ‚‚) monad ; get = λ s → get >>= λ x → return (x , s) ; put = λ s′ s → put s′ >> return (_ , s) } where open RawIMonadState Mon agda-stdlib-0.12/src/Coinduction.agda000066400000000000000000000024241270451047000174740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic types related to coinduction ------------------------------------------------------------------------ module Coinduction where open import Agda.Builtin.Coinduction public ------------------------------------------------------------------------ -- Rec, a type which is analogous to the Rec type constructor used in -- ΠΣ (see Altenkirch, Danielsson, Löh and Oury. ΠΣ: Dependent Types -- without the Sugar. FLOPS 2010, LNCS 6009.) data Rec {a} (A : ∞ (Set a)) : Set a where fold : (x : â™­ A) → Rec A unfold : ∀ {a} {A : ∞ (Set a)} → Rec A → â™­ A unfold (fold x) = x {- -- If --guardedness-preserving-type-constructors is enabled one can -- define types like â„• by recursion: open import Data.Sum open import Data.Unit â„• : Set â„• = ⊤ ⊎ Rec (♯ â„•) zero : â„• zero = injâ‚ _ suc : â„• → â„• suc n = injâ‚‚ (fold n) â„•-rec : (P : â„• → Set) → P zero → (∀ n → P n → P (suc n)) → ∀ n → P n â„•-rec P z s (injâ‚ _) = z â„•-rec P z s (injâ‚‚ (fold n)) = s n (â„•-rec P z s n) -- This feature is very experimental, though: it may lead to -- inconsistencies. -} agda-stdlib-0.12/src/Data/000077500000000000000000000000001270451047000152475ustar00rootroot00000000000000agda-stdlib-0.12/src/Data/AVL.agda000066400000000000000000000375521270451047000165230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- AVL trees ------------------------------------------------------------------------ -- AVL trees are balanced binary search trees. -- The search tree invariant is specified using the technique -- described by Conor McBride in his talk "Pivotal pragmatism". open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) module Data.AVL {k v â„“} {Key : Set k} (Value : Key → Set v) {_<_ : Rel Key â„“} (isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_) where open import Data.Bool.Base using (Bool) import Data.DifferenceList as DiffList open import Data.Empty open import Data.List.Base as List using (List) open import Data.Maybe.Base hiding (map) open import Data.Nat.Base hiding (_<_; _⊔_; compare) open import Data.Product hiding (map) open import Data.Unit open import Function open import Level using (_⊔_; Lift; lift) open IsStrictTotalOrder isStrictTotalOrder ------------------------------------------------------------------------ -- Extended keys module Extended-key where -- The key type extended with a new minimum and maximum. data Key⺠: Set k where ⊥⺠⊤⺠: Key⺠[_] : (k : Key) → Key⺠-- An extended strict ordering relation. infix 4 _<âº_ _<âº_ : Key⺠→ Key⺠→ Set â„“ ⊥⺠<⺠[ _ ] = Lift ⊤ ⊥⺠<⺠⊤⺠= Lift ⊤ [ x ] <⺠[ y ] = x < y [ _ ] <⺠⊤⺠= Lift ⊤ _ <⺠_ = Lift ⊥ -- A pair of ordering constraints. infix 4 _<_<_ _<_<_ : Key⺠→ Key → Key⺠→ Set â„“ l < x < u = l <⺠[ x ] × [ x ] <⺠u -- _<âº_ is transitive. trans⺠: ∀ l {m u} → l <⺠m → m <⺠u → l <⺠u trans⺠[ l ] {m = [ m ]} {u = [ u ]} l _ _ k′ _ _ _ = joinʳ⻠_ p lp (delete k pu) bal ... | tri≈ _ _ _ = join lp pu bal -- Looks up a key. Logarithmic in the size of the tree (assuming -- constant-time comparisons). lookup : ∀ {l u h} → (k : Key) → Tree l u h → Maybe (Value k) lookup k (leaf _) = nothing lookup k (node (k′ , v) lk′ k′u _) with compare k k′ ... | tri< _ _ _ = lookup k lk′ ... | tri> _ _ _ = lookup k k′u ... | tri≈ _ eq _ rewrite eq = just v -- Maps a function over all values in the tree. map : (∀ {k} → Value k → Value k) → ∀ {l u h} → Tree l u h → Tree l u h map f (leaf l