packages feed

agda2hs 1.3 → 1.4

raw patch · 210 files changed

+6859/−6135 lines, 210 filesdep ~Agdadep ~basedep ~containers

Dependency ranges changed: Agda, base, containers, filepath

Files

CHANGELOG.md view
@@ -1,36 +1,43 @@-Release notes for agda2hs v1.3+Release notes for agda2hs v1.4 ==============================  Changes -------  Changes to agda2hs:-- Increased Agda base version to 2.7-- Increased bounds to support GHC 9.8.4 and GHC 9.10.2-- Re-implemented the canonicity check for instances to be simpler but more robust-- Added {-# COMPILE AGDA2HS ... inline #-} pragma for marking definitions to be inlined during compilation to Haskell-- Added {-# COMPILE AGDA2HS ... tuple #-} pragma for compiling record types in Agda to a tuple type in Haskell-- Non-erased implicit arguments and instance arguments are now compiled to regular arguments in Haskell-- Non-erased module parameters are now compiled to regular arguments in Haskell-- Rank-N Haskell types are now supported-- Added `agda2hs locate` command printing the path to the agda2hs prelude `.agda-lib` file+- Increased Agda base version to 2.8.+- Increased bounds to support GHC 9.12.2.+- agda2hs will now skip compilation of files that are up-to-date.+- Added support for multi-parameter type classes.+- Added support for quantified constraints.+- Agda record types that compile to a Haskell data type are now+  required to have the `no-eta-equality` directive.+- agda2hs will now assume that any modules under the `Haskell.`+  namespace are part of the trusted FFI with Haskell.+  Concretely, no code will be generated for these modules and+  the `Haskell.` prefix will be dropped from the module name.  Additions to the agda2hs Prelude:-- New module `Haskell.Extra.Dec` for working with decidability proofs (compiled to `Bool`)-- New module `Haskell.Extra.Refinement` for working with refinement types (compiled to the base type)-- New module `Haskell.Extra.Erase` for working with erased types (compiled to `()`)-- New module `Haskell.Extra.Sigma` for working with dependent pair types (compiled to tuples)-- New module `Haskell.Extra.Loop` providing a safe `loop` function (using an erased fuel argument)-- New module `Haskell.Extra.Delay` providing a `Delay` monad for non-termination (compiled to pure functions in Haskell)-- New function `the` in `Haskell.Prim` for generating Haskell type annotations-- Added properties to `Haskell.Law.Equality`: `subst`, `subst0`-- Added properties to `Haskell.Law.Bool`: `ifFlip`, `ifTrueEqThen`, `ifFalseEqThen`-- Added properties to `Haskell.Law.List`: `map-concatMap`, `map-<*>-recomp`, `concatMap-++-distr`-- Added proofs that many of the instances defined in the prelude are lawful+- The builtin sort `Set` has been renamed to `Type` in the agda2hs Prelude+- The `Rezz` type defined in `Haskell.Extra.Erase` has been renamed to `Singleton`.+- The bindings to the Haskell `base` library are now located under `lib/base`+  to allow for adding bindings to other Haskell libraries.+- Added new module `Haskell.Control.Exception` with the `assert` function+  which can be used to assert any decidable property, with the decidability+  proof being compiled to a boolean check in Haskell.+- Added new module `Haskell.Data.Maybe` with `fromMaybe` and other functions.+- Added new module `Haskell.Data.List` with functions `nub`, `deleteAll`, and `sort`+  together with some of their properties.+- Added new modules `Haskell.Data.Map` and `Haskell.Data.Set` from the+  `containers` package, together with a number of their properties.+  These libraries are part of the new `containers` package located in `lib/containers`.+- Added properties of boolean values and operations under `Haskell.Law.Bool`.+- Added laws for the `Num` type class and its instances under `Haskell.Law.Num`. -See https://github.com/agda/agda2hs/issues?q=milestone%3A1.3+is%3Apr for the full list of changes. +See https://github.com/agda/agda2hs/issues?q=milestone%3A1.4+is%3Apr for the full list of changes.+ Fixed issues ------------ -See https://github.com/agda/agda2hs/issues?q=milestone%3A1.3+is%3Aissue for the full list of fixed issues.+See https://github.com/agda/agda2hs/issues?q=milestone%3A1.4+is%3Aissue for the full list of fixed issues.
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2024 Ulf Norell, Jesper Cockx, Orestis Melkonian, Sára Juhošová, James Chapman, Lucas Escot, Henry Blanchette, Viktor Csimma, Aleksander Wolska, Paul Bittner, Andreas Källberg, Bohdan Liesnikov, and Jakob Naucke.+Copyright 2025 Ulf Norell, Jesper Cockx, Orestis Melkonian, Sára Juhošová, James Chapman, Lucas Escot, Henry Blanchette, Viktor Csimma, Aleksander Wolska, Paul Bittner, Andreas Källberg, Bohdan Liesnikov, Jakob Naucke, and Heinrich Apfelmus.  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:
− agda2hs.agda-lib 
@@ -1,4 +0,0 @@-name: agda2hs-depend:-include: lib-flags: -W noUnsupportedIndexedMatch --erasure
agda2hs.cabal view
@@ -1,11 +1,11 @@ cabal-version:       2.4 name:                agda2hs-version:             1.3+version:             1.4 license:             BSD-3-Clause license-file:        LICENSE-author:              Ulf Norell, Jesper Cockx, Orestis Melkonian, Sára Juhošová, James Chapman, Lucas Escot, Henry Blanchette, Viktor Csimma, Aleksander Wolska, Paul Bittner, Andreas Källberg, Bohdan Liesnikov, and Jakob Naucke+author:              Ulf Norell, Jesper Cockx, Orestis Melkonian, Sára Juhošová, James Chapman, Lucas Escot, Henry Blanchette, Viktor Csimma, Aleksander Wolska, Paul Bittner, Andreas Källberg, Bohdan Liesnikov, Jakob Naucke, and Heinrich Apfelmus maintainer:          jesper@sikanda.be-copyright:           2024 Ulf Norell, Jesper Cockx, Orestis Melkonian, Sára Juhošová, James Chapman, Lucas Escot, Henry Blanchette, Viktor Csimma, Aleksander Wolska, Paul Bittner, Andreas Källberg, Bohdan Liesnikov, and Jakob Naucke+copyright:           2025 Ulf Norell, Jesper Cockx, Orestis Melkonian, Sára Juhošová, James Chapman, Lucas Escot, Henry Blanchette, Viktor Csimma, Aleksander Wolska, Paul Bittner, Andreas Källberg, Bohdan Liesnikov, Jakob Naucke, and Heinrich Apfelmus category:            Language, Compiler build-type:          Simple synopsis:            Compiling Agda code to readable Haskell.@@ -18,8 +18,9 @@ extra-doc-files:    CHANGELOG.md                     README.md -data-files: agda2hs.agda-lib-            lib/**/*.agda+data-files:+    lib/base/base.agda-lib+    lib/base/**/*.agda  source-repository head   type:     git@@ -44,23 +45,25 @@                        Agda2Hs.Compile.Utils,                        Agda2Hs.Compile.Var,                        Agda2Hs.Config,-                       Agda2Hs.HsUtils,+                       Agda2Hs.Language.Haskell,+                       Agda2Hs.Language.Haskell.Pretty,+                       Agda2Hs.Language.Haskell.Utils,                        Agda2Hs.Pragma,                        Agda2Hs.Render,                        AgdaInternals,                        Paths_agda2hs   autogen-modules:     Paths_agda2hs-  build-depends:       base                 >= 4.13    && < 4.21,-                       Agda                 >= 2.7.0   && < 2.8.0,+  build-depends:       base                 >= 4.13    && < 4.22,+                       Agda                 >= 2.8.0   && < 2.9.0,                        bytestring           >= 0.11.5  && < 0.13,-                       containers           >= 0.6     && < 0.8,+                       containers           >= 0.6     && < 0.9,                        unordered-containers >= 0.2.19  && < 0.3,                        mtl                 (>= 2.2     && < 2.3)                                         || (>= 2.3.1   && < 2.4),                        transformers         >= 0.6     && < 0.7,                        monad-control        >= 1.0     && < 1.1,                        directory            >= 1.2.6.2 && < 1.4,-                       filepath             >= 1.4.1.0 && < 1.5,+                       filepath             >= 1.4.1.0 && < 1.6,                        haskell-src-exts     >= 1.23    && < 1.25,                        syb                  >= 0.7.2   && < 0.8,                        text                 >= 2.0.2   && < 2.2,@@ -78,4 +81,5 @@                        NamedFieldPuns                        PatternSynonyms                        NondecreasingIndentation+                       OverloadedStrings   ghc-options:         -rtsopts
− lib/Haskell/Control/Monad.agda 
@@ -1,11 +0,0 @@-module Haskell.Control.Monad where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.Monad-open import Haskell.Prim.String-open import Haskell.Extra.Erase--guard : {{ MonadFail m }} → (b : Bool) → m (Erase (b ≡ True))-guard True = return (Erased refl)-guard False = fail "Guard was not True"
− lib/Haskell/Extra/Dec.agda 
@@ -1,48 +0,0 @@-module Haskell.Extra.Dec where--open import Haskell.Prelude-open import Haskell.Extra.Refinement-open import Agda.Primitive--private variable-  ℓ : Level-  P : Set--@0 Reflects : Set ℓ → Bool → Set ℓ-Reflects P True  = P-Reflects P False = P → ⊥--of : {b : Bool} → if b then P else (P → ⊥) → Reflects P b-of {b = False} np = np-of {b = True}  p  = p--invert : ∀ {b} → Reflects P b → if b then P else (P → ⊥)-invert {b = False} np = np-invert {b = True}  p  = p--extractTrue : ∀ { b } → ⦃ true : b ≡ True ⦄ → Reflects P b → P-extractTrue {b = True} p = p--extractFalse : ∀ { b } → ⦃ true : b ≡ False ⦄ → Reflects P b → (P → ⊥)-extractFalse {b = False} np = np--mapReflects : ∀ {cond} → (a → b) → (b → a)-            → Reflects a cond → Reflects b cond-mapReflects {cond = False} f g x = x ∘ g-mapReflects {cond = True}  f g x = f x--Dec : ∀ {ℓ} → @0 Set ℓ → Set ℓ-Dec P = ∃ Bool (Reflects P)-{-# COMPILE AGDA2HS Dec inline #-}--mapDec : {@0 a b : Set}-       → @0 (a → b)-       → @0 (b → a)-       → Dec a → Dec b-mapDec f g (True  ⟨ x ⟩) = True  ⟨ f x   ⟩-mapDec f g (False ⟨ h ⟩) = False ⟨ h ∘ g ⟩-{-# COMPILE AGDA2HS mapDec transparent #-}--ifDec : Dec a → (@0 {{a}} → b) → (@0 {{a → ⊥}} → b) → b-ifDec (b ⟨ p ⟩) x y = if b then (λ where {{refl}} → x {{p}}) else (λ where {{refl}} → y {{p}})-{-# COMPILE AGDA2HS ifDec inline #-}
− lib/Haskell/Extra/Delay.agda 
@@ -1,39 +0,0 @@-{-# OPTIONS --sized-types #-}--module Haskell.Extra.Delay where--open import Agda.Builtin.Size public--open import Haskell.Prelude-open import Haskell.Prim.Thunk-open import Haskell.Extra.Refinement--private variable-  x y z : a-  @0 i : Size--data Delay (a : Set) (@0 i : Size) : Set where-  now : a → Delay a i-  later : Thunk (Delay a) i → Delay a i--data HasResult (x : a) : Delay a i → Set where-  now   : HasResult x (now x)-  later : HasResult x (y .force) → HasResult x (later y)--runDelay : {@0 x : a} (y : Delay a ∞) → @0 HasResult x y → a-runDelay (now x) now = x-runDelay (later y) (later p) = runDelay (y .force) p--runDelaySound : {@0 x : a} (y : Delay a ∞) → (@0 hr : HasResult x y) → runDelay y hr ≡ x-runDelaySound (now x) now = refl-runDelaySound (later y) (later hr) = runDelaySound (y .force) hr---- tryDelay and unDelay cannot and should not be compiled to Haskell,--- so they are marked as erased.-@0 tryDelay : (y : Delay a ∞) → Nat → Maybe (∃ a (λ x → HasResult x y))-tryDelay (now x)   _       = Just (x ⟨ now ⟩)-tryDelay (later y) zero    = Nothing-tryDelay (later y) (suc n) = fmap (mapRefine later) (tryDelay (y .force) n)--@0 unDelay : (y : Delay a ∞) (n : Nat) → @0 {IsJust (tryDelay y n)} → a-unDelay y n {p} = fromJust (tryDelay y n) {p} .value
− lib/Haskell/Extra/Erase.agda 
@@ -1,82 +0,0 @@-module Haskell.Extra.Erase where--  open import Agda.Primitive-  open import Agda.Builtin.Sigma-  open import Agda.Builtin.Equality--  open import Haskell.Prim-  open import Haskell.Prim.List-  open import Haskell.Extra.Refinement-  open import Haskell.Law.Equality--  private variable-    @0 x y : a-    @0 xs  : List a--  record Erase (@0 a : Set ℓ) : Set ℓ where-    instance constructor iErased-    field @0 {{get}} : a-  open Erase public-  {-# COMPILE AGDA2HS Erase tuple #-}--  pattern Erased x = iErased {{x}}--  infixr 4 ⟨_⟩_-  record Σ0 (@0 a : Set) (b : @0 a → Set) : Set where-    constructor ⟨_⟩_-    field-      @0 proj₁ : a-      proj₂ : b proj₁-  open Σ0 public-  {-# COMPILE AGDA2HS Σ0 unboxed #-}--  pattern <_> x = record { proj₁ = _ ; proj₂ = x }--  -- Resurrection of erased values-  Rezz : (@0 x : a) → Set-  Rezz x = ∃ _ (x ≡_)--  {-# COMPILE AGDA2HS Rezz inline #-}--  pattern rezz x = x ⟨ refl ⟩--  instance-    rezz-id : {x : a} → Rezz x-    rezz-id = rezz _-  {-# COMPILE AGDA2HS rezz-id inline #-}--  rezzCong : {@0 a : Set} {@0 x : a} (f : a → b) → Rezz x → Rezz (f x)-  rezzCong f (x ⟨ p ⟩) = f x ⟨ cong f p ⟩-  {-# COMPILE AGDA2HS rezzCong inline #-}--  rezzCong2 : (f : a → b → c) → Rezz x → Rezz y → Rezz (f x y)-  rezzCong2 f (x ⟨ p ⟩) (y ⟨ q ⟩) = f x y ⟨ cong₂ f p q ⟩-  {-# COMPILE AGDA2HS rezzCong2 inline #-}--  rezzHead : Rezz (x ∷ xs) → Rezz x-  rezzHead {x = x} (ys ⟨ p ⟩) =-    head ys-    ⟨ subst (λ ys → ⦃ @0 _ : NonEmpty ys ⦄ → x ≡ head ys)-            p refl ⟩-    where instance @0 ne : NonEmpty ys-                   ne = subst NonEmpty p itsNonEmpty-  {-# COMPILE AGDA2HS rezzHead inline #-}--  rezzTail : Rezz (x ∷ xs) → Rezz xs-  rezzTail {xs = xs} (ys ⟨ p ⟩) =-    tail ys-    ⟨ subst (λ ys → ⦃ @0 _ : NonEmpty ys ⦄ → xs ≡ tail ys)-            p refl ⟩-    where instance @0 ne : NonEmpty ys-                   ne = subst NonEmpty p itsNonEmpty-  {-# COMPILE AGDA2HS rezzTail inline #-}--  rezzErase : {@0 a : Set} {@0 x : a} → Rezz (Erased x)-  rezzErase {x = x} = Erased x ⟨ refl ⟩-  {-# COMPILE AGDA2HS rezzErase inline #-}--  erase-injective : Erased x ≡ Erased y → x ≡ y-  erase-injective refl = refl--  inspect_by_ : (x : a) → (Rezz x → b) → b-  inspect x by f = f (rezz x)
− lib/Haskell/Extra/Loop.agda 
@@ -1,26 +0,0 @@--open import Haskell.Prelude--module Haskell.Extra.Loop where--data Fuel (f : a → Either a b) : (x : Either a b) → Set where-  done : ∀ {y} → Fuel f (Right y)-  more : ∀ {x} → Fuel f (f x) → Fuel f (Left x)--tryFuel : (f : a → Either a b) (x : Either a b) (n : Nat) → Maybe (Fuel f x)-tryFuel f x         zero    = Nothing-tryFuel f (Left x)  (suc n) = more <$> tryFuel f (f x) n-tryFuel f (Right y) (suc n) = Just done--getFuel : (f : a → Either a b) (x : Either a b) (n : Nat)-        → {IsJust (tryFuel f x n)} → Fuel f x-getFuel f x n {p} = fromJust (tryFuel f x n) {p}--module _ {a b : Set} where-  loop : (f : a → Either a b) (x : a) → @0 Fuel f (Left x) → b-  loop f x (more n) = go (f x) n-    where-      go : (x : Either a b) → @0 Fuel f x → b-      go (Left x)  (more n) = go (f x) n-      go (Right y) done     = y-{-# COMPILE AGDA2HS loop #-}
− lib/Haskell/Extra/Refinement.agda 
@@ -1,28 +0,0 @@-module Haskell.Extra.Refinement where--open import Haskell.Prelude-open import Agda.Primitive--private variable-  ℓ ℓ′ : Level--record ∃ (a : Set ℓ) (@0 P : a → Set ℓ′) : Set (ℓ ⊔ ℓ′) where-  constructor _⟨_⟩-  field-    value    : a-    @0 proof : P value-open ∃ public-{-# COMPILE AGDA2HS ∃ unboxed #-}--mapRefine : {@0 P Q : a → Set ℓ} (@0 f : ∀ {x} → P x → Q x) → ∃ a P → ∃ a Q-mapRefine f (x ⟨ p ⟩) = x ⟨ f p ⟩--{-# COMPILE AGDA2HS mapRefine transparent #-}--refineMaybe : {@0 P : a → Set ℓ} -            → (mx : Maybe a) → @0 (∀ {x} → mx ≡ Just x → P x)-            → Maybe (∃ a P)-refineMaybe Nothing f = Nothing-refineMaybe (Just x) f = Just (x ⟨ f refl ⟩)--{-# COMPILE AGDA2HS refineMaybe transparent #-}
− lib/Haskell/Extra/Sigma.agda 
@@ -1,17 +0,0 @@-module Haskell.Extra.Sigma where--record Σ (a : Set) (b : @0 a → Set) : Set where-  constructor _,_-  field-    fst : a-    snd : b fst-open Σ public-{-# COMPILE AGDA2HS Σ tuple #-}--infix 2 Σ-syntax--Σ-syntax : (a : Set) → (@0 a → Set) → Set-Σ-syntax = Σ-{-# COMPILE AGDA2HS Σ-syntax inline #-}--syntax Σ-syntax a (λ x → b) = Σ[ x ∈ a ] b
− lib/Haskell/Law.agda 
@@ -1,20 +0,0 @@-module Haskell.Law where--open import Haskell.Prim-open import Haskell.Prim.Bool--open import Haskell.Law.Def          public-open import Haskell.Law.Applicative  public-open import Haskell.Law.Bool         public-open import Haskell.Law.Either       public-open import Haskell.Law.Eq           public-open import Haskell.Law.Equality     public-open import Haskell.Law.Functor      public-open import Haskell.Law.Int          public-open import Haskell.Law.Integer      public-open import Haskell.Law.List         public-open import Haskell.Law.Maybe        public-open import Haskell.Law.Monad        public-open import Haskell.Law.Monoid       public-open import Haskell.Law.Nat          public-open import Haskell.Law.Ord          public
− lib/Haskell/Law/Applicative.agda 
@@ -1,7 +0,0 @@-module Haskell.Law.Applicative where--open import Haskell.Law.Applicative.Def    public-open import Haskell.Law.Applicative.Either public-open import Haskell.Law.Applicative.IO     public-open import Haskell.Law.Applicative.List   public-open import Haskell.Law.Applicative.Maybe  public
− lib/Haskell/Law/Applicative/Def.agda 
@@ -1,41 +0,0 @@-module Haskell.Law.Applicative.Def where--open import Haskell.Prim-open import Haskell.Prim.Functor--open import Haskell.Prim.Applicative-open import Haskell.Prim.Monoid-open import Haskell.Prim.Tuple--open import Haskell.Law.Functor--record IsLawfulApplicative (F : Set → Set) ⦃ iAppF : Applicative F ⦄ : Set₁ where-  field-    overlap ⦃ super ⦄ : IsLawfulFunctor F--    -- Identity: pure id <*> v = v-    identity : (v : F a) → (pure id <*> v) ≡ v--    -- Composition: pure (.) <*> u <*> v <*> w = u <*> (v <*> w)-    composition : {a b c : Set} → (u : F (b → c)) (v : F (a → b)) (w : F a)-      → (pure _∘_ <*> u <*> v <*> w) ≡ (u <*> (v <*> w))--    -- Homomorphism: pure f <*> pure x = pure (f x)-    homomorphism : {a b : Set} → (f : a → b) (x : a)-      → (Applicative._<*>_ iAppF (pure f) (pure x)) ≡ (pure (f x))--    -- Interchange: u <*> pure y = pure ($ y) <*> u-    interchange : {a b : Set} → (u : F (a → b)) (y : a)-      → (u <*> (pure y)) ≡ (pure (_$ y) <*> u)--    -- fmap f x = pure f <*> x-    functor : (f : a → b) (x : F a) → (fmap f x) ≡ ((pure f) <*> x)--open IsLawfulApplicative ⦃ ... ⦄ public--instance postulate-  iLawfulApplicativeFun : IsLawfulApplicative (λ b → a → b)--  iLawfulApplicativeTuple₂ : ⦃ Monoid a ⦄ → Applicative (a ×_)--  iLawfulApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Applicative (a × b ×_)
− lib/Haskell/Law/Applicative/Either.agda 
@@ -1,29 +0,0 @@-module Haskell.Law.Applicative.Either where--open import Haskell.Prim-open import Haskell.Prim.Either--open import Haskell.Prim.Applicative--open import Haskell.Law.Applicative.Def--open import Haskell.Law.Functor.Either--instance-  iLawfulApplicativeEither : IsLawfulApplicative (Either a)-  -- (λ { true → true ; false → false })--  iLawfulApplicativeEither .identity = λ { (Left _) → refl; (Right _) → refl }--  iLawfulApplicativeEither .composition =-    λ { (Left _)  _         _         → refl-      ; (Right _) (Left _)  _         → refl-      ; (Right _) (Right _) (Left _)  → refl-      ; (Right _) (Right _) (Right _) → refl-      }--  iLawfulApplicativeEither .homomorphism _ _ = refl--  iLawfulApplicativeEither .interchange = λ { (Left _) _ → refl; (Right _) _ → refl }--  iLawfulApplicativeEither .functor = λ { _ (Left _) → refl; _ (Right _) → refl }
− lib/Haskell/Law/Applicative/IO.agda 
@@ -1,12 +0,0 @@-module Haskell.Law.Applicative.IO where--open import Haskell.Prim-open import Haskell.Prim.IO--open import Haskell.Prim.Applicative--open import Haskell.Law.Applicative.Def--open import Haskell.Law.Functor.IO--instance postulate iLawfulApplicativeIO : IsLawfulApplicative IO
− lib/Haskell/Law/Applicative/List.agda 
@@ -1,54 +0,0 @@-module Haskell.Law.Applicative.List where--open import Haskell.Prim-open import Haskell.Prim.List--open import Haskell.Prim.Applicative-open import Haskell.Prim.Functor--open import Haskell.Law.Applicative.Def--open import Haskell.Law.Equality-open import Haskell.Law.Functor.List-open import Haskell.Law.List--private-  identityList : {a : Set} → (v : List a) → (pure id <*> v) ≡ v-  identityList [] = refl-  identityList (x ∷ xs)-    rewrite identityList xs-    = refl--  compositionList : {a b c : Set} → (u : List (b → c)) (v : List (a → b)) (w : List a)-    → ((((pure _∘_) <*> u) <*> v) <*> w) ≡ (u <*> (v <*> w))-  compositionList [] _  _  = refl-  compositionList (u ∷ us) v w-    rewrite sym $ concatMap-++-distr (map (u ∘_) v) (((pure _∘_) <*> us) <*> v) (λ f → map f w)-      | sym $ map-<*>-recomp v w u-      | compositionList us v w-    = refl --  interchangeList : {a b : Set} → (u : List (a → b)) → (y : a)-    → (u <*> (pure y)) ≡ (pure (_$ y) <*> u)-  interchangeList [] _ = refl-  interchangeList (x ∷ xs) y-      rewrite interchangeList xs y-      = refl--  functorList : {a b : Set} → (f : a → b) → (x : List a)-    → (fmap f x) ≡ ((pure f) <*> x)-  functorList _ [] = refl-  functorList f (x ∷ xs)-      rewrite functorList f xs-        | ++-[] (map f xs)-        | ++-[] (f x ∷ map f xs)-      = refl--instance-  iLawfulApplicativeList : IsLawfulApplicative List-  iLawfulApplicativeList = λ where-    .identity → identityList-    .composition → compositionList-    .homomorphism _ x → refl-    .interchange → interchangeList-    .functor → functorList
− lib/Haskell/Law/Applicative/Maybe.agda 
@@ -1,27 +0,0 @@-module Haskell.Law.Applicative.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Maybe--open import Haskell.Prim.Applicative--open import Haskell.Law.Applicative.Def--open import Haskell.Law.Functor.Maybe--instance-  iLawfulApplicativeMaybe : IsLawfulApplicative Maybe-  iLawfulApplicativeMaybe .identity = λ { Nothing → refl; (Just _) → refl }--  iLawfulApplicativeMaybe .composition =-    λ { Nothing  _        _        → refl-      ; (Just _) Nothing  _        → refl-      ; (Just _) (Just _) Nothing  → refl-      ; (Just _) (Just _) (Just _) → refl-      }--  iLawfulApplicativeMaybe .homomorphism _ _ = refl--  iLawfulApplicativeMaybe .interchange = λ { Nothing _ → refl; (Just _) _ → refl }--  iLawfulApplicativeMaybe .functor = λ { _ Nothing → refl; _ (Just _) → refl }
− lib/Haskell/Law/Bool.agda 
@@ -1,86 +0,0 @@-module Haskell.Law.Bool where--open import Haskell.Prim-open import Haskell.Prim.Bool--open import Haskell.Law.Equality------------------------------------------------------- &&--&&-sym : ∀ (a b : Bool) → (a && b) ≡ (b && a)-&&-sym False False = refl-&&-sym False True = refl-&&-sym True False = refl-&&-sym True True = refl--&&-semantics : ∀ (a b : Bool) → a ≡ True → b ≡ True → (a && b) ≡ True-&&-semantics True True _ _ = refl--&&-leftAssoc : ∀ (a b c : Bool) → (a && b && c) ≡ True → ((a && b) && c) ≡ True-&&-leftAssoc True True True _ = refl--&&-leftAssoc' : ∀ (a b c : Bool) → (a && b && c) ≡ ((a && b) && c)-&&-leftAssoc' False b c = refl-&&-leftAssoc' True b c = refl--&&-leftTrue : ∀ (a b : Bool) → (a && b) ≡ True → a ≡ True-&&-leftTrue True True _ = refl--&&-leftTrue' : ∀ (a b c : Bool) → a ≡ (b && c) → a ≡ True → c ≡ True-&&-leftTrue' .True True True _ refl = refl--&&-rightTrue : ∀ (a b : Bool) → (a && b) ≡ True → b ≡ True-&&-rightTrue True True _ = refl--&&-rightTrue' : ∀ (a b c : Bool) → a ≡ (b && c) → a ≡ True → b ≡ True-&&-rightTrue' .True True True _ refl = refl------------------------------------------------------- ||---- if a then True else b--||-excludedMiddle : ∀ (a b : Bool) → (a || not a) ≡ True-||-excludedMiddle False _ = refl-||-excludedMiddle True  _ = refl--||-leftTrue : ∀ (a b : Bool) → a ≡ True → (a || b) ≡ True-||-leftTrue .True b refl = refl--||-rightTrue : ∀ (a b : Bool) → b ≡ True → (a || b) ≡ True-||-rightTrue False .True refl = refl-||-rightTrue True  .True refl = refl------------------------------------------------------- not--not-not : ∀ (a : Bool) → not (not a) ≡ a-not-not False = refl-not-not True = refl--not-involution : ∀ (a b : Bool) → a ≡ not b → not a ≡ b-not-involution .(not b) b refl = not-not b------------------------------------------------------- if_then_else_--ifFlip : ∀ (b)-       → (t : {{not b ≡ True}} → a)-       → (e : {{not b ≡ False}} → a)-       → (if not b then t                             else e) ≡-         (if b     then (e {{not-involution _ _ it}}) else t {{not-involution _ _ it}})-ifFlip False _ _ = refl-ifFlip True  _ _ = refl--ifTrueEqThen : ∀ (b : Bool)-             → {thn : {{b ≡ True}} → a}-             → {els : {{b ≡ False}} → a}-             → (pf : b ≡ True) → (if b then thn else els) ≡ thn {{pf}}-ifTrueEqThen .True refl = refl--ifFalseEqElse : ∀ (b : Bool)-             → {thn : {{b ≡ True}} → a}-             → {els : {{b ≡ False}} → a}-             → (pf : b ≡ False) → (if b then thn else els) ≡ els {{pf}}-ifFalseEqElse .False refl = refl
− lib/Haskell/Law/Def.agda 
@@ -1,6 +0,0 @@-module Haskell.Law.Def where--open import Haskell.Prim--Injective : (a → b) → Set _-Injective f = ∀ {x y} → f x ≡ f y → x ≡ y
− lib/Haskell/Law/Either.agda 
@@ -1,12 +0,0 @@-module Haskell.Law.Either where--open import Haskell.Prim-open import Haskell.Prim.Either--open import Haskell.Law.Def--Left-injective : Injective (Left {a}{b})-Left-injective refl = refl--Right-injective : Injective (Right {a}{b})-Right-injective refl = refl
− lib/Haskell/Law/Eq.agda 
@@ -1,4 +0,0 @@-module Haskell.Law.Eq where--open import Haskell.Law.Eq.Def       public-open import Haskell.Law.Eq.Instances public
− lib/Haskell/Law/Eq/Def.agda 
@@ -1,68 +0,0 @@-module Haskell.Law.Eq.Def where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.Double--open import Haskell.Prim.Eq--open import Haskell.Extra.Dec--open import Haskell.Law.Bool-open import Haskell.Law.Equality--record IsLawfulEq (e : Set) ⦃ iEq : Eq e ⦄ : Set₁ where-  field-    isEquality : ∀ (x y : e) → Reflects (x ≡ y) (x == y)--  equality : ∀ (x y : e) → (x == y) ≡ True → x ≡ y-  equality x y h = extractTrue ⦃ h ⦄ (isEquality x y)--  nequality : ∀ (x y : e) → (x == y) ≡ False → (x ≡ y → ⊥)-  nequality x y h = extractFalse ⦃ h ⦄ (isEquality x y)--  -- contrapositive of nequality-  equality' : ∀ (x y : e) → x ≡ y → (x == y) ≡ True-  equality' x y h with x == y in eq-  ... | False = magic (nequality x y eq h)-  ... | True = refl--  -- contrapositive of equality-  nequality' : ∀ (x y : e) → (x ≡ y → ⊥) → (x == y) ≡ False-  nequality' x y h with x == y in eq-  ... | True = magic (h (equality x y eq))-  ... | False = refl--open IsLawfulEq ⦃ ... ⦄ public---- Reflexivity: x == x = True-eqReflexivity : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄-              → ∀ (x : e) → (x == x) ≡ True-eqReflexivity x = equality' x x refl---- Symmetry: x == y = y == x-eqSymmetry : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄-           → ∀ (x y : e) → (x == y) ≡ (y == x)-eqSymmetry x y with x == y in eq-... | True  = sym (equality' y x (sym (equality x y eq)))-... | False = sym (nequality' y x (λ qe → (nequality x y eq) (sym qe)))---- Transitivity: if x == y && y == z = True, then x == z = True-eqTransitivity : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄-               → ∀ (x y z : e) → ((x == y) && (y == z)) ≡ True → (x == z) ≡ True-eqTransitivity x y z h-  = equality' x z (trans-    (equality x y (&&-leftTrue (x == y) (y == z) h))-    (equality y z (&&-rightTrue (x == y) (y == z) h)))---- Extensionality: if x == y = True and f is a function whose return type is an instance of Eq, then f x == f y = True-eqExtensionality : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄-                 → ⦃ iEq : Eq a ⦄ → ⦃ iLawfulEq : IsLawfulEq a ⦄-                 → ∀ ( x y : e ) ( f : e → a ) → (x == y) ≡ True → (f x == f y) ≡ True-eqExtensionality x y f h = equality' (f x) (f y) (cong f (equality x y h))---- Negation: x /= y = not (x == y)-eqNegation : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄-           → ∀ { x y : e } → (x /= y) ≡ not (x == y)-eqNegation = refl-
− lib/Haskell/Law/Eq/Instances.agda 
@@ -1,138 +0,0 @@-module Haskell.Law.Eq.Instances where--open import Agda.Builtin.Char.Properties renaming (primCharToNatInjective to c2n-injective)-open import Agda.Builtin.Word.Properties renaming (primWord64ToNatInjective to w2n-injective)--open import Haskell.Prim-open import Haskell.Prim.Eq--open import Haskell.Prim.Either using ( Either; Left; Right )-open import Haskell.Prim.Int    using ( Int; int64 )-open import Haskell.Prim.Maybe-open import Haskell.Prim.Ord    using ( Ordering; LT; GT; EQ )-open import Haskell.Prim.Tuple-open import Haskell.Prim.Word   using ( Word )--open import Haskell.Extra.Dec   using ( mapReflects )--open import Haskell.Law.Eq.Def-open import Haskell.Law.Equality--open import Haskell.Law.Either-open import Haskell.Law.Int-open import Haskell.Law.Integer-open import Haskell.Law.List    using ( ∷-injective-left; ∷-injective-right )-open import Haskell.Law.Maybe-open import Haskell.Law.Nat--open _×_×_--instance-  iLawfulEqNat : IsLawfulEq Nat-  iLawfulEqNat .isEquality zero    zero    = refl-  iLawfulEqNat .isEquality zero    (suc _) = λ ()-  iLawfulEqNat .isEquality (suc _) zero    = λ ()-  iLawfulEqNat .isEquality (suc x) (suc y) = mapReflects-    (cong suc)-    suc-injective-    (isEquality x y)--  iLawfulEqWord : IsLawfulEq Word-  iLawfulEqWord .isEquality x y-    with (w2n x) in h₁ | (w2n y) in h₂-  ... | a | b  = mapReflects-    (λ h → w2n-injective x y $ sym $ trans (trans h₂ $ sym h) (sym h₁))-    (λ h → trans (sym $ trans (cong w2n (sym h)) h₁) h₂)-    (isEquality a b)--  iLawfulEqBool : IsLawfulEq Bool-  iLawfulEqBool .isEquality False False = refl-  iLawfulEqBool .isEquality False True  = λ()-  iLawfulEqBool .isEquality True  False = λ()-  iLawfulEqBool .isEquality True  True  = refl--  iLawfulEqChar : IsLawfulEq Char-  iLawfulEqChar .isEquality x y-    with (c2n x) in h₁ | (c2n y) in h₂-  ... | a | b  = mapReflects { a ≡ b } { x ≡ y } { eqNat a b }-    (λ h → c2n-injective x y $ sym $ trans (trans h₂ $ sym h) (sym h₁))-    (λ h → trans (sym $ trans (cong c2n (sym h)) h₁) h₂)-    (isEquality a b)--  iLawfulEqEither : ⦃ iEqA : Eq a ⦄ → ⦃ iEqB : Eq b ⦄-    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄-    → IsLawfulEq (Either a b)-  iLawfulEqEither .isEquality (Left  _) (Right _) = λ ()-  iLawfulEqEither .isEquality (Right _) (Left  _) = λ ()-  iLawfulEqEither .isEquality (Left  x) (Left  y) = mapReflects-    (cong Left) (Left-injective) (isEquality x y)-  iLawfulEqEither .isEquality (Right x) (Right y) = mapReflects-    (cong Right) (Right-injective) (isEquality x y)--  iLawfulEqInt : IsLawfulEq Int-  iLawfulEqInt .isEquality (int64 x) (int64 y) = mapReflects-    (cong int64) int64-injective (isEquality x y)--  iLawfulEqInteger : IsLawfulEq Integer-  iLawfulEqInteger .isEquality (pos n)    (pos m)    = mapReflects-    (cong pos) pos-injective (isEquality n m)-  iLawfulEqInteger .isEquality (pos _)    (negsuc _) = λ ()-  iLawfulEqInteger .isEquality (negsuc _) (pos _)    = λ ()-  iLawfulEqInteger .isEquality (negsuc n) (negsuc m) = mapReflects-    (cong negsuc) neg-injective (isEquality n m)--  iLawfulEqList : ⦃ iEqA : Eq a ⦄ → ⦃ IsLawfulEq a ⦄ → IsLawfulEq (List a)-  iLawfulEqList .isEquality []       []      = refl-  iLawfulEqList .isEquality []       (_ ∷ _) = λ ()-  iLawfulEqList .isEquality (_ ∷ _)  []      = λ ()-  iLawfulEqList .isEquality (x ∷ xs) (y ∷ ys)-    with (x == y) in h₁-  ... | True  = mapReflects-    (λ h → cong₂ (_∷_) (equality x y h₁)  h)-    ∷-injective-right-    (isEquality xs ys)-  ... | False = λ h → (nequality x y h₁) (∷-injective-left h)--  iLawfulEqMaybe : ⦃ iEqA : Eq a ⦄ → ⦃ IsLawfulEq a ⦄ → IsLawfulEq (Maybe a)-  iLawfulEqMaybe .isEquality Nothing  Nothing  = refl-  iLawfulEqMaybe .isEquality Nothing  (Just _) = λ()-  iLawfulEqMaybe .isEquality (Just _) Nothing  = λ()-  iLawfulEqMaybe .isEquality (Just x) (Just y) = mapReflects-    (cong Just) Just-injective (isEquality x y)--  iLawfulEqOrdering : IsLawfulEq Ordering-  iLawfulEqOrdering .isEquality LT LT = refl-  iLawfulEqOrdering .isEquality LT EQ = λ()-  iLawfulEqOrdering .isEquality LT GT = λ()-  iLawfulEqOrdering .isEquality EQ LT = λ()-  iLawfulEqOrdering .isEquality EQ EQ = refl-  iLawfulEqOrdering .isEquality EQ GT = λ()-  iLawfulEqOrdering .isEquality GT LT = λ()-  iLawfulEqOrdering .isEquality GT EQ = λ()-  iLawfulEqOrdering .isEquality GT GT = refl--  iLawfulEqTuple₂ : ⦃ iEqA : Eq a ⦄ ⦃ iEqB : Eq b ⦄-    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄-    → IsLawfulEq (a × b)-  iLawfulEqTuple₂ .isEquality (x₁ , x₂) (y₁ , y₂)-    with (x₁ == y₁) in h₁-  ... | True  = mapReflects-    (λ h → cong₂ _,_ (equality x₁ y₁ h₁) h)-    (cong snd)-    (isEquality x₂ y₂)-  ... | False = λ h → exFalso (equality' x₁ y₁ (cong fst h)) h₁--  iLawfulEqTuple₃ : ⦃ iEqA : Eq a ⦄ ⦃ iEqB : Eq b ⦄ ⦃ iEqC : Eq c ⦄-    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄ → ⦃ IsLawfulEq c ⦄-    → IsLawfulEq (a × b × c)-  iLawfulEqTuple₃ .isEquality (x₁ , x₂ , x₃) (y₁ , y₂ , y₃)-    with (x₁ == y₁) in h₁-  ... | True  = mapReflects-    (λ h → cong₂ (λ a (b , c) → a , b , c) (equality x₁ y₁ h₁) h)-    (cong λ h → snd3 h , thd3 h)-    (isEquality (x₂ , x₃) (y₂ , y₃))-  ... | False = λ h → exFalso (equality' x₁ y₁ (cong fst3 h)) h₁---  iLawfulEqUnit : IsLawfulEq ⊤-  iLawfulEqUnit .isEquality tt tt = refl
− lib/Haskell/Law/Equality.agda 
@@ -1,67 +0,0 @@-module Haskell.Law.Equality where--open import Haskell.Prim--open import Agda.Builtin.TrustMe--_≠_ : {A : Set} → A → A → Set-_≠_ a b = a ≡ b → ⊥--infix 4 _≠_------------------------------------------------------- Basic Laws--cong : {A B : Set} → ∀ (f : A → B) {x y} → x ≡ y → f x ≡ f y-cong f refl = refl--cong₂ : ∀ (f : a → b → c) {x y u v} → x ≡ y → u ≡ v → f x u ≡ f y v-cong₂ f refl refl = refl--sym : ∀ {A : Set} {x y : A} → x ≡ y → y ≡ x-sym refl = refl--trans : ∀ {A : Set} {x y z : A} → x ≡ y → y ≡ z → x ≡ z-trans refl refl = refl--subst : ∀ {A : Set} (P : A → Set) {x y : A} → x ≡ y → P x → P y-subst P refl z = z------------------------------------------------------- Scary Things--trustMe : ∀ {a} {A : Set a} {x y : A} → x ≡ y-trustMe = primTrustMe------------------------------------------------------- ≡-Reasoning--infix  1 begin_-infixr 2 _≡⟨⟩_ step-≡ step-≡˘-infix  3 _∎--begin_ : ∀{x y : a} → x ≡ y → x ≡ y-begin_ x≡y = x≡y--_≡⟨⟩_ : ∀ (x {y} : a) → x ≡ y → x ≡ y-_ ≡⟨⟩ x≡y = x≡y--step-≡ : ∀ (x {y z} : a) → y ≡ z → x ≡ y → x ≡ z-step-≡ _ y≡z x≡y = trans x≡y y≡z--step-≡˘ : ∀ (x {y z} : a) → y ≡ z → y ≡ x → x ≡ z-step-≡˘ _ y≡z y≡x = trans (sym y≡x) y≡z--_∎ : ∀ (x : a) → x ≡ x-_∎ _ = refl--syntax step-≡  x y≡z x≡y = x ≡⟨  x≡y ⟩ y≡z-syntax step-≡˘ x y≡z y≡x = x ≡˘⟨ y≡x ⟩ y≡z------------------------------------------------------- Utility Functions--subst0 : {@0 a : Set} (@0 p : @0 a → Set) {@0 x y : a} → @0 x ≡ y → p x → p y-subst0 p refl z = z-{-# COMPILE AGDA2HS subst0 transparent #-}
− lib/Haskell/Law/Function.agda 
@@ -1,171 +0,0 @@-module Haskell.Law.Function where--open import Haskell.Prim-open import Haskell.Law.Equality---{-|-Pointwise equality on functions.-This says that two functions produce the same-result for all input values.--}-infix 4 _≗_-_≗_ : ∀ {A B : Set} (f g : A → B) → Set-f ≗ g = ∀ a → f a ≡ g a--Commutative : {a : Set} → (a → a → a) → Set-Commutative _+_ = ∀ x y → x + y ≡ y + x--Associative : {a : Set} → (a → a → a) → Set-Associative _+_ = ∀ x y z → (x + y) + z ≡ x + (y + z)--Identityˡ : {a : Set} → (a → a → a) → a → Set-Identityˡ _+_ 𝟘 = ∀ x → 𝟘 + x ≡ x--Identityʳ : {a : Set} → (a → a → a) → a → Set-Identityʳ _+_ 𝟘 = ∀ x → x + 𝟘 ≡ x--Distributiveˡ : {a : Set} → (_+_ : a → a → a) → (_*_ : a → a → a) → Set-Distributiveˡ _+_ _*_ = ∀ x y z → x * (y + z) ≡ (x * y) + (x * z)--Distributiveʳ : {a : Set} → (_+_ : a → a → a) → (_*_ : a → a → a) → Set-Distributiveʳ _+_ _*_ =  ∀ x y z → (y + z) * x ≡ (y * x) + (z * x)--{-|-Definition of homomorphism over unary functions.-A function φ is homomorphic w.r.t. some function or structure f-when it preserves this structure in its target domain b-(where this structure is called g).--}-Homomorphism₁ : ∀ {a b : Set} (f : a → a) (g : b → b)-  → (φ : a → b) → Set-Homomorphism₁ f g φ = φ ∘ f ≗ g ∘ φ--{-|-Definition of homomorphism over binary functions.-A function φ is homomorphic w.r.t. some structure _+ᵃ_-when it preserves this structure in its target domain b-(where this structure is called _+ᵇ_).--}-Homomorphism₂ : ∀ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b)-  → (φ : a → b) → Set-Homomorphism₂ _+ᵃ_ _+ᵇ_ φ = ∀ x y → φ (x +ᵃ y) ≡ φ x +ᵇ φ y--record Embedding₂ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) : Set where-  field-    hom   : Homomorphism₂ _+ᵃ_ _+ᵇ_ φ-    embed : φ⁻¹ ∘ φ ≗ id--record MonoidEmbedding₂ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) (0ᵃ : a) (0ᵇ : b) : Set where-  field-    embedding : Embedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹-    0-hom     : φ 0ᵃ ≡ 0ᵇ--map-comm : ∀ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a)-  → Embedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹-  → Commutative _+ᵇ_-  → Commutative _+ᵃ_-map-comm _+ᵃ_ _+ᵇ_ φ φ⁻¹ proj comm x y =-  begin-    x +ᵃ y-  ≡˘⟨ embed (x +ᵃ y) ⟩-    φ⁻¹ (φ (x +ᵃ y))-  ≡⟨ cong φ⁻¹ (hom x y) ⟩-    φ⁻¹ (φ x +ᵇ φ y)-  ≡⟨ cong φ⁻¹ (comm (φ x) (φ y)) ⟩-    φ⁻¹ (φ y +ᵇ φ x)-  ≡˘⟨ cong φ⁻¹ (hom y x) ⟩-    φ⁻¹ (φ (y +ᵃ x))-  ≡⟨ embed (y +ᵃ x) ⟩-    y +ᵃ x-  ∎-  where-    open Embedding₂ proj--map-assoc : ∀ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a)-  → Embedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹-  → Associative _+ᵇ_-  → Associative _+ᵃ_-map-assoc _+ᵃ_ _+ᵇ_ φ φ⁻¹ proj assoc x y z =-  begin-    (x +ᵃ y) +ᵃ z-  ≡⟨ sym (embed ((x +ᵃ y) +ᵃ z)) ⟩-    φ⁻¹ (φ ((x +ᵃ y) +ᵃ z))-  ≡⟨ cong φ⁻¹ (hom (x +ᵃ y) z) ⟩-    φ⁻¹ (φ (x +ᵃ y) +ᵇ φ z)-  ≡⟨ cong φ⁻¹ (cong (_+ᵇ φ z) (hom x y)) ⟩-    φ⁻¹ ((φ x +ᵇ φ y) +ᵇ φ z)-  ≡⟨ cong φ⁻¹ (assoc (φ x) (φ y) (φ z)) ⟩-    φ⁻¹ (φ x +ᵇ (φ y +ᵇ φ z))-  ≡⟨ cong φ⁻¹ (cong (φ x +ᵇ_) (sym (hom y z))) ⟩-    φ⁻¹ (φ x +ᵇ φ (y +ᵃ z))-  ≡⟨ cong φ⁻¹ (sym (hom x (y +ᵃ z))) ⟩-    φ⁻¹ (φ (x +ᵃ (y +ᵃ z)))-  ≡⟨ embed (x +ᵃ (y +ᵃ z)) ⟩-    x +ᵃ (y +ᵃ z)-  ∎-  where-    open Embedding₂ proj--map-idˡ : ∀ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) (0ᵃ : a) (0ᵇ : b)-  → MonoidEmbedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹ 0ᵃ 0ᵇ-  → Identityˡ _+ᵇ_ 0ᵇ-  → Identityˡ _+ᵃ_ 0ᵃ-map-idˡ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ membed idˡ x =-  0ᵃ +ᵃ x         ≡⟨ sym (embed (0ᵃ +ᵃ x)) ⟩-  g (f (0ᵃ +ᵃ x)) ≡⟨ cong g (hom 0ᵃ x) ⟩-  g (f 0ᵃ +ᵇ f x) ≡⟨ cong g (cong (_+ᵇ f x) 0-hom) ⟩-  g (0ᵇ +ᵇ f x)   ≡⟨ cong g (idˡ (f x)) ⟩-  g (f x)        ≡⟨ embed x ⟩-  x              ∎-  where-    open MonoidEmbedding₂ membed-    open Embedding₂ embedding--map-idʳ : ∀ {a b : Set} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) (0ᵃ : a) (0ᵇ : b)-  → MonoidEmbedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹ 0ᵃ 0ᵇ-  → Identityʳ _+ᵇ_ 0ᵇ-  → Identityʳ _+ᵃ_ 0ᵃ-map-idʳ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ membed idʳ x =-  x +ᵃ 0ᵃ         ≡⟨ sym (embed (x +ᵃ 0ᵃ)) ⟩-  g (f (x +ᵃ 0ᵃ)) ≡⟨ cong g (hom x 0ᵃ) ⟩-  g (f x +ᵇ f 0ᵃ) ≡⟨ cong g (cong (f x +ᵇ_) 0-hom) ⟩-  g (f x +ᵇ 0ᵇ)   ≡⟨ cong g (idʳ (f x)) ⟩-  g (f x)        ≡⟨ embed x ⟩-  x              ∎-  where-    open MonoidEmbedding₂ membed-    open Embedding₂ embedding--module _ {a b : Set}-  (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b)-  (_*ᵃ_ : a → a → a) (_*ᵇ_ : b → b → b)-  (f : a → b) (g : b → a)-  (embed : g ∘ f ≗ id)-  (+-hom : Homomorphism₂ _+ᵃ_ _+ᵇ_ f)-  (*-hom : Homomorphism₂ _*ᵃ_ _*ᵇ_ f)-  where--  map-distributeˡ : Distributiveˡ _+ᵇ_ _*ᵇ_ → Distributiveˡ _+ᵃ_ _*ᵃ_-  map-distributeˡ distributeˡ-b x y z =-    x *ᵃ (y +ᵃ z)                    ≡˘⟨ embed (x *ᵃ (y +ᵃ z)) ⟩-    g (f (x *ᵃ (y +ᵃ z)))            ≡⟨ cong g (*-hom x (y +ᵃ z)) ⟩-    g (f x *ᵇ f (y +ᵃ z))            ≡⟨ cong g (cong (f x *ᵇ_) (+-hom y z)) ⟩-    g (f x *ᵇ (f y +ᵇ f z))          ≡⟨ cong g (distributeˡ-b (f x) (f y) (f z)) ⟩-    g ((f x *ᵇ f y) +ᵇ (f x *ᵇ f z)) ≡˘⟨ cong g (cong (_+ᵇ (f x *ᵇ f z)) (*-hom x y)) ⟩-    g (f (x *ᵃ y) +ᵇ (f x *ᵇ f z))   ≡˘⟨ cong g (cong (f (x *ᵃ y) +ᵇ_) (*-hom x z)) ⟩-    g (f (x *ᵃ y) +ᵇ f (x *ᵃ z))     ≡˘⟨ cong g (+-hom (x *ᵃ y) (x *ᵃ z)) ⟩-    g (f ((x *ᵃ y) +ᵃ (x *ᵃ z)))     ≡⟨ embed ((x *ᵃ y) +ᵃ (x *ᵃ z)) ⟩-    (x *ᵃ y) +ᵃ (x *ᵃ z)             ∎--  map-distributeʳ : Distributiveʳ _+ᵇ_ _*ᵇ_ → Distributiveʳ _+ᵃ_ _*ᵃ_-  map-distributeʳ distributeʳ-b x y z =-    (y +ᵃ z) *ᵃ x                    ≡˘⟨ embed ((y +ᵃ z) *ᵃ x) ⟩-    g (f ((y +ᵃ z) *ᵃ x))            ≡⟨ cong g (*-hom (y +ᵃ z) x) ⟩-    g (f (y +ᵃ z) *ᵇ f x)            ≡⟨ cong g (cong (_*ᵇ f x) (+-hom y z)) ⟩-    g ((f y +ᵇ f z) *ᵇ f x)          ≡⟨ cong g (distributeʳ-b (f x) (f y) (f z)) ⟩-    g ((f y *ᵇ f x) +ᵇ (f z *ᵇ f x)) ≡˘⟨ cong g (cong (_+ᵇ (f z *ᵇ f x)) (*-hom y x)) ⟩-    g (f (y *ᵃ x) +ᵇ (f z *ᵇ f x))   ≡˘⟨ cong g (cong (f (y *ᵃ x) +ᵇ_) (*-hom z x)) ⟩-    g (f (y *ᵃ x) +ᵇ f (z *ᵃ x))     ≡˘⟨ cong g (+-hom (y *ᵃ x) (z *ᵃ x)) ⟩-    g (f ((y *ᵃ x) +ᵃ (z *ᵃ x)))     ≡⟨ embed ((y *ᵃ x) +ᵃ (z *ᵃ x)) ⟩-    (y *ᵃ x) +ᵃ (z *ᵃ x)             ∎
− lib/Haskell/Law/Functor.agda 
@@ -1,7 +0,0 @@-module Haskell.Law.Functor where--open import Haskell.Law.Functor.Def    public-open import Haskell.Law.Functor.Either public-open import Haskell.Law.Functor.IO     public-open import Haskell.Law.Functor.List   public-open import Haskell.Law.Functor.Maybe  public
− lib/Haskell/Law/Functor/Def.agda 
@@ -1,24 +0,0 @@-module Haskell.Law.Functor.Def where--open import Haskell.Prim-open import Haskell.Prim.Tuple--open import Haskell.Prim.Functor--record IsLawfulFunctor (F : Set → Set) ⦃ iFuncF : Functor F ⦄ : Set₁ where-  field-    -- Identity: fmap id == id-    identity : (fa : F a) → (fmap id) fa ≡ id fa--    -- Composition: fmap (f . g) == fmap f . fmap g-    composition : (fa : F a) (f : a → b) (g : b → c)-      → fmap (g ∘ f) fa ≡ (fmap g ∘ fmap f) fa--open IsLawfulFunctor ⦃ ... ⦄ public--instance postulate-  iLawfulFunctorFun : IsLawfulFunctor (λ b → a → b)--  iLawfulFunctorTuple₂ : IsLawfulFunctor (a ×_)--  iLawfulFunctorTuple₃ : IsLawfulFunctor (a × b ×_)
− lib/Haskell/Law/Functor/Either.agda 
@@ -1,14 +0,0 @@-module Haskell.Law.Functor.Either where--open import Haskell.Prim-open import Haskell.Prim.Either--open import Haskell.Prim.Functor--open import Haskell.Law.Functor.Def--instance-  iLawfulFunctorEither : IsLawfulFunctor (Either a)-  iLawfulFunctorEither .identity = λ { (Left _) → refl; (Right _) → refl }--  iLawfulFunctorEither .composition = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
− lib/Haskell/Law/Functor/IO.agda 
@@ -1,10 +0,0 @@-module Haskell.Law.Functor.IO where--open import Haskell.Prim-open import Haskell.Prim.IO--open import Haskell.Prim.Functor--open import Haskell.Law.Functor.Def--instance postulate isLawFulFunctorIO : IsLawfulFunctor IO
− lib/Haskell/Law/Functor/List.agda 
@@ -1,25 +0,0 @@-module Haskell.Law.Functor.List where--open import Haskell.Prim-open import Haskell.Prim.List--open import Haskell.Prim.Functor--open import Haskell.Law.Equality-open import Haskell.Law.Functor.Def--private-  identityList : (fa : List a) → (fmap id) fa ≡ id fa-  identityList [] = refl-  identityList (x ∷ xs) rewrite identityList xs = refl--  compositionList : (fa : List a) → (f : a → b) → (g : b → c)-    → fmap (g ∘ f) fa ≡ (fmap g ∘ fmap f) fa-  compositionList [] _ _ = refl-  compositionList (x ∷ xs) f g rewrite compositionList xs f g = refl--instance-  iLawfulFunctorList : IsLawfulFunctor List-  iLawfulFunctorList = λ where-    .identity → identityList-    .composition → compositionList
− lib/Haskell/Law/Functor/Maybe.agda 
@@ -1,14 +0,0 @@-module Haskell.Law.Functor.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Maybe--open import Haskell.Prim.Functor--open import Haskell.Law.Functor.Def--instance-  iLawfulFunctorMaybe : IsLawfulFunctor Maybe-  iLawfulFunctorMaybe .identity = λ { Nothing → refl; (Just _) → refl }--  iLawfulFunctorMaybe .composition = λ { Nothing _ _ → refl; (Just _) _ _ → refl }
− lib/Haskell/Law/Int.agda 
@@ -1,9 +0,0 @@-module Haskell.Law.Int where--open import Haskell.Prim-open import Haskell.Prim.Int using ( int64 )--open import Haskell.Law.Def--int64-injective : Injective int64-int64-injective refl = refl
− lib/Haskell/Law/Integer.agda 
@@ -1,11 +0,0 @@-module Haskell.Law.Integer where--open import Haskell.Prim--open import Haskell.Law.Def--pos-injective : Injective pos-pos-injective refl = refl--neg-injective : Injective negsuc-neg-injective refl = refl
− lib/Haskell/Law/List.agda 
@@ -1,145 +0,0 @@-module Haskell.Law.List where--open import Haskell.Law.Equality-open import Haskell.Prim renaming (addNat to _+ₙ_)-open import Haskell.Prim.Foldable-open import Haskell.Prim.List-open import Haskell.Prim.Applicative--[]≠∷ : ∀ x (xs : List a) → [] ≠ x ∷ xs-[]≠∷ x xs ()------------------------------------------------------- _∷_--module _ {x y : a} {xs ys : List a} where  -  ∷-injective-left : x ∷ xs ≡ y ∷ ys → x ≡ y-  ∷-injective-left refl = refl--  ∷-injective-right : x ∷ xs ≡ y ∷ ys → xs ≡ ys-  ∷-injective-right refl = refl------------------------------------------------------- map--map-id : (xs : List a) → map id xs ≡ xs-map-id []       = refl-map-id (x ∷ xs) = cong (x ∷_) (map-id xs)--map-++ : ∀ (f : a → b) xs ys → map f (xs ++ ys) ≡ map f xs ++ map f ys-map-++ f [] ys       = refl-map-++ f (x ∷ xs) ys = cong (f x ∷_) (map-++ f xs ys)--lengthMap : ∀ (f : a → b) xs → lengthNat (map f xs) ≡ lengthNat xs-lengthMap f []       = refl-lengthMap f (x ∷ xs) = cong suc (lengthMap f xs)--map-∘ : ∀ (g : b → c) (f : a → b) xs → map (g ∘ f) xs ≡ (map g ∘ map f) xs-map-∘ g f []       = refl-map-∘ g f (x ∷ xs) = cong (_ ∷_) (map-∘ g f xs)--map-concatMap : ∀ (f : a → b) (xs : List a) → (map f xs) ≡ concatMap (λ g → f g ∷ []) xs-map-concatMap f [] = refl-map-concatMap f (x ∷ xs) -  rewrite map-concatMap f xs-  = refl--map-<*>-recomp : {a b c : Set} → (xs : List (a → b)) → (ys : List a) → (u : (b → c))  -  → ((map (u ∘_) xs) <*> ys) ≡ map u (xs <*> ys)-map-<*>-recomp [] _ _  = refl-map-<*>-recomp (x ∷ xs) ys u -  rewrite map-∘ u x ys-    | map-++ u (map x ys) (xs <*> ys)-    | map-<*>-recomp  xs ys u-  = refl------------------------------------------------------- _++_--lengthNat-++ : ∀ (xs : List a) {ys} →-            lengthNat (xs ++ ys) ≡ lengthNat xs +ₙ lengthNat ys-lengthNat-++ []       = refl-lengthNat-++ (x ∷ xs) = cong suc (lengthNat-++ xs)--++-[] : ∀ (xs : List a) → xs ++ [] ≡ xs-++-[] [] = refl-++-[] (x ∷ xs) rewrite ++-[] xs = refl--[]-++ : ∀ (xs : List a) → [] ++ xs ≡ xs-[]-++ xs = refl--++-assoc : ∀ (xs ys zs : List a) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)-++-assoc [] ys zs = refl-++-assoc (x ∷ xs) ys zs rewrite ++-assoc xs ys zs = refl--++-∷-assoc : ∀ xs y (ys : List a) → xs ++ y ∷ ys ≡ (xs ++ y ∷ []) ++ ys-++-∷-assoc [] y ys = refl-++-∷-assoc (x ∷ xs) y ys = cong (x ∷_) (++-∷-assoc xs y ys)--∷-++-assoc : ∀ x xs (ys : List a) → (x ∷ xs) ++ ys ≡ x ∷ (xs ++ ys)-∷-++-assoc x xs ys = refl--++-identity-right-unique : ∀ (xs : List a) {ys} → xs ≡ xs ++ ys → ys ≡ []-++-identity-right-unique []       refl = refl-++-identity-right-unique (x ∷ xs) eq   =-  ++-identity-right-unique xs (∷-injective-right eq)--++-identity-left-unique : ∀ {xs} (ys : List a) → xs ≡ ys ++ xs → ys ≡ []-++-identity-left-unique               []       _  = refl-++-identity-left-unique {xs = x ∷ xs} (y ∷ ys) eq-  with ++-identity-left-unique (ys ++ (x ∷ [])) (begin-        xs                  ≡⟨ ∷-injective-right eq ⟩-        ys ++ x ∷ xs        ≡⟨ sym (++-assoc ys (x ∷ []) xs) ⟩-        (ys ++ x ∷ []) ++ xs ∎)-++-identity-left-unique {xs = x ∷ xs} (y ∷ []   ) eq | ()-++-identity-left-unique {xs = x ∷ xs} (y ∷ _ ∷ _) eq | ()--++-cancel-left : ∀ (xs ys : List a) {zs} → xs ++ ys ≡ xs ++ zs → ys ≡ zs-++-cancel-left []       ys eq = eq-++-cancel-left (x ∷ xs) ys eq = ++-cancel-left xs ys (∷-injective-right eq)--++-cancel-right : ∀ (xs ys : List a) {zs} → xs ++ zs ≡ ys ++ zs → xs ≡ ys-++-cancel-right []       []       eq = refl-++-cancel-right (x ∷ xs) []       eq = ++-identity-left-unique (x ∷ xs) (sym eq)-++-cancel-right []       (y ∷ ys) eq = sym $ ++-identity-left-unique (y ∷ ys) eq-++-cancel-right (x ∷ xs) (y ∷ ys) eq -  rewrite ∷-injective-left eq = cong (y ∷_) $ ++-cancel-right xs ys (∷-injective-right eq)--++-conical-left : (xs ys : List a) → xs ++ ys ≡ [] → xs ≡ []-++-conical-left [] _ refl = refl--++-conical-right : (xs ys : List a) → xs ++ ys ≡ [] → ys ≡ []-++-conical-right [] _ refl = refl--∷-not-identity : ∀ x (xs ys : List a) → (x ∷ xs) ++ ys ≡ ys → ⊥-∷-not-identity x xs ys eq = []≠∷ x xs (sym $ ++-identity-left-unique (x ∷ xs) (sym eq))--concatMap-++-distr : ∀ (xs ys : List a) (f : a → List b) → -  ((concatMap f xs) ++ (concatMap f ys)) ≡ (concatMap f (xs ++ ys))-concatMap-++-distr [] ys f = refl-concatMap-++-distr (x ∷ xs) ys f-  rewrite ++-assoc (f x) (concatMap f xs) (concatMap f ys)-  | concatMap-++-distr xs ys f- = refl------------------------------------------------------- foldr--foldr-universal : ∀ (h : List a → b) f e → (h [] ≡ e) →-                  (∀ x xs → h (x ∷ xs) ≡ f x (h xs)) →-                  ∀ xs → h xs ≡ foldr f e xs-foldr-universal h f e base step []       = base-foldr-universal h f e base step (x ∷ xs) rewrite step x xs = cong (f x) (foldr-universal h f e base step xs) --foldr-cong : ∀ {f g : a → b → b} {d e : b} →-            (∀ x y → f x y ≡ g x y) → d ≡ e →-             ∀ (xs : List a) → foldr f d xs ≡ foldr g e xs-foldr-cong f≡g d≡e []       = d≡e-foldr-cong f≡g d≡e (x ∷ xs) rewrite foldr-cong f≡g d≡e xs = f≡g x _--foldr-fusion : (h : b → c) {f : a → b → b} {g : a → c → c} (e : b) →-               (∀ x y → h (f x y) ≡ g x (h y)) →-               ∀ (xs : List a) → h (foldr f e xs) ≡ foldr g (h e) xs-foldr-fusion h {f} {g} e fuse =-  foldr-universal (h ∘ foldr f e) g (h e) refl-                  (λ x xs → fuse x (foldr f e xs))
− lib/Haskell/Law/Maybe.agda 
@@ -1,9 +0,0 @@-module Haskell.Law.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Maybe--open import Haskell.Law.Def--Just-injective : Injective (Just {a = a})-Just-injective refl = refl
− lib/Haskell/Law/Monad.agda 
@@ -1,7 +0,0 @@-module Haskell.Law.Monad where--open import Haskell.Law.Monad.Def    public-open import Haskell.Law.Monad.Either public-open import Haskell.Law.Monad.IO     public-open import Haskell.Law.Monad.List   public-open import Haskell.Law.Monad.Maybe  public
− lib/Haskell/Law/Monad/Def.agda 
@@ -1,46 +0,0 @@-module Haskell.Law.Monad.Def where--open import Haskell.Prim--open import Haskell.Prim.Applicative-open import Haskell.Prim.Functor-open import Haskell.Prim.Monad-open import Haskell.Prim.Monoid-open import Haskell.Prim.Tuple--open import Haskell.Law.Applicative--record IsLawfulMonad (F : Set → Set) ⦃ iMonadF : Monad F ⦄ : Set₁ where-  field-    overlap ⦃ super ⦄ : IsLawfulApplicative F--    -- Left identity: return a >>= k = k a-    leftIdentity : {a : Set} → (a' : a) (k : a → F b) → ((return a') >>= k) ≡ k a'--    -- Right identity: m >>= return = m-    rightIdentity : {a : Set} → (ma : F a) → (ma >>= return) ≡ ma--    -- Associativity: m >>= (\x -> k x >>= h) = (m >>= k) >>= h-    associativity : {a b c : Set} → (ma : F a) (f : a → F b) (g : b → F c)-      → (ma >>= (λ x → f x >>= g)) ≡ ((ma >>= f) >>= g)--    -- pure = return-    pureIsReturn : (a' : a) → pure a' ≡ (Monad.return iMonadF a')-    -- m1 <*> m2 = m1 >>= (\x1 -> m2 >>= (\x2 -> return (x1 x2)))-    sequence2bind : {a b : Set} → (mab : F (a → b)) (ma : F a)-      → (mab <*> ma) ≡ (mab >>= (λ x1 → (ma >>= (λ x2 → return (x1 x2)))))--    -- fmap f xs  =  xs >>= return . f-    fmap2bind : {a b : Set} → (f : a → b) (ma : F a)-      → fmap f ma ≡ (ma >>= (return ∘ f))-    -- (>>) = (*>)-    rSequence2rBind : (ma : F a) → (mb : F b) → (ma *> mb) ≡ (ma >> mb)--open IsLawfulMonad ⦃ ... ⦄ public--instance postulate-  iLawfulMonadFun : IsLawfulMonad (λ b → a → b)--  iLawfulMonadTuple₂ : ⦃ Monoid a ⦄ → Monad (a ×_)--  iLawfulMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monad (a × b ×_)
− lib/Haskell/Law/Monad/Either.agda 
@@ -1,34 +0,0 @@-module Haskell.Law.Monad.Either where--open import Haskell.Prim-open import Haskell.Prim.Either--open import Haskell.Prim.Monad--open import Haskell.Law.Monad.Def--open import Haskell.Law.Applicative.Either--instance-  iLawfulMonadEither : IsLawfulMonad (Either a)-  iLawfulMonadEither .leftIdentity _ _ = refl--  iLawfulMonadEither .rightIdentity = λ { (Left _) → refl; (Right _) → refl }--  iLawfulMonadEither .associativity = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }--  iLawfulMonadEither .pureIsReturn _ = refl--  iLawfulMonadEither .sequence2bind =-    λ { (Left _)  _         → refl-      ; (Right _) (Left _)  → refl-      ; (Right _) (Right _) → refl-      }--  iLawfulMonadEither .fmap2bind = λ { _ (Left _) → refl; _ (Right _) → refl }--  iLawfulMonadEither .rSequence2rBind =-    λ { (Left _)  _         → refl-      ; (Right _) (Left _)  → refl-      ; (Right _) (Right _) → refl-      }
− lib/Haskell/Law/Monad/IO.agda 
@@ -1,12 +0,0 @@-module Haskell.Law.Monad.IO where--open import Haskell.Prim-open import Haskell.Prim.IO--open import Haskell.Prim.Monad--open import Haskell.Law.Monad.Def--open import Haskell.Law.Applicative.IO--instance postulate iLawfulMonadIO : IsLawfulMonad IO
− lib/Haskell/Law/Monad/List.agda 
@@ -1,48 +0,0 @@-module Haskell.Law.Monad.List where--open import Haskell.Prim-open import Haskell.Prim.List--open import Haskell.Prim.Monad--open import Haskell.Law.Monad.Def-open import Haskell.Law.List--open import Haskell.Law.Applicative.List--instance-  iLawfulMonadList :  IsLawfulMonad List-  iLawfulMonadList .leftIdentity a k -    rewrite ++-[] (k a)-    = refl--  iLawfulMonadList .rightIdentity [] = refl-  iLawfulMonadList .rightIdentity (_ ∷ xs)-    rewrite rightIdentity xs-    = refl--  iLawfulMonadList .associativity [] f g = refl-  iLawfulMonadList .associativity (x ∷ xs) f g-    rewrite associativity xs f g-      | concatMap-++-distr (f x) (xs >>= f) g-    = refl  --  iLawfulMonadList .pureIsReturn _ = refl--  iLawfulMonadList .sequence2bind [] _ = refl-  iLawfulMonadList .sequence2bind (f ∷ fs) xs -    rewrite sequence2bind fs xs-      | map-concatMap f xs-    = refl--  iLawfulMonadList .fmap2bind f [] = refl-  iLawfulMonadList .fmap2bind f (_ ∷ xs)-    rewrite fmap2bind f xs-    = refl--  iLawfulMonadList .rSequence2rBind [] mb = refl-  iLawfulMonadList .rSequence2rBind (x ∷ ma) mb-    rewrite rSequence2rBind ma mb -      | map-id mb -    = refl-
− lib/Haskell/Law/Monad/Maybe.agda 
@@ -1,35 +0,0 @@-module Haskell.Law.Monad.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Maybe--open import Haskell.Prim.Monad--open import Haskell.Law.Monad.Def--open import Haskell.Law.Applicative.Maybe--instance-  iLawfulMonadMaybe : IsLawfulMonad Maybe-  iLawfulMonadMaybe .leftIdentity _ _ = refl--  iLawfulMonadMaybe .rightIdentity = λ { Nothing → refl; (Just _) → refl }--  iLawfulMonadMaybe .associativity = λ { Nothing _ _ → refl; (Just _) _ _ → refl }--  iLawfulMonadMaybe .pureIsReturn _ = refl--  iLawfulMonadMaybe .sequence2bind =-    λ { Nothing  _        → refl-      ; (Just _) Nothing  → refl-      ; (Just _) (Just _) → refl-      }--  iLawfulMonadMaybe .fmap2bind = λ { _ Nothing → refl; _ (Just _) → refl }--  iLawfulMonadMaybe .rSequence2rBind =-    λ { Nothing  _        → refl-      ; (Just _) Nothing  → refl-      ; (Just _) (Just _) → refl-      }-
− lib/Haskell/Law/Monoid.agda 
@@ -1,10 +0,0 @@-module Haskell.Law.Monoid where--open import Haskell.Law.Semigroup.Def    public-open import Haskell.Law.Semigroup.Either public-open import Haskell.Law.Semigroup.List   public-open import Haskell.Law.Semigroup.Maybe  public--open import Haskell.Law.Monoid.Def       public-open import Haskell.Law.Monoid.List      public-open import Haskell.Law.Monoid.Maybe     public
− lib/Haskell/Law/Monoid/Def.agda 
@@ -1,38 +0,0 @@-module Haskell.Law.Monoid.Def where--open import Haskell.Prim-open import Haskell.Prim.Tuple--open import Haskell.Prim.Foldable-open import Haskell.Prim.Monoid--open import Haskell.Law.Semigroup.Def--record IsLawfulMonoid (a : Set) ⦃ iMonoidA : Monoid a ⦄ : Set₁ where-  field-    overlap ⦃ super ⦄ : IsLawfulSemigroup a--    -- Right identity: x <> mempty = x-    rightIdentity : (x : a) → x <> mempty ≡ x--    -- Left identity: mempty <> x = x-    leftIdentity : (x : a) → mempty <> x ≡ x--    -- Concatenation: mconcat = foldr (<>) mempty-    concatenation : (xs : List a) → mconcat xs ≡ foldr _<>_ mempty xs--open IsLawfulMonoid ⦃ ... ⦄ public--postulate instance-  iLawfulMonoidFun : ⦃ iSemB : Monoid b ⦄ → ⦃ IsLawfulMonoid b ⦄ → IsLawfulMonoid (a → b)--  iLawfulMonoidUnit : IsLawfulMonoid ⊤--  iLawfulMonoidTuple₂ : ⦃ iSemA : Monoid a ⦄ ⦃ iSemB : Monoid b ⦄-                      → ⦃ IsLawfulMonoid a ⦄ → ⦃ IsLawfulMonoid b ⦄-                      → IsLawfulMonoid (a × b)--  iLawfulMonoidTuple₃ : ⦃ iSemA : Monoid a ⦄ ⦃ iSemB : Monoid b ⦄ ⦃ iSemC : Monoid c ⦄-                      → ⦃ IsLawfulMonoid a ⦄ → ⦃ IsLawfulMonoid b ⦄ → ⦃ IsLawfulMonoid c ⦄-                      → IsLawfulMonoid (a × b × c)-
− lib/Haskell/Law/Monoid/List.agda 
@@ -1,29 +0,0 @@-module Haskell.Law.Monoid.List where--open import Haskell.Prim-open import Haskell.Prim.List--open import Haskell.Prim.Monoid--open import Haskell.Law.List-open import Haskell.Law.Monoid.Def-open import Haskell.Law.Semigroup.Def-open import Haskell.Law.Semigroup.List--instance-  iLawfulMonoidList : IsLawfulMonoid (List a)-  iLawfulMonoidList .rightIdentity [] = refl-  iLawfulMonoidList .rightIdentity (x ∷ xs)-    rewrite ++-[] (x ∷ xs)-    = refl--  iLawfulMonoidList .leftIdentity [] = refl-  iLawfulMonoidList .leftIdentity (x ∷ xs)-    rewrite ++-[] (x ∷ xs)-    = refl--  iLawfulMonoidList .concatenation [] = refl-  iLawfulMonoidList .concatenation (x ∷ xs) -    rewrite ++-[] (x ∷ xs)-      | concatenation xs-    = refl
− lib/Haskell/Law/Monoid/Maybe.agda 
@@ -1,21 +0,0 @@-module Haskell.Law.Monoid.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Maybe--open import Haskell.Prim.Monoid--open import Haskell.Law.Monoid.Def-open import Haskell.Law.Semigroup.Def-open import Haskell.Law.Semigroup.Maybe--instance-  iLawfulMonoidMaybe : ⦃ iMonoidA : Monoid a ⦄ → ⦃ iLawfulMonoidA : IsLawfulMonoid a ⦄ → IsLawfulMonoid (Maybe a)-  iLawfulMonoidMaybe .rightIdentity = λ { Nothing → refl; (Just _) → refl }--  iLawfulMonoidMaybe .leftIdentity = λ { Nothing → refl; (Just _) → refl }--  iLawfulMonoidMaybe .concatenation [] = refl-  iLawfulMonoidMaybe .concatenation (x ∷ xs) -    rewrite (concatenation xs)-    = refl
− lib/Haskell/Law/Nat.agda 
@@ -1,51 +0,0 @@-module Haskell.Law.Nat where--open import Haskell.Prim-open import Haskell.Prim.Num--open import Haskell.Law.Def-open import Haskell.Law.Equality--suc-injective : Injective suc-suc-injective refl = refl--{-|-The canonical formalization of the-less-than-or-equal-to relation for natural numbers.--}-data _≤_ : Nat → Nat → Set where-  z≤n : ∀ {n}                 → zero  ≤ n-  s≤s : ∀ {m n} (m≤n : m ≤ n) → suc m ≤ suc n--≤-refl : ∀ (x : Nat) → x ≤ x-≤-refl zero    = z≤n-≤-refl (suc x) = s≤s (≤-refl x)--≤-antisym : ∀ {x y : Nat}-  → x ≤ y-  → y ≤ x-    ------  → x ≡ y-≤-antisym z≤n       z≤n       = refl-≤-antisym (s≤s x≤y) (s≤s y≤x) = cong suc (≤-antisym x≤y y≤x)--≤-trans : ∀ {x y z : Nat}-  → x ≤ y-  → y ≤ z-    ------  → x ≤ z-≤-trans z≤n y≤z = z≤n-≤-trans (s≤s x≤y) (s≤s y≤z) = s≤s (≤-trans x≤y y≤z)--x≤x+1 : ∀ (x : Nat) → x ≤ suc x-x≤x+1 zero    = z≤n-x≤x+1 (suc x) = s≤s (x≤x+1 x)--x+[y-x]≡y : ∀ (x y : Nat) → x ≤ y → x + monusNat y x ≡ y-x+[y-x]≡y   zero       y       x≤y  = refl-x+[y-x]≡y (suc x) (suc y) (s≤s x≤y) = cong suc (x+[y-x]≡y x y x≤y)--y-x≤y : ∀ (x y : Nat) → monusNat y x ≤ y-y-x≤y zero         y  = ≤-refl y-y-x≤y (suc x)   zero  = z≤n-y-x≤y (suc x) (suc y) = ≤-trans (y-x≤y x y) (x≤x+1 y)
− lib/Haskell/Law/Num.agda 
@@ -1,7 +0,0 @@-module Haskell.Law.Num where--open import Haskell.Law.Num.Def     public-open import Haskell.Law.Num.Int     public-open import Haskell.Law.Num.Integer public-open import Haskell.Law.Num.Nat     public-open import Haskell.Law.Num.Word    public
− lib/Haskell/Law/Num/Def.agda 
@@ -1,125 +0,0 @@-module Haskell.Law.Num.Def where--open import Haskell.Prim-open import Haskell.Prim.Num-open import Haskell.Prim.Integer--record IsLawfulNum (a : Set) ⦃ iNum : Num a ⦄ : Set₁ where-  field-    +-assoc : ∀ (x y z : a) → (x + y) + z ≡ x + (y + z)--    +-comm : ∀ (x y : a) → x + y ≡ y + x--    +-idˡ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 0}}-      → fromInteger 0 + x ≡ x-    +-idʳ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 0}}-      → x + fromInteger 0 ≡ x--    neg-inv : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 0}} {{@0 _ : Num.NegateOK iNum x}}-      → x + negate x ≡ fromInteger 0--    *-assoc : ∀ (x y z : a) → (x * y) * z ≡ x * (y * z)--    *-idˡ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 1}}-      → fromInteger 1 * x ≡ x-    *-idʳ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 1}}-      → x * fromInteger 1 ≡ x--    distributeˡ : ∀ (x y z : a) → x * (y + z) ≡ (x * y) + (x * z)-    distributeʳ : ∀ (x y z : a) → (y + z) * x ≡ (y * x) + (z * x)--    -- We are currently missing the following because toInteger is missing in our Prelude.-    -- "if the type also implements Integral, then fromInteger is a left inverse for toInteger, i.e. fromInteger (toInteger i) == i"-open IsLawfulNum ⦃ ... ⦄ public--open import Haskell.Law.Equality-open import Haskell.Law.Function--{-|-A number homomorphism establishes a homomorphism from one Num type a to another one b.-In particular, zero and one are mapped to zero and one in the other Num type,-and addition, multiplication, and negation are homorphic.--}-record NumHomomorphism (a b : Set) ⦃ iNuma : Num a ⦄ ⦃ iNumb : Num b ⦄ (φ : a → b) : Set where-  0ᵃ = Num.fromInteger iNuma (pos 0)-  0ᵇ = Num.fromInteger iNumb (pos 0)-  1ᵃ = Num.fromInteger iNuma (pos 1)-  1ᵇ = Num.fromInteger iNumb (pos 1)--  field-    +-hom : Homomorphism₂ _+_ _+_ φ-    *-hom : Homomorphism₂ _*_ _*_ φ-    ⦃ minus-ok ⦄       : ∀ {x y : a}     → ⦃ MinusOK x y ⦄               → MinusOK (φ x) (φ y)-    ⦃ negate-ok ⦄      : ∀ {x   : a}     → ⦃ NegateOK x ⦄                → NegateOK (φ x)-    ⦃ fromInteger-ok ⦄ : ∀ {i : Integer} → ⦃ Num.FromIntegerOK iNuma i ⦄ → Num.FromIntegerOK iNumb i-    0-hom : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 0) ⦄ → φ 0ᵃ ≡ 0ᵇ-    1-hom : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 1) ⦄ → φ 1ᵃ ≡ 1ᵇ-    negate-hom : ∀ (x : a) → ⦃ @0 _ : Num.NegateOK iNuma x ⦄ → φ (negate x) ≡ negate (φ x) --Homomorphism₁ inlined for type instances--{-|-A number embedding is an invertible number homomorphism.--}-record NumEmbedding (a b : Set) ⦃ iNuma : Num a ⦄ ⦃ iNumb : Num b ⦄ (φ : a → b) (φ⁻¹ : b → a) : Set where-  field-    hom   : NumHomomorphism a b φ-    embed : φ⁻¹ ∘ φ ≗ id--  open NumHomomorphism hom--  +-Embedding₂ : Embedding₂ _+_ _+_ φ φ⁻¹-  Embedding₂.hom   +-Embedding₂ = +-hom-  Embedding₂.embed +-Embedding₂ = embed--  *-Embedding₂ : Embedding₂ _*_ _*_ φ φ⁻¹-  Embedding₂.hom   *-Embedding₂ = *-hom-  Embedding₂.embed *-Embedding₂ = embed--  +-MonoidEmbedding₂ : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 0) ⦄ → MonoidEmbedding₂ _+_ _+_ φ φ⁻¹ 0ᵃ 0ᵇ-  MonoidEmbedding₂.embedding +-MonoidEmbedding₂ = +-Embedding₂-  MonoidEmbedding₂.0-hom     +-MonoidEmbedding₂ = 0-hom--  *-MonoidEmbedding₂ : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 1) ⦄ → MonoidEmbedding₂ _*_ _*_ φ φ⁻¹ 1ᵃ 1ᵇ-  MonoidEmbedding₂.embedding *-MonoidEmbedding₂ = *-Embedding₂-  MonoidEmbedding₂.0-hom     *-MonoidEmbedding₂ = 1-hom--{-|-Given an embedding from one number type a onto another one b,-we can conclude that b satisfies the laws of Num if a satisfies the-laws of Num.--}-map-IsLawfulNum : ∀ {a b : Set} ⦃ iNuma : Num a ⦄ ⦃ iNumb : Num b ⦄-  → (a2b : a → b) (b2a : b → a)-  → NumEmbedding a b a2b b2a-  → IsLawfulNum b-    ------------------------  → IsLawfulNum a-map-IsLawfulNum {a} {b} {{numa}} {{numb}} f g proj lawb =-  record-  { +-assoc = map-assoc _+ᵃ_ _+ᵇ_ f g +-Embedding₂ (+-assoc lawb)-  ; +-comm  = map-comm  _+ᵃ_ _+ᵇ_ f g +-Embedding₂ (+-comm lawb)-  ; +-idˡ = λ x → map-idˡ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ +-MonoidEmbedding₂ (λ y → +-idˡ lawb y) x-  ; +-idʳ = λ x → map-idʳ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ +-MonoidEmbedding₂ (λ y → +-idʳ lawb y) x-  ; neg-inv = map-neg-inv-  ; *-assoc = map-assoc _*ᵃ_ _*ᵇ_ f g *-Embedding₂ (*-assoc lawb)-  ; *-idˡ = λ x → map-idˡ _*ᵃ_ _*ᵇ_ f g 1ᵃ 1ᵇ *-MonoidEmbedding₂ (λ y → *-idˡ lawb y) x-  ; *-idʳ = λ x → map-idʳ _*ᵃ_ _*ᵇ_ f g 1ᵃ 1ᵇ *-MonoidEmbedding₂ (λ y → *-idʳ lawb y) x-  ; distributeˡ = map-distributeˡ _+ᵃ_ _+ᵇ_ _*ᵃ_ _*ᵇ_ f g embed +-hom *-hom (distributeˡ lawb)-  ; distributeʳ = map-distributeʳ _+ᵃ_ _+ᵇ_ _*ᵃ_ _*ᵇ_ f g embed +-hom *-hom (distributeʳ lawb)-  }-  where-    open NumEmbedding proj-    open NumHomomorphism hom-    open IsLawfulNum lawb-    open Num numa renaming (_+_ to _+ᵃ_; _*_ to _*ᵃ_; negate to negateᵃ)-    open Num numb renaming (_+_ to _+ᵇ_; _*_ to _*ᵇ_; negate to negateᵇ)--    map-neg-inv : ∀ (x : a) ⦃ @0 _ : Num.FromIntegerOK numa (pos 0) ⦄ ⦃ @0 _ : Num.NegateOK numa x ⦄-      → x +ᵃ negateᵃ x ≡ 0ᵃ-    map-neg-inv x =-      x +ᵃ negateᵃ x           ≡˘⟨ embed (x +ᵃ negateᵃ x) ⟩-      g (f (x +ᵃ negateᵃ x))   ≡⟨ cong g (+-hom x (negateᵃ x)) ⟩-      g (f x +ᵇ f (negateᵃ x)) ≡⟨ cong g (cong (f x +ᵇ_) (negate-hom x)) ⟩-      g (f x +ᵇ negateᵇ (f x)) ≡⟨ cong g (neg-inv lawb (f x)) ⟩-      g 0ᵇ                     ≡˘⟨ cong g 0-hom ⟩-      g (f 0ᵃ)                 ≡⟨ embed 0ᵃ ⟩-      0ᵃ ∎
− lib/Haskell/Law/Num/Int.agda 
@@ -1,27 +0,0 @@-module Haskell.Law.Num.Int where--open import Haskell.Prim using (refl; tt)-open import Haskell.Prim.Num-open import Haskell.Prim.Int-open import Haskell.Prim.Word--open import Haskell.Law.Num.Def-open import Haskell.Law.Num.Word--instance-  open NumHomomorphism-  open NumEmbedding--  iNumEmbeddingIntWord : NumEmbedding Int Word intToWord int64-  +-hom          (hom iNumEmbeddingIntWord) (int64 _) (int64 _) = refl-  *-hom          (hom iNumEmbeddingIntWord) (int64 _) (int64 _) = refl-  minus-ok       (hom iNumEmbeddingIntWord) = tt-  negate-ok      (hom iNumEmbeddingIntWord) = tt-  fromInteger-ok (hom iNumEmbeddingIntWord) = tt-  0-hom          (hom iNumEmbeddingIntWord) = refl-  1-hom          (hom iNumEmbeddingIntWord) = refl-  negate-hom     (hom iNumEmbeddingIntWord) (int64 _) = refl-  embed               iNumEmbeddingIntWord  (int64 _) = refl--  iLawfulNumInt : IsLawfulNum Int-  iLawfulNumInt = map-IsLawfulNum intToWord int64 iNumEmbeddingIntWord iLawfulNumWord
− lib/Haskell/Law/Num/Integer.agda 
@@ -1,297 +0,0 @@-module Haskell.Law.Num.Integer where--open import Haskell.Prim-open import Haskell.Prim.Num-open import Haskell.Prim.Integer--open import Haskell.Law.Equality-open import Haskell.Law.Num.Def-open import Haskell.Law.Num.Nat---- Open the internal definitions because--- these must be transparent for proofs.-open Haskell.Prim.Integer.Internal--addInteger-idˡ : ∀ (x : Integer) → 0 + x ≡ x-addInteger-idˡ (pos _)    = refl-addInteger-idˡ (negsuc _) = cong negsuc refl--addInteger-idʳ : ∀ (x : Integer) → x + 0 ≡ x-addInteger-idʳ (pos n)    = cong pos    $ addNat-idʳ n-addInteger-idʳ (negsuc _) = cong negsuc refl--mulInteger-idˡ : ∀ (x : Integer) → 1 * x ≡ x-mulInteger-idˡ (pos x)    = cong pos    (addNat-idʳ x)-mulInteger-idˡ (negsuc x) = cong negsuc (addNat-idʳ x)--mulInteger-idʳ : ∀ (x : Integer) → x * 1 ≡ x-mulInteger-idʳ (pos x)    = cong pos    (mulNat-idʳ x)-mulInteger-idʳ (negsuc x) = cong negsuc (mulNat-idʳ x)--subNat-refl : ∀ (x : Nat) → subNat x x ≡ 0-subNat-refl zero    = refl-subNat-refl (suc x) = subNat-refl x--n-n≡0-Nat : ∀ (x y : Nat) → subNat (x + y) x ≡ pos y-n-n≡0-Nat x       zero    rewrite addNat-idʳ x = subNat-refl x-n-n≡0-Nat zero    (suc _) = refl-n-n≡0-Nat (suc x) (suc y) = n-n≡0-Nat x (suc y)--n-n≡0-Integer : ∀ (x : Integer) → x + (negateInteger x) ≡ 0-n-n≡0-Integer (pos zero)    = refl-n-n≡0-Integer (pos (suc x)) = subNat-refl x-n-n≡0-Integer (negsuc x)    = subNat-refl x--mulInteger-zeroˡ : ∀ (x : Integer) → 0 * x ≡ 0-mulInteger-zeroˡ (pos _)    = refl-mulInteger-zeroˡ (negsuc _) = refl--mulInteger-zeroʳ : ∀ (x : Integer) → x * 0 ≡ 0-mulInteger-zeroʳ (pos n)    = cong pos (mulNat-zeroʳ n)-mulInteger-zeroʳ (negsuc n) rewrite mulNat-zeroʳ n = refl--addInteger-comm : ∀ (x y : Integer) → x + y ≡ y + x-addInteger-comm (pos x)    (pos y)    = cong pos (addNat-comm x y)-addInteger-comm (pos _)    (negsuc _) = refl-addInteger-comm (negsuc _) (pos _)    = refl-addInteger-comm (negsuc x) (negsuc y) = cong negsuc (cong suc (addNat-comm x y))--subNat|x-[y+z]≡x-y-z : ∀ (x y z : Nat) → subNat x (y + suc z) ≡ subNat x y + negsuc z-subNat|x-[y+z]≡x-y-z _       zero    _ = refl-subNat|x-[y+z]≡x-y-z zero    (suc y) z = cong negsuc (addNat-suc y z)-subNat|x-[y+z]≡x-y-z (suc x) (suc y) z = subNat|x-[y+z]≡x-y-z x y z--subNat|x-y+z≡[x+z]-y : ∀ (x y z : Nat) → subNat x y + pos (suc z) ≡ subNat (x + suc z) y-subNat|x-y+z≡[x+z]-y _       zero    _ = refl-subNat|x-y+z≡[x+z]-y zero    (suc _) _ = refl-subNat|x-y+z≡[x+z]-y (suc x) (suc y) z = subNat|x-y+z≡[x+z]-y x y z--subNat-cong-suc : ∀ (x y : Nat) → subNat (suc x) y ≡ pos 1 + subNat x y-subNat-cong-suc _       zero    = refl-subNat-cong-suc zero    (suc _) = refl-subNat-cong-suc (suc x) (suc y) = subNat-cong-suc x y--subNat|x+[y-z]≡[1+x]+[y-[1+z]] : ∀ (x y z : Nat) → pos x + subNat y z ≡ pos (suc x) + subNat y (suc z)-subNat|x+[y-z]≡[1+x]+[y-[1+z]] x zero    zero    = cong pos (addNat-idʳ x)-subNat|x+[y-z]≡[1+x]+[y-[1+z]] x (suc y) zero    = cong pos (addNat-suc x y)-subNat|x+[y-z]≡[1+x]+[y-[1+z]] _ zero    (suc _) = refl-subNat|x+[y-z]≡[1+x]+[y-[1+z]] x (suc y) (suc z) = subNat|x+[y-z]≡[1+x]+[y-[1+z]] x y z--subNat|x-y+[1+z]≡[1+x]+[z-y] : ∀ (x y z : Nat) → subNat x y + pos (suc z) ≡ pos (suc x) + subNat z y-subNat|x-y+[1+z]≡[1+x]+[z-y] x       zero    z    = cong pos (addNat-suc x z)-subNat|x-y+[1+z]≡[1+x]+[z-y] zero    (suc _) zero = refl-subNat|x-y+[1+z]≡[1+x]+[z-y] zero    (suc y) (suc z) = subNat-cong-suc z y-subNat|x-y+[1+z]≡[1+x]+[z-y] (suc x) (suc y) z       =-  subNat x y + pos (suc z)             ≡⟨ subNat|x-y+[1+z]≡[1+x]+[z-y] x y z ⟩-  pos (suc x)       + subNat z y       ≡⟨ subNat|x+[y-z]≡[1+x]+[y-[1+z]] (suc x) z y ⟩-  pos (suc (suc x)) + subNat z (suc y) ∎--subNat|[1+x+y]-z≡[1+x]+[y-z] : ∀ (x y z : Nat) → subNat (suc x + y) z ≡ pos (suc x) + subNat y z-subNat|[1+x+y]-z≡[1+x]+[y-z] _ _       zero    = refl-subNat|[1+x+y]-z≡[1+x]+[y-z] x zero    (suc z) = cong (λ eq → subNat eq z) (addNat-idʳ x)-subNat|[1+x+y]-z≡[1+x]+[y-z] x (suc y) (suc z) =-  subNat (x + suc y) z     ≡⟨ sym (subNat|x-y+z≡[x+z]-y x z y) ⟩-  subNat x z + pos (suc y) ≡⟨ subNat|x-y+[1+z]≡[1+x]+[z-y] x z y ⟩-  pos (suc x) + subNat y z ∎--subNat|x-y+[-[1+z]]≡x-z+[-[1+y]] : ∀ (x y z : Nat) → subNat x y + negsuc z ≡ subNat x z + negsuc y-subNat|x-y+[-[1+z]]≡x-z+[-[1+y]] x y z = begin-  subNat x y + negsuc z ≡⟨ sym (subNat|x-[y+z]≡x-y-z x y z) ⟩-  subNat x (y + suc z)  ≡⟨ cong (subNat x) (addNat-comm y (suc z)) ⟩-  subNat x (suc z + y)  ≡⟨ cong (subNat x) (sym (addNat-suc z y)) ⟩-  subNat x (z + suc y)  ≡⟨ subNat|x-[y+z]≡x-y-z x z y ⟩-  subNat x z + negsuc y ∎--subNat-cong-+ : ∀ (x y z : Nat) → subNat (x + y) (x + z) ≡ subNat y z-subNat-cong-+ x       y zero rewrite addNat-idʳ x = n-n≡0-Nat x y-subNat-cong-+ zero    _ (suc _) = refl-subNat-cong-+ (suc x) y (suc z) = subNat-cong-+ x y (suc z)--subNat-distrib-minus : ∀ (m n o : Nat) → subNat n o * pos m ≡ subNat (n * m) (o * m)-subNat-distrib-minus _       _       zero    = refl-subNat-distrib-minus zero    zero    (suc o) rewrite mulNat-zeroʳ o = refl-subNat-distrib-minus (suc _) zero    (suc _) = refl-subNat-distrib-minus zero    (suc n) (suc o) rewrite mulNat-zeroʳ o | mulInteger-zeroʳ (subNat n o) | mulNat-zeroʳ n = refl-subNat-distrib-minus (suc m) (suc n) (suc o) =-  subNat n o * (pos (suc m))                 ≡⟨ subNat-distrib-minus (suc m) n o ⟩-  subNat      (n * suc m)       (o * suc m)  ≡⟨ sym (subNat-cong-+ m (n * suc m) (o * suc m)) ⟩-  subNat (m + (n * suc m)) (m + (o * suc m)) ∎--subNat-mult-flip-negsuc : ∀ (m n o : Nat) → subNat o n * negsuc m ≡ subNat n o * pos (suc m)-subNat-mult-flip-negsuc _ zero    zero    = refl-subNat-mult-flip-negsuc _ zero    (suc _) = refl-subNat-mult-flip-negsuc _ (suc _) zero    = refl-subNat-mult-flip-negsuc m (suc n) (suc o) = subNat-mult-flip-negsuc m n o--subNat-distrib-minus-cong-+ : ∀ (m n o : Nat) → subNat o n * (pos (suc m)) ≡ subNat (m + (o * suc m)) (m + (n * suc m))-subNat-distrib-minus-cong-+ m n o = begin-  subNat o n * (pos (suc m))                 ≡⟨ subNat-distrib-minus (suc m) o n ⟩-  subNat (o * suc m) (n * suc m)             ≡⟨ sym (subNat-cong-+ m (o * suc m) (n * suc m)) ⟩-  subNat (m + (o * suc m)) (m + (n * suc m)) ∎---addInteger-assoc : ∀ (x y z : Integer) → (x + y) + z ≡ x + (y + z)-addInteger-assoc (pos zero) j k rewrite addInteger-idˡ      j  | addInteger-idˡ (j + k) = refl-addInteger-assoc i (pos zero) k rewrite addInteger-idʳ  i      | addInteger-idˡ      k  = refl-addInteger-assoc i j (pos zero) rewrite addInteger-idʳ (i + j) | addInteger-idʳ  j      = refl-addInteger-assoc (negsuc m) (negsuc n) (pos (suc o)) =-  (negsuc m + negsuc n) + pos (suc o)       ≡⟨⟩-  negsuc (suc (m + n)) + pos (suc o)        ≡⟨⟩-  subNat o (suc m + n)                      ≡⟨ cong (subNat o) (addNat-comm (suc m) n) ⟩-  subNat o (n + suc m)                      ≡⟨ subNat|x-[y+z]≡x-y-z o n m ⟩-  subNat o n + negsuc m                     ≡⟨ addInteger-comm (subNat o n) (negsuc m) ⟩-  negsuc m + subNat o n                     ≡⟨⟩-  negsuc m + (negsuc n + pos (suc o))       ∎-addInteger-assoc (negsuc m) (pos (suc n)) (pos (suc o)) =-  (negsuc m + pos (suc n)) + pos (suc o)    ≡⟨⟩-  subNat n m + pos (suc o)                  ≡⟨ subNat|x-y+z≡[x+z]-y n m o ⟩-  subNat (n + suc o) m                      ≡⟨⟩-  negsuc m + pos (suc (n + suc o))          ≡⟨⟩-  negsuc m + (pos (suc n) + pos (suc o))    ∎-addInteger-assoc (pos (suc m)) (negsuc n) (negsuc o) =-  (pos (suc m) + negsuc n) + negsuc o       ≡⟨⟩-  subNat m n + negsuc o                     ≡⟨ sym $ subNat|x-[y+z]≡x-y-z m n o ⟩-  subNat m (n + suc o)                      ≡⟨ cong (subNat m) (addNat-suc n o) ⟩-  subNat m (suc (n + o))                    ≡⟨⟩-  pos (suc m) + (negsuc (suc (n + o)))      ≡⟨⟩-  pos (suc m) + (negsuc n + negsuc o)       ∎-addInteger-assoc (pos (suc m)) (negsuc n) (pos (suc o)) =-  (pos (suc m) + negsuc n) + pos (suc o)    ≡⟨⟩-  subNat m n + pos (suc o)                  ≡⟨ subNat|x-y+[1+z]≡[1+x]+[z-y] m n o ⟩-  pos (suc m) + subNat o n                  ≡⟨⟩-  pos (suc m) + (negsuc n + pos (suc o))    ∎-addInteger-assoc (pos (suc x)) (pos (suc y)) (negsuc z) = begin-  (pos (suc x) + pos (suc y)) + negsuc z    ≡⟨⟩-  pos (suc (x + (suc y))) + negsuc z        ≡⟨ cong (_+ negsuc z) (cong pos (cong suc (addNat-suc x y))) ⟩-  pos (suc (suc (x + y))) + negsuc z        ≡⟨⟩-  subNat (suc (x + y)) z                    ≡⟨⟩-  subNat (suc  x + y)  z                    ≡⟨ subNat|[1+x+y]-z≡[1+x]+[y-z] x y z ⟩-  pos (suc x) + subNat y z                  ≡⟨⟩-  pos (suc x) + (pos (suc y)   + negsuc z)  ∎-addInteger-assoc (negsuc m) (negsuc n) (negsuc o) = cong negsuc $ cong suc $-  suc ((m + n) + o)                         ≡⟨ cong suc (addNat-assoc m n o) ⟩-  suc (m + (n + o))                         ≡⟨ sym (addNat-suc m (n + o)) ⟩-  m + (suc (n + o))                         ∎-addInteger-assoc (negsuc m) (pos (suc n)) (negsuc o) =-  (negsuc m + pos (suc n)) + negsuc o       ≡⟨⟩-  subNat n m + negsuc o                     ≡⟨ subNat|x-y+[-[1+z]]≡x-z+[-[1+y]] n m o ⟩-  subNat n o + negsuc m                     ≡⟨ addInteger-comm (subNat n o) (negsuc m) ⟩-  negsuc m + subNat n o                     ≡⟨⟩-  negsuc m + (pos (suc n) - pos (suc o))    ∎-addInteger-assoc (pos (suc m)) (pos (suc n)) (pos (suc o)) = cong pos (addNat-assoc (suc m) (suc n) (suc o))--distribute-1ˡ : ∀ (x y : Nat) → x * (1 + y) ≡ x + (y * x)-distribute-1ˡ x y = begin-  x * (suc y) ≡⟨ mulNat-suc x y ⟩-  x + (x * y) ≡⟨ cong (x +_) (mulNat-comm x y) ⟩-  x + (y * x) ∎--mulInteger-comm : ∀ (x y : Integer) → x * y ≡ y * x-mulInteger-comm (pos x)    (pos y)    = cong pos (mulNat-comm x y)-mulInteger-comm (pos x)    (negsuc y) = cong negNat $       distribute-1ˡ x y-mulInteger-comm (negsuc x) (pos y)    = cong negNat $ sym $ distribute-1ˡ y x-mulInteger-comm (negsuc x) (negsuc y) = cong pos $ cong suc $-  y + (x * (suc y)) ≡⟨ cong (y +_) (distribute-1ˡ x y) ⟩-  y + (x + (y * x)) ≡⟨ cong (y +_) (cong (x +_) (mulNat-comm y x)) ⟩-  y + (x + (x * y)) ≡⟨ sym (addNat-assoc y x (x * y)) ⟩-  (y + x) + (x * y) ≡⟨ cong (_+ x * y) (addNat-comm y x) ⟩-  (x + y) + (x * y) ≡⟨ addNat-assoc x y (x * y) ⟩-  x + (y + (x * y)) ≡⟨ cong (x +_) (sym (distribute-1ˡ y x)) ⟩-  x + (y * (suc x)) ∎--distrib-lemma : ∀ (m n o : Nat) → suc (m + ((n + o) * suc m)) ≡ (n * suc m) + (suc (m + (o * suc m)))-distrib-lemma m n o =-  suc (m + ((n + o) * suc m))             ≡⟨ cong suc (cong (m +_) (mulNat-distributeʳ-addNat (suc m) n o)) ⟩-  suc (m + ((n * suc m)   + (o * suc m))) ≡⟨⟩-   suc m + ((n * suc m)   + (o * suc m))  ≡⟨ sym (addNat-assoc (suc m) (n * suc m) (o * suc m) ) ⟩-  (suc m +  (n * suc m))  + (o * suc m)   ≡⟨ cong (_+ o * suc m) (addNat-comm (suc m) (n * suc m)) ⟩-  ((n * suc m) +  suc  m) + (o * suc m)   ≡⟨ addNat-assoc (n * suc m) (suc m) (o * suc m) ⟩-   (n * suc m) + (suc (m  + (o * suc m))) ∎--distrib-lemma2 : ∀ (m n o : Nat) → m + ((n * suc m) + (suc m + (o * suc m))) ≡ suc ((m + (n * suc m)) + (m + (o * suc m)))-distrib-lemma2 m n o =-   m + (    (n * suc m) + (suc  m + (o * suc m))) ≡⟨⟩-   m + (    (n * suc m) +  suc (m + (o * suc m))) ≡⟨ sym (addNat-assoc m (n * suc m) (suc (m + (o * suc m)))) ⟩-  (m +      (n * suc m)) + suc (m + (o * suc m))  ≡⟨ addNat-suc (m + (n * suc m)) (m + (o * suc m)) ⟩-  suc ((m + (n * suc m)) +     (m + (o * suc m))) ∎--mulInteger-distributeʳ-addInteger : ∀ (x y z : Integer) → (y + z) * x ≡ (y * x) + (z * x)-mulInteger-distributeʳ-addInteger (pos zero) j k rewrite mulInteger-zeroʳ j | mulInteger-zeroʳ k | mulInteger-zeroʳ (j + k) = refl-mulInteger-distributeʳ-addInteger i (pos zero) k rewrite addInteger-idˡ k   | mulInteger-zeroˡ i | addInteger-idˡ   (k * i) = refl-mulInteger-distributeʳ-addInteger i j (pos zero) rewrite addInteger-idʳ j   | mulInteger-zeroˡ i | addInteger-idʳ   (j * i) = refl-mulInteger-distributeʳ-addInteger (negsuc m)    (negsuc n)    (pos (suc o)) = begin-  subNat o n * negsuc m                      ≡⟨ subNat-mult-flip-negsuc m n o ⟩-  subNat n o * pos (suc m)                   ≡⟨ subNat-distrib-minus-cong-+ m o n ⟩-  subNat (m + (n * suc m)) (m + (o * suc m)) ∎-mulInteger-distributeʳ-addInteger (negsuc m)    (pos (suc n)) (pos (suc o)) = cong negsuc $ begin-  m + ((n + suc o) * suc m)                       ≡⟨ cong (m +_) (mulNat-distributeʳ-addNat (suc m) n (suc o)) ⟩-  m + (     (n * suc m) + (suc m + (o * suc m)))  ≡⟨ distrib-lemma2 m n o ⟩-  suc ((m + (n * suc m)) +     (m + (o * suc m))) ∎ -- Y-mulInteger-distributeʳ-addInteger (pos (suc m)) (negsuc n)    (negsuc o)    = cong negsuc $ begin-  m + (suc (m + ((n + o) * suc m)))               ≡⟨⟩-  m + (suc m  + ((n + o) * suc m))                ≡⟨ cong (m +_) (distrib-lemma m n o) ⟩-  m + (     (n * suc m) + (suc m + (o * suc m)))  ≡⟨ distrib-lemma2 m n o ⟩-  suc ((m + (n * suc m)) + (m + (o * suc m)))     ∎ -- Y-mulInteger-distributeʳ-addInteger (pos (suc m)) (negsuc n)    (pos (suc o)) = subNat-distrib-minus-cong-+ m n o-mulInteger-distributeʳ-addInteger (pos (suc m)) (pos (suc n)) (negsuc o)    = subNat-distrib-minus-cong-+ m o n-mulInteger-distributeʳ-addInteger (negsuc m)    (negsuc n)    (negsuc o)    = cong pos $ cong suc $-  m + (suc (m + ((n + o) * suc m)))           ≡⟨⟩-  m + (suc m  + ((n + o) * suc m))            ≡⟨ cong (m +_) (distrib-lemma m n o) ⟩-  m + ((n * suc m) + (suc m  + (o * suc m)))  ≡⟨ sym (addNat-assoc m (n * suc m) (suc m + (o * suc m))) ⟩-  (m + (n * suc m)) + (suc (m + (o * suc m))) ∎ -- X-mulInteger-distributeʳ-addInteger (negsuc m)    (pos (suc n)) (negsuc o)    =-  subNat n o * negsuc m                      ≡⟨ subNat-mult-flip-negsuc m o n ⟩-  subNat o n * pos (suc m)                   ≡⟨ subNat-distrib-minus-cong-+ m n o ⟩-  subNat (m + (o * suc m)) (m + (n * suc m)) ∎-mulInteger-distributeʳ-addInteger (pos (suc m)) (pos (suc n)) (pos (suc o)) = cong pos $ cong suc $-  m + ((n + suc o) * suc m)                   ≡⟨ cong (m +_) (mulNat-distributeʳ-addNat (suc m) n (suc o)) ⟩-  m + ((n * suc m) + (suc m  + (o * suc m)))  ≡⟨ sym (addNat-assoc m (n * suc m) (suc m + (o * suc m))) ⟩-  (m + (n * suc m)) + (suc m  + (o * suc m))  ≡⟨⟩-  (m + (n * suc m)) + (suc (m + (o * suc m))) ∎ -- X--mulInteger-distributeˡ-addInteger : ∀ (x y z : Integer) → x * (y + z) ≡ (x * y) + (x * z)-mulInteger-distributeˡ-addInteger x y z-  -- This proof works the very same as addNat-distributeˡ-mulNat.-  rewrite (mulInteger-comm x (y + z)) -- makes or goal become: (y + z) * x ≡ (x * y) + (x * z)-  rewrite (mulInteger-comm x y)       -- makes or goal become: (y + z) * x ≡ (y * x) + (x * z)-  rewrite (mulInteger-comm x z)       -- makes or goal become: (y + z) * x ≡ (y * x) + (z * x)-  = mulInteger-distributeʳ-addInteger x y z--mulInteger-assoc-lemma-2 : ∀ (m n o : Nat) → (n + m * suc n) * suc o ≡ (n * suc o) + (m * suc (o + (n * suc o)))-mulInteger-assoc-lemma-2 m n o =            begin-  (n + (m * suc n)) * (suc o)               ≡⟨ mulNat-distributeʳ-addNat (suc o) n (m * suc n) ⟩-  (n * (suc o)) + ((m * suc n) * (suc o))   ≡⟨ cong (n * suc o +_) (mulNat-assoc m (suc n) (suc o)) ⟩-  (n * suc o) + (m * suc (o + (n * suc o))) ∎--mulInteger-assoc-lemma : ∀ (m n o : Nat)-  → o + ((n + m * suc n) * suc o) ≡ (o + (n * suc o)) + (m * suc (o + (n * suc o)))-mulInteger-assoc-lemma m n o =                      begin-    o + ((n + m * suc n) * suc o)                   ≡⟨ cong (o +_) (mulInteger-assoc-lemma-2 m n o) ⟩-    o + ((n * suc o) + (m * suc (o + (n * suc o)))) ≡⟨ sym (addNat-assoc o (n * suc o) (m * suc (o + (n * suc o)))) ⟩-    (o + (n * suc o)) + (m * suc (o + (n * suc o))) ∎--mulInteger-assoc : ∀ (x y z : Integer) → (x * y) * z ≡ x * (y * z)-mulInteger-assoc (pos zero) j k rewrite mulInteger-zeroˡ j | mulInteger-zeroˡ k | mulInteger-zeroˡ (j * k) = refl-mulInteger-assoc i (pos zero) k rewrite mulInteger-zeroʳ i | mulInteger-zeroˡ k | mulInteger-zeroʳ i       = refl-mulInteger-assoc i j (pos zero) rewrite mulInteger-zeroʳ j | mulInteger-zeroʳ i | mulInteger-zeroʳ (i * j) = refl-mulInteger-assoc (negsuc m)    (negsuc n)    (pos (suc o)) = cong pos (cong suc (mulInteger-assoc-lemma m n o))-mulInteger-assoc (negsuc m)    (pos (suc n)) (pos (suc o)) = cong negsuc        (mulInteger-assoc-lemma m n o)-mulInteger-assoc (pos (suc m)) (negsuc n)    (negsuc o)    = cong pos (cong suc (mulInteger-assoc-lemma m n o))-mulInteger-assoc (pos (suc m)) (negsuc n)    (pos (suc o)) = cong negsuc        (mulInteger-assoc-lemma m n o)-mulInteger-assoc (pos (suc m)) (pos (suc n)) (negsuc o)    = cong negsuc        (mulInteger-assoc-lemma m n o)-mulInteger-assoc (negsuc m)    (negsuc n)    (negsuc o)    = cong negsuc        (mulInteger-assoc-lemma m n o)-mulInteger-assoc (negsuc m)    (pos (suc n)) (negsuc o)    = cong pos (cong suc (mulInteger-assoc-lemma m n o))-mulInteger-assoc (pos (suc m)) (pos (suc n)) (pos (suc o)) = cong pos (cong suc (mulInteger-assoc-lemma m n o))--instance-  iLawfulNumInteger : IsLawfulNum Integer-  iLawfulNumInteger .IsLawfulNum.+-assoc = addInteger-assoc-  iLawfulNumInteger .IsLawfulNum.+-comm = addInteger-comm-  iLawfulNumInteger .IsLawfulNum.+-idˡ x = addInteger-idˡ x-  iLawfulNumInteger .IsLawfulNum.+-idʳ x = addInteger-idʳ x-  iLawfulNumInteger .IsLawfulNum.neg-inv x = n-n≡0-Integer x-  iLawfulNumInteger .IsLawfulNum.*-assoc = mulInteger-assoc -  iLawfulNumInteger .IsLawfulNum.*-idˡ x = mulInteger-idˡ x-  iLawfulNumInteger .IsLawfulNum.*-idʳ x = mulInteger-idʳ x-  iLawfulNumInteger .IsLawfulNum.distributeˡ = mulInteger-distributeˡ-addInteger-  iLawfulNumInteger .IsLawfulNum.distributeʳ = mulInteger-distributeʳ-addInteger
− lib/Haskell/Law/Num/Nat.agda 
@@ -1,103 +0,0 @@-module Haskell.Law.Num.Nat where--open import Haskell.Prim-open import Haskell.Prim.Num--open import Haskell.Law.Equality-open import Haskell.Law.Num.Def--addNat-suc : ∀ m n → m + suc n ≡ suc (m + n)-addNat-suc zero    n = refl-addNat-suc (suc m) n = cong suc (addNat-suc m n)--addNat-idˡ : ∀ (x : Nat) → 0 + x ≡ x-addNat-idˡ _ = refl--addNat-idʳ : ∀ (x : Nat) → x + 0 ≡ x-addNat-idʳ zero    = refl-addNat-idʳ (suc x) = cong suc (addNat-idʳ x)--addNat-comm : ∀ (x y : Nat) → x + y ≡ y + x-addNat-comm zero    y = sym (addNat-idʳ y)-addNat-comm (suc x) y = begin-  suc (x + y) ≡⟨ cong suc (addNat-comm x y) ⟩-  suc (y + x) ≡⟨ sym (addNat-suc y x) ⟩-  y + suc x   ∎--addNat-assoc : ∀ (x y z : Nat) → (x + y) + z ≡ x + (y + z)-addNat-assoc zero    _ _ = refl-addNat-assoc (suc m) n o = cong suc (addNat-assoc m n o)--mulNat-suc : ∀ (m n : Nat) → m * suc n ≡ m + m * n-mulNat-suc zero    n = refl-mulNat-suc (suc m) n = begin-  suc m * suc n         ≡⟨⟩-  suc n + m * suc n     ≡⟨ cong (suc n +_) (mulNat-suc m n) ⟩-  suc n + (m + m * n)   ≡⟨⟩-  suc (n + (m + m * n)) ≡⟨ cong suc (sym (addNat-assoc n m (m * n))) ⟩-  suc (n + m + m * n)   ≡⟨ cong (λ x → suc (x + m * n)) (addNat-comm n m) ⟩-  suc (m + n + m * n)   ≡⟨ cong suc (addNat-assoc m n (m * n)) ⟩-  suc (m + (n + m * n)) ≡⟨⟩-  suc m + suc m * n     ∎--mulNat-idˡ : ∀ (x : Nat) → 1 * x ≡ x-mulNat-idˡ = addNat-idʳ--mulNat-idʳ : ∀ (x : Nat) → x * 1 ≡ x-mulNat-idʳ zero    = refl-mulNat-idʳ (suc x) = cong suc (mulNat-idʳ x)--mulNat-zeroˡ : ∀ (x : Nat) → 0 * x ≡ 0-mulNat-zeroˡ _ = refl--mulNat-zeroʳ : ∀ (x : Nat) → x * 0 ≡ 0-mulNat-zeroʳ zero    = refl-mulNat-zeroʳ (suc x) = mulNat-zeroʳ x--mulNat-comm : ∀ (x y : Nat) → x * y ≡ y * x-mulNat-comm zero y    = sym (mulNat-zeroʳ y)-mulNat-comm (suc x) y = begin-  suc x * y  ≡⟨⟩-  y + x * y  ≡⟨ cong (y +_) (mulNat-comm x y) ⟩-  y + y * x  ≡⟨ sym (mulNat-suc y x) ⟩-  y * suc x  ∎--mulNat-distributeʳ-addNat : ∀ (x y z : Nat) → (y + z) * x ≡ (y * x) + (z * x)-mulNat-distributeʳ-addNat _ zero    _ = refl-mulNat-distributeʳ-addNat x (suc y) z = begin-  (suc y + z) * x     ≡⟨⟩-  x + (y + z) * x     ≡⟨ cong (x +_) (mulNat-distributeʳ-addNat x y z) ⟩-  x + (y * x + z * x) ≡⟨ sym (addNat-assoc x (y * x) (z * x)) ⟩-  x + y * x + z * x   ≡⟨⟩-  suc y * x + z * x   ∎--mulNat-distributeˡ-addNat : ∀ (x y z : Nat) → x * (y + z) ≡ (x * y) + (x * z)-mulNat-distributeˡ-addNat x y z-  -- This proof transform left distribution to right distribution by using commutativity of *.-  --                                 the initial goal is:  x * (y + z) ≡ (x * y) + (x * z)-  rewrite (mulNat-comm x (y + z)) -- makes or goal become: (y + z) * x ≡ (x * y) + (x * z)-  rewrite (mulNat-comm x y)       -- makes or goal become: (y + z) * x ≡ (y * x) + (x * z)-  rewrite (mulNat-comm x z)       -- makes or goal become: (y + z) * x ≡ (y * x) + (z * x)-  = mulNat-distributeʳ-addNat x y z--mulNat-assoc : ∀ (x y z : Nat) → (x * y) * z ≡ x * (y * z)-mulNat-assoc zero    _ _ = refl-mulNat-assoc (suc x) y z = begin-  (suc x * y) * z     ≡⟨⟩-  (y + x * y) * z     ≡⟨ mulNat-distributeʳ-addNat z y (x * y) ⟩-  y * z + (x * y) * z ≡⟨ cong (y * z +_) (mulNat-assoc x y z) ⟩-  y * z + x * (y * z) ≡⟨⟩-  suc x * (y * z)     ∎--instance-  iLawfulNumNat : IsLawfulNum Nat-  iLawfulNumNat .IsLawfulNum.+-assoc      = addNat-assoc-  iLawfulNumNat .IsLawfulNum.+-comm       = addNat-comm-  iLawfulNumNat .IsLawfulNum.+-idˡ x      = addNat-idˡ x-  iLawfulNumNat .IsLawfulNum.+-idʳ x      = addNat-idʳ x-  iLawfulNumNat .IsLawfulNum.neg-inv zero = refl -- inline this proof because it has not much use anyway I guess?-  iLawfulNumNat .IsLawfulNum.*-assoc      = mulNat-assoc-  iLawfulNumNat .IsLawfulNum.*-idˡ x      = mulNat-idˡ x-  iLawfulNumNat .IsLawfulNum.*-idʳ x      = mulNat-idʳ x-  iLawfulNumNat .IsLawfulNum.distributeˡ  = mulNat-distributeˡ-addNat-  iLawfulNumNat .IsLawfulNum.distributeʳ  = mulNat-distributeʳ-addNat
− lib/Haskell/Law/Num/Word.agda 
@@ -1,106 +0,0 @@-{-# OPTIONS --allow-unsolved-metas #-}-module Haskell.Law.Num.Word where--open import Haskell.Prim-open import Haskell.Prim.Num-open import Haskell.Prim.Word-open Haskell.Prim.Word.WordInternal--open import Haskell.Law.Equality-open import Haskell.Law.Function-open import Haskell.Law.Nat--open import Haskell.Law.Num.Def-open import Haskell.Law.Num.Nat--open Num iNumNat  renaming (_+_ to _+ⁿ_; _*_ to _*ⁿ_)-open Num iNumWord renaming (_+_ to _+ʷ_; _*_ to _*ʷ_)--postulate-  -- This is a reasonable axiom because there are more natural numbers than-  -- integer. More precisely, Words denote a finite subset of Integers.-  -- This means, there is am embedding of Words into Integers as stated by-  -- this axiom.-  n2w∘w2n≡id : ∀ (x : Word)           → n2w (w2n x) ≡ x--  -- Conversion of natural numbers to words is invertible as long as the-  -- natural is within word bounds.-  w2n∘n2w≡id : ∀ (x : Nat)  → x ≤ 2⁶⁴ → w2n (n2w x) ≡ x--  -- Definitions of word arithmetics are based on conversions to Nats.-  -- That conversion must be homomorphic w.r.t. to addition and multiplication-  -- to not break their properties.-  w2n-+-hom : Homomorphism₂ _+ʷ_ _+ⁿ_ w2n-  w2n-*-hom : Homomorphism₂ _*ʷ_ _*ⁿ_ w2n--  -- 2⁶⁴ is the upper bound of the ring that forms Words in Nats.-  max-int≡0 : n2w 2⁶⁴ ≡ 0--  -- Words are bounded. They can never be larger than 2⁶⁴.-  bounded : ∀ (x : Word) → w2n x ≤ 2⁶⁴--open MonoidEmbedding₂--+-wordsAsNats : MonoidEmbedding₂ addWord addNat w2n n2w 0 0-Embedding₂.hom   (embedding +-wordsAsNats) = w2n-+-hom-Embedding₂.embed (embedding +-wordsAsNats) = n2w∘w2n≡id-0-hom +-wordsAsNats = refl--*-wordsAsNats : MonoidEmbedding₂ mulWord mulNat w2n n2w 1 1-Embedding₂.hom   (embedding *-wordsAsNats) = w2n-*-hom-Embedding₂.embed (embedding *-wordsAsNats) = n2w∘w2n≡id-0-hom *-wordsAsNats = refl--addWord-idˡ : Identityˡ addWord 0-addWord-idˡ = map-idˡ addWord addNat w2n n2w 0 0 +-wordsAsNats addNat-idˡ--addWord-idʳ : Identityʳ addWord 0-addWord-idʳ = map-idʳ addWord addNat w2n n2w 0 0 +-wordsAsNats addNat-idʳ--addWord-comm : Commutative addWord-addWord-comm = map-comm addWord addNat w2n n2w (embedding +-wordsAsNats) addNat-comm--addWord-assoc : Associative addWord-addWord-assoc = map-assoc addWord addNat w2n n2w (embedding +-wordsAsNats) addNat-assoc --mulWord-comm : Commutative mulWord-mulWord-comm = map-comm mulWord mulNat w2n n2w (embedding *-wordsAsNats) mulNat-comm--mulWord-assoc : Associative mulWord-mulWord-assoc = map-assoc mulWord mulNat w2n n2w (embedding *-wordsAsNats) mulNat-assoc--mulWord-idˡ : Identityˡ mulWord 1-mulWord-idˡ = map-idˡ mulWord mulNat w2n n2w 1 1 *-wordsAsNats mulNat-idˡ--mulWord-idʳ : Identityʳ mulWord 1-mulWord-idʳ = map-idʳ mulWord mulNat w2n n2w 1 1 *-wordsAsNats mulNat-idʳ--mulWord-distributeˡ-addWord : Distributiveˡ addWord mulWord-mulWord-distributeˡ-addWord = map-distributeˡ addWord addNat mulWord mulNat w2n n2w n2w∘w2n≡id w2n-+-hom w2n-*-hom mulNat-distributeˡ-addNat--mulWord-distributeʳ-addWord : Distributiveʳ addWord mulWord-mulWord-distributeʳ-addWord = map-distributeʳ addWord addNat mulWord mulNat w2n n2w n2w∘w2n≡id w2n-+-hom w2n-*-hom mulNat-distributeʳ-addNat--neg-inv-word : ∀ (x : Word) → addWord x (negateWord x) ≡ 0-neg-inv-word x =-  x + negateWord x                               ≡⟨⟩-  n2w (w2n x + w2n (negateWord x))               ≡⟨⟩-  n2w (w2n x + w2n (n2w (monusNat 2⁶⁴ (w2n x)))) ≡⟨ cong n2w (cong (w2n x +_) (w2n∘n2w≡id (monusNat 2⁶⁴ (w2n x)) (y-x≤y (w2n x) 2⁶⁴))) ⟩-  n2w (w2n x + monusNat 2⁶⁴ (w2n x))             ≡⟨ cong n2w (x+[y-x]≡y (w2n x) 2⁶⁴ (bounded x)) ⟩-  n2w 2⁶⁴                                        ≡⟨ max-int≡0 ⟩-  0                                              ∎--instance-  open IsLawfulNum--  iLawfulNumWord : IsLawfulNum Word-  +-assoc iLawfulNumWord = addWord-assoc-  +-comm iLawfulNumWord = addWord-comm-  +-idˡ iLawfulNumWord = λ x → addWord-idˡ x-  +-idʳ iLawfulNumWord = λ x → addWord-idʳ x-  neg-inv iLawfulNumWord = λ x → neg-inv-word x-  *-assoc iLawfulNumWord = mulWord-assoc-  *-idˡ iLawfulNumWord = λ x → mulWord-idˡ x-  *-idʳ iLawfulNumWord = λ x → mulWord-idʳ x-  distributeˡ iLawfulNumWord = mulWord-distributeˡ-addWord-  distributeʳ iLawfulNumWord = mulWord-distributeʳ-addWord
− lib/Haskell/Law/Ord.agda 
@@ -1,6 +0,0 @@-module Haskell.Law.Ord where--open import Haskell.Law.Ord.Def      public-open import Haskell.Law.Ord.Bool     public-open import Haskell.Law.Ord.Maybe    public-open import Haskell.Law.Ord.Ordering public
− lib/Haskell/Law/Ord/Bool.agda 
@@ -1,68 +0,0 @@-module Haskell.Law.Ord.Bool where--open import Haskell.Prim-open import Haskell.Prim.Ord--open import Haskell.Law.Eq-open import Haskell.Law.Equality-open import Haskell.Law.Ord.Def--instance-  iLawfulOrdBool : IsLawfulOrd Bool--  iLawfulOrdBool .comparability False False = refl-  iLawfulOrdBool .comparability False True  = refl-  iLawfulOrdBool .comparability True  False = refl-  iLawfulOrdBool .comparability True  True  = refl--  iLawfulOrdBool .transitivity False False False _ = refl-  iLawfulOrdBool .transitivity False False True  _ = refl-  iLawfulOrdBool .transitivity False True  True  _ = refl-  iLawfulOrdBool .transitivity True  True  True  _ = refl--  iLawfulOrdBool .reflexivity False = refl-  iLawfulOrdBool .reflexivity True  = refl--  iLawfulOrdBool .antisymmetry False False _ = refl-  iLawfulOrdBool .antisymmetry True  True  _ = refl--  iLawfulOrdBool .lte2gte False False = refl-  iLawfulOrdBool .lte2gte False True  = refl-  iLawfulOrdBool .lte2gte True  False = refl-  iLawfulOrdBool .lte2gte True  True  = refl--  iLawfulOrdBool .lt2LteNeq False False = refl-  iLawfulOrdBool .lt2LteNeq False True  = refl-  iLawfulOrdBool .lt2LteNeq True  False = refl-  iLawfulOrdBool .lt2LteNeq True  True  = refl--  iLawfulOrdBool .lt2gt False False = refl-  iLawfulOrdBool .lt2gt False True  = refl-  iLawfulOrdBool .lt2gt True  False = refl-  iLawfulOrdBool .lt2gt True  True  = refl--  iLawfulOrdBool .compareLt False False = refl-  iLawfulOrdBool .compareLt False True  = refl-  iLawfulOrdBool .compareLt True  False = refl-  iLawfulOrdBool .compareLt True  True  = refl--  iLawfulOrdBool .compareGt False False = refl-  iLawfulOrdBool .compareGt False True  = refl-  iLawfulOrdBool .compareGt True  False = refl-  iLawfulOrdBool .compareGt True  True  = refl--  iLawfulOrdBool .compareEq False False = refl-  iLawfulOrdBool .compareEq False True  = refl-  iLawfulOrdBool .compareEq True  False = refl-  iLawfulOrdBool .compareEq True  True  = refl--  iLawfulOrdBool .min2if False False = refl-  iLawfulOrdBool .min2if False True  = refl-  iLawfulOrdBool .min2if True  False = refl-  iLawfulOrdBool .min2if True  True  = refl--  iLawfulOrdBool .max2if False False = refl-  iLawfulOrdBool .max2if False True  = refl-  iLawfulOrdBool .max2if True  False = refl-  iLawfulOrdBool .max2if True  True  = refl-
− lib/Haskell/Law/Ord/Def.agda 
@@ -1,203 +0,0 @@-module Haskell.Law.Ord.Def where--open import Haskell.Prim-open import Haskell.Prim.Ord-open import Haskell.Prim.Bool-open import Haskell.Prim.Int-open import Haskell.Prim.Word-open import Haskell.Prim.Integer-open import Haskell.Prim.Double-open import Haskell.Prim.Tuple-open import Haskell.Prim.Monoid-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Either--open import Haskell.Prim.Eq-open import Haskell.Law.Eq--open import Haskell.Law.Bool-open import Haskell.Law.Equality--record IsLawfulOrd (a : Set) ⦃ iOrd : Ord a ⦄ : Set₁ where-  field-    overlap ⦃ super ⦄ : IsLawfulEq a--    -- Comparability: x <= y || y <= x = True-    comparability : ∀ (x y : a) → (x <= y || y <= x) ≡ True--    -- Transitivity: if x <= y && y <= z = True, then x <= z = True-    transitivity :  ∀ ( x y z : a ) → ((x <= y) && (y <= z)) ≡ True → (x <= z) ≡ True--    -- Reflexivity: x <= x = True-    reflexivity : ∀ (x : a) → (x <= x) ≡ True--    -- Antisymmetry: if x <= y && y <= x = True, then x == y = True-    antisymmetry : ∀ (x y : a) → ((x <= y) && (y <= x)) ≡ True → (x == y) ≡ True--    -- x >= y = y <= x-    lte2gte : ∀ (x y : a) → (x <= y) ≡ (y >= x)--    -- x < y = x <= y && x /= y-    lt2LteNeq : ∀ (x y : a) → (x < y) ≡ (x <= y && x /= y)--    -- x > y = y < x-    lt2gt : ∀ (x y : a) → (x < y) ≡ (y > x)--    -- x < y = compare x y == LT-    compareLt : ∀ (x y : a) → (x < y) ≡ (compare x y == LT)--    -- x > y = compare x y == GT-    compareGt : ∀ (x y : a) → (x > y) ≡ (compare x y == GT)--    -- x == y = compare x y == EQ-    compareEq : ∀ (x y : a) → (x == y) ≡ (compare x y == EQ)--    -- min x y == if x <= y then x else y = True-    min2if : ∀ (x y : a) → ((min x y) == (if (x <= y) then x else y)) ≡ True--    -- max x y == if x >= y then x else y = True-    max2if : ∀ (x y : a) → ((max x y) == (if (x >= y) then x else y)) ≡ True--open IsLawfulOrd ⦃ ... ⦄ public------------------------------------------------------- Some more helper laws--eq2nlt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x == y) ≡ True → (x < y) ≡ False-eq2nlt x y h-  rewrite compareEq x y-    | compareLt x y-    | equality (compare x y) EQ h-  = refl--eq2ngt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x == y) ≡ True → (x > y) ≡ False-eq2ngt x y h-  rewrite compareEq x y-    | compareGt x y-    | equality (compare x y) EQ h-  = refl--lte2LtEq : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x <= y) ≡ (x < y || x == y)-lte2LtEq x y -  rewrite lt2LteNeq x y-    | compareEq x y-  with (x <= y) in h₁ | (compare x y) in h₂-... | False | LT = refl-... | False | EQ = magic $ exFalso (reflexivity x) $ begin -    (x <= x)  ≡⟨ (cong (x <=_) (equality x y (begin -      (x == y)            ≡⟨ compareEq x y ⟩ -      (compare x y == EQ) ≡⟨ equality' (compare x y) EQ h₂ ⟩ -      True                ∎ ) ) ) ⟩-    (x <= y)  ≡⟨ h₁ ⟩ -    False ∎-... | False | GT = refl-... | True  | LT = refl-... | True  | EQ = refl-... | True  | GT = refl--gte2GtEq : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x >= y) ≡ (x > y || x == y)-gte2GtEq x y-  rewrite sym $ lte2gte y x-    | lte2LtEq y x-    | eqSymmetry y x-    | lt2gt y x-  = refl--gte2nlt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x >= y) ≡ not (x < y)-gte2nlt x y-  rewrite gte2GtEq x y-    | compareGt x y-    | compareEq x y-    | compareLt x y-  with compare x y-... | GT = refl -... | EQ = refl -... | LT = refl --gte2nLT : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x >= y) ≡ (compare x y /= LT)-gte2nLT x y-  rewrite gte2nlt x y-    | compareLt x y-  = refl--lte2ngt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x <= y) ≡ not (x > y)-lte2ngt x y-  rewrite lte2LtEq x y-    | compareLt x y-    | compareEq x y-    | compareGt x y-  with compare x y-... | GT = refl -... | EQ = refl -... | LT = refl --lte2nGT : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x <= y) ≡ (compare x y /= GT)-lte2nGT x y-  rewrite lte2ngt x y-    | compareGt x y-  = refl--eq2lte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x == y) ≡ True → (x <= y) ≡ True-eq2lte x y h-  rewrite lte2ngt x y-    | eq2ngt x y h-  = refl--lt2lte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x < y) ≡ True → (x <= y) ≡ True-lt2lte x y h = &&-rightTrue' (x < y) (x <= y) (x /= y) (lt2LteNeq x y) h--eq2gte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x == y) ≡ True → (x >= y) ≡ True-eq2gte x y h-  rewrite gte2nlt x y-    | eq2nlt x y h-  = refl--gt2gte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : a) → (x > y) ≡ True → (x >= y) ≡ True-gt2gte x y h-  rewrite sym (lt2gt y x)-    | sym (lt2lte y x h)-    | lte2gte y x-  = refl------------------------------------------------------- Postulated instances--postulate instance-  iLawfulOrdNat : IsLawfulOrd Nat--  iLawfulOrdInteger : IsLawfulOrd Integer--  iLawfulOrdInt : IsLawfulOrd Int--  iLawfulOrdWord : IsLawfulOrd Word--  iLawfulOrdDouble : IsLawfulOrd Double--  iLawfulOrdChar : IsLawfulOrd Char--  iLawfulOrdUnit : IsLawfulOrd ⊤--  iLawfulOrdTuple₂ : ⦃ iOrdA : Ord a ⦄ ⦃ iOrdB : Ord b ⦄-                   → ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄-                   → IsLawfulOrd (a × b)--  iLawfulOrdTuple₃ : ⦃ iOrdA : Ord a ⦄ ⦃ iOrdB : Ord b ⦄ ⦃ iOrdC : Ord c ⦄-                   → ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄ → ⦃ IsLawfulOrd c ⦄-                   → IsLawfulOrd (a × b × c)--  iLawfulOrdList : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄ → IsLawfulOrd (List a)--  iLawfulOrdEither : ⦃ iOrdA : Ord a ⦄ → ⦃ iOrdB : Ord b ⦄ →  ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄ → IsLawfulOrd (Either a b)
− lib/Haskell/Law/Ord/Maybe.agda 
@@ -1,150 +0,0 @@-module Haskell.Law.Ord.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.Eq-open import Haskell.Prim.Maybe-open import Haskell.Prim.Ord--open import Haskell.Law.Bool-open import Haskell.Law.Eq-open import Haskell.Law.Equality hiding ( trustMe )-open import Haskell.Law.Maybe-open import Haskell.Law.Ord.Def--compMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x <= y || y <= x) ≡ True-compMaybe Nothing  Nothing  = refl-compMaybe Nothing  (Just _) = refl-compMaybe (Just _) Nothing  = refl-compMaybe (Just x) (Just y)-  rewrite sym (lte2nGT x y)-    | sym (lte2nGT y x)-  = comparability x y--transMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ ( x y z : Maybe a ) → ((x <= y) && (y <= z)) ≡ True → (x <= z) ≡ True-transMaybe Nothing  Nothing  Nothing  _ = refl-transMaybe Nothing  Nothing  (Just _) _ = refl-transMaybe Nothing  (Just _) (Just _) _ = refl-transMaybe (Just x) (Just y) Nothing  h-  = magic ((nequality (GT /= GT) True refl) (&&-rightTrue (compare x y /= GT) (GT /= GT) h))-transMaybe (Just x) (Just y) (Just z) h-  rewrite sym (compareGt x z)-    | sym (lte2nGT x y)-    | sym (lte2nGT y z)-    | sym (lte2ngt x z) -- not (x > z) → (x <= z)-  = transitivity x y z h--reflMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x : Maybe a) → (x <= x) ≡ True-reflMaybe Nothing = refl-reflMaybe (Just x)-  rewrite (equality (compare x x) EQ (trans (sym (compareEq x x)) (eqReflexivity x)))-  = refl--antisymmetryMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → ((x <= y) && (y <= x)) ≡ True → (x == y) ≡ True-antisymmetryMaybe Nothing  Nothing  _ = refl-antisymmetryMaybe (Just x) (Just y) h-  rewrite sym (lte2nGT x y)-    | sym (lte2nGT y x)-  = antisymmetry x y h--lte2gteMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x <= y) ≡ (y >= x)-lte2gteMaybe Nothing  Nothing  = refl-lte2gteMaybe Nothing  (Just _) = refl-lte2gteMaybe (Just _) Nothing  = refl-lte2gteMaybe (Just x) (Just y)-  rewrite sym (compareGt x y)-    | sym (lte2ngt x y)-    | lte2gte x y -- IH-    | gte2nlt y x-    | compareLt y x-  = refl--lt2LteNeqMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x < y) ≡ (x <= y && x /= y)-lt2LteNeqMaybe Nothing  Nothing  = refl-lt2LteNeqMaybe Nothing  (Just _) = refl-lt2LteNeqMaybe (Just _) Nothing  = refl-lt2LteNeqMaybe (Just x) (Just y)-  rewrite sym (compareLt x y)-    | lt2LteNeq x y -- IH-    | lte2ngt x y-    | compareGt x y-  = refl--lt2gtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x < y) ≡ (y > x)-lt2gtMaybe Nothing  Nothing  = refl-lt2gtMaybe Nothing  (Just _) = refl-lt2gtMaybe (Just _) Nothing  = refl-lt2gtMaybe (Just x) (Just y)-  rewrite sym (compareLt x y)-    | lt2gt x y -- IH-    | compareGt y x-  = refl--compareLtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x < y) ≡ (compare x y == LT)-compareLtMaybe Nothing  Nothing  = refl-compareLtMaybe Nothing  (Just _) = refl-compareLtMaybe (Just _) Nothing  = refl-compareLtMaybe (Just _) (Just _) = refl--compareGtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x > y) ≡ (compare x y == GT)-compareGtMaybe Nothing  Nothing  = refl-compareGtMaybe Nothing  (Just _) = refl-compareGtMaybe (Just _) Nothing  = refl-compareGtMaybe (Just _) (Just _) = refl--compareEqMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ iLawfulOrdA : IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → (x == y) ≡ (compare x y == EQ)-compareEqMaybe Nothing  Nothing  = refl-compareEqMaybe Nothing  (Just y) = refl-compareEqMaybe (Just x) Nothing  = refl-compareEqMaybe (Just x) (Just y) = compareEq x y--min2ifMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → ((min x y) == (if (x <= y) then x else y)) ≡ True-min2ifMaybe Nothing  Nothing  = refl-min2ifMaybe Nothing  (Just _) = refl-min2ifMaybe (Just _) Nothing = refl-min2ifMaybe (Just x) (Just y)-  rewrite sym (ifFlip (compare x y == GT) (Just x) (Just y))-  = equality'-      (if (compare x y /= GT) then Just x else Just y)-      (if (compare x y /= GT) then Just x else Just y)-      refl--max2ifMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄-  → ∀ (x y : Maybe a) → ((max x y) == (if (x >= y) then x else y)) ≡ True-max2ifMaybe Nothing  Nothing  = refl-max2ifMaybe Nothing  (Just y) = eqReflexivity y-max2ifMaybe (Just x) Nothing  = eqReflexivity x-max2ifMaybe (Just x) (Just y)-  rewrite sym (ifFlip (compare x y == LT) (Just x) (Just y))-  = equality'-    (if (compare x y /= LT) then Just x else Just y)-    (if (compare x y /= LT) then Just x else Just y)-    refl--instance-  iLawfulOrdMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄ → IsLawfulOrd (Maybe a)-  iLawfulOrdMaybe = λ where-    .comparability → compMaybe-    .transitivity → transMaybe-    .reflexivity → reflMaybe-    .antisymmetry → antisymmetryMaybe-    .lte2gte → lte2gteMaybe-    .lt2LteNeq → lt2LteNeqMaybe-    .lt2gt → lt2gtMaybe-    .compareLt → compareLtMaybe-    .compareGt → compareGtMaybe-    .compareEq → compareEqMaybe-    .min2if → min2ifMaybe-    .max2if → max2ifMaybe-
− lib/Haskell/Law/Ord/Ordering.agda 
@@ -1,121 +0,0 @@-module Haskell.Law.Ord.Ordering where--open import Haskell.Prim-open import Haskell.Prim.Ord--open import Haskell.Law.Eq-open import Haskell.Law.Equality-open import Haskell.Law.Ord.Def--instance-  iLawfulOrdOrdering : IsLawfulOrd Ordering--  iLawfulOrdOrdering .comparability LT LT = refl-  iLawfulOrdOrdering .comparability LT EQ = refl-  iLawfulOrdOrdering .comparability LT GT = refl-  iLawfulOrdOrdering .comparability EQ LT = refl-  iLawfulOrdOrdering .comparability EQ EQ = refl-  iLawfulOrdOrdering .comparability EQ GT = refl-  iLawfulOrdOrdering .comparability GT LT = refl-  iLawfulOrdOrdering .comparability GT EQ = refl-  iLawfulOrdOrdering .comparability GT GT = refl--  iLawfulOrdOrdering .transitivity LT LT LT _ = refl-  iLawfulOrdOrdering .transitivity LT LT EQ _ = refl-  iLawfulOrdOrdering .transitivity LT LT GT _ = refl-  iLawfulOrdOrdering .transitivity LT EQ EQ _ = refl-  iLawfulOrdOrdering .transitivity LT EQ GT _ = refl-  iLawfulOrdOrdering .transitivity LT GT GT _ = refl-  iLawfulOrdOrdering .transitivity EQ EQ EQ _ = refl-  iLawfulOrdOrdering .transitivity EQ EQ GT _ = refl-  iLawfulOrdOrdering .transitivity EQ GT GT _ = refl-  iLawfulOrdOrdering .transitivity GT GT GT _ = refl--  iLawfulOrdOrdering .reflexivity LT = refl-  iLawfulOrdOrdering .reflexivity EQ = refl-  iLawfulOrdOrdering .reflexivity GT = refl--  iLawfulOrdOrdering .antisymmetry LT LT _ = refl-  iLawfulOrdOrdering .antisymmetry EQ EQ _ = refl-  iLawfulOrdOrdering .antisymmetry GT GT _ = refl--  iLawfulOrdOrdering .lte2gte LT LT = refl-  iLawfulOrdOrdering .lte2gte LT EQ = refl-  iLawfulOrdOrdering .lte2gte LT GT = refl-  iLawfulOrdOrdering .lte2gte EQ LT = refl-  iLawfulOrdOrdering .lte2gte EQ EQ = refl-  iLawfulOrdOrdering .lte2gte EQ GT = refl-  iLawfulOrdOrdering .lte2gte GT LT = refl-  iLawfulOrdOrdering .lte2gte GT EQ = refl-  iLawfulOrdOrdering .lte2gte GT GT = refl--  iLawfulOrdOrdering .lt2LteNeq LT LT = refl-  iLawfulOrdOrdering .lt2LteNeq LT EQ = refl-  iLawfulOrdOrdering .lt2LteNeq LT GT = refl-  iLawfulOrdOrdering .lt2LteNeq EQ LT = refl-  iLawfulOrdOrdering .lt2LteNeq EQ EQ = refl-  iLawfulOrdOrdering .lt2LteNeq EQ GT = refl-  iLawfulOrdOrdering .lt2LteNeq GT LT = refl-  iLawfulOrdOrdering .lt2LteNeq GT EQ = refl-  iLawfulOrdOrdering .lt2LteNeq GT GT = refl--  iLawfulOrdOrdering .lt2gt LT LT = refl-  iLawfulOrdOrdering .lt2gt LT EQ = refl-  iLawfulOrdOrdering .lt2gt LT GT = refl-  iLawfulOrdOrdering .lt2gt EQ LT = refl-  iLawfulOrdOrdering .lt2gt EQ EQ = refl-  iLawfulOrdOrdering .lt2gt EQ GT = refl-  iLawfulOrdOrdering .lt2gt GT LT = refl-  iLawfulOrdOrdering .lt2gt GT EQ = refl-  iLawfulOrdOrdering .lt2gt GT GT = refl--  iLawfulOrdOrdering .compareLt LT LT = refl-  iLawfulOrdOrdering .compareLt LT EQ = refl-  iLawfulOrdOrdering .compareLt LT GT = refl-  iLawfulOrdOrdering .compareLt EQ LT = refl-  iLawfulOrdOrdering .compareLt EQ EQ = refl-  iLawfulOrdOrdering .compareLt EQ GT = refl-  iLawfulOrdOrdering .compareLt GT LT = refl-  iLawfulOrdOrdering .compareLt GT EQ = refl-  iLawfulOrdOrdering .compareLt GT GT = refl--  iLawfulOrdOrdering .compareGt LT LT = refl-  iLawfulOrdOrdering .compareGt LT EQ = refl-  iLawfulOrdOrdering .compareGt LT GT = refl-  iLawfulOrdOrdering .compareGt EQ LT = refl-  iLawfulOrdOrdering .compareGt EQ EQ = refl-  iLawfulOrdOrdering .compareGt EQ GT = refl-  iLawfulOrdOrdering .compareGt GT LT = refl-  iLawfulOrdOrdering .compareGt GT EQ = refl-  iLawfulOrdOrdering .compareGt GT GT = refl--  iLawfulOrdOrdering .compareEq LT LT = refl-  iLawfulOrdOrdering .compareEq LT EQ = refl-  iLawfulOrdOrdering .compareEq LT GT = refl-  iLawfulOrdOrdering .compareEq EQ LT = refl-  iLawfulOrdOrdering .compareEq EQ EQ = refl-  iLawfulOrdOrdering .compareEq EQ GT = refl-  iLawfulOrdOrdering .compareEq GT LT = refl-  iLawfulOrdOrdering .compareEq GT EQ = refl-  iLawfulOrdOrdering .compareEq GT GT = refl--  iLawfulOrdOrdering .min2if LT LT = refl-  iLawfulOrdOrdering .min2if LT EQ = refl-  iLawfulOrdOrdering .min2if LT GT = refl-  iLawfulOrdOrdering .min2if EQ LT = refl-  iLawfulOrdOrdering .min2if EQ EQ = refl-  iLawfulOrdOrdering .min2if EQ GT = refl-  iLawfulOrdOrdering .min2if GT LT = refl-  iLawfulOrdOrdering .min2if GT EQ = refl-  iLawfulOrdOrdering .min2if GT GT = refl--  iLawfulOrdOrdering .max2if LT LT = refl-  iLawfulOrdOrdering .max2if LT EQ = refl-  iLawfulOrdOrdering .max2if LT GT = refl-  iLawfulOrdOrdering .max2if EQ LT = refl-  iLawfulOrdOrdering .max2if EQ EQ = refl-  iLawfulOrdOrdering .max2if EQ GT = refl-  iLawfulOrdOrdering .max2if GT LT = refl-  iLawfulOrdOrdering .max2if GT EQ = refl-  iLawfulOrdOrdering .max2if GT GT = refl-
− lib/Haskell/Law/Semigroup/Def.agda 
@@ -1,27 +0,0 @@-module Haskell.Law.Semigroup.Def where--open import Haskell.Prim-open import Haskell.Prim.Tuple--open import Haskell.Prim.Monoid--record IsLawfulSemigroup (a : Set) ⦃ iSemigroupA : Semigroup a ⦄ : Set₁ where-  field-    -- Associativity: x <> (y <> z) = (x <> y) <> z-    associativity : (x y z : a) → x <> (y <> z) ≡ (x <> y) <> z--open IsLawfulSemigroup ⦃ ... ⦄ public--postulate instance-  iLawfulSemigroupFun : ⦃ iSemB : Semigroup b ⦄ → ⦃ IsLawfulSemigroup b ⦄ → IsLawfulSemigroup (a → b)--  iLawfulSemigroupUnit : IsLawfulSemigroup ⊤--  iLawfulSemigroupTuple₂ : ⦃ iSemA : Semigroup a ⦄ ⦃ iSemB : Semigroup b ⦄-                         → ⦃ IsLawfulSemigroup a ⦄ → ⦃ IsLawfulSemigroup b ⦄-                         → IsLawfulSemigroup (a × b)--  iLawfulSemigroupTuple₃ : ⦃ iSemA : Semigroup a ⦄ ⦃ iSemB : Semigroup b ⦄ ⦃ iSemC : Semigroup c ⦄-                         → ⦃ IsLawfulSemigroup a ⦄ → ⦃ IsLawfulSemigroup b ⦄ → ⦃ IsLawfulSemigroup c ⦄-                         → IsLawfulSemigroup (a × b × c)-
− lib/Haskell/Law/Semigroup/Either.agda 
@@ -1,13 +0,0 @@-module Haskell.Law.Semigroup.Either where--open import Haskell.Prim-open import Haskell.Prim.Either--open import Haskell.Prim.Monoid--open import Haskell.Law.Equality-open import Haskell.Law.Semigroup.Def--instance-  iLawfulSemigroupEither : IsLawfulSemigroup (Either a b)-  iLawfulSemigroupEither .associativity  = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
− lib/Haskell/Law/Semigroup/List.agda 
@@ -1,17 +0,0 @@-module Haskell.Law.Semigroup.List where--open import Haskell.Prim-open import Haskell.Prim.List--open import Haskell.Prim.Monoid--open import Haskell.Law.Equality-open import Haskell.Law.List-open import Haskell.Law.Semigroup.Def--instance-  iLawfulSemigroupList : IsLawfulSemigroup (List a)-  iLawfulSemigroupList .associativity []       _  _  = refl-  iLawfulSemigroupList .associativity (x ∷ xs) ys zs-    rewrite sym (++-assoc xs ys zs)-    = refl
− lib/Haskell/Law/Semigroup/Maybe.agda 
@@ -1,18 +0,0 @@-module Haskell.Law.Semigroup.Maybe where--open import Haskell.Prim-open import Haskell.Prim.Maybe--open import Haskell.Prim.Monoid--open import Haskell.Law.Equality-open import Haskell.Law.Semigroup.Def--instance-  iLawfulSemigroupMaybe : ⦃ iSemA : Semigroup a ⦄ → ⦃ IsLawfulSemigroup a ⦄ → IsLawfulSemigroup (Maybe a)-  iLawfulSemigroupMaybe .associativity Nothing  _        _        = refl-  iLawfulSemigroupMaybe .associativity (Just _) Nothing  _        = refl-  iLawfulSemigroupMaybe .associativity (Just _) (Just _) Nothing  = refl-  iLawfulSemigroupMaybe .associativity (Just x) (Just y) (Just z)-    rewrite associativity x y z-    = refl
− lib/Haskell/Prelude.agda 
@@ -1,142 +0,0 @@-{-# OPTIONS --no-auto-inline #-}-module Haskell.Prelude where--open import Haskell.Prim-open Haskell.Prim public using-  ( Bool; True; False; Char; Integer;-    List; []; _∷_; Nat; zero; suc; ⊤; tt;-    TypeError; ⊥; iNumberNat; lengthNat;-    IsTrue; IsFalse; NonEmpty;-    All; allNil; allCons;-    Any; anyHere; anyThere;-    id; _∘_; _$_; flip; const;-    if_then_else_; case_of_;-    Number; fromNat; Negative; fromNeg;-    IsString; fromString;-    _≡_; refl;-    a; b; c; d; e; f; m; s; t )--open import Haskell.Prim.Absurd      public-open import Haskell.Prim.Applicative public-open import Haskell.Prim.Bool        public-open import Haskell.Prim.Bounded     public-open import Haskell.Prim.Char        public-open import Haskell.Prim.Double      public-open import Haskell.Prim.Either      public-open import Haskell.Prim.Enum        public-open import Haskell.Prim.Eq          public-open import Haskell.Prim.Foldable    public-open import Haskell.Prim.Functor     public-open import Haskell.Prim.Int         public-open import Haskell.Prim.Integer     public-open import Haskell.Prim.IO          public-open import Haskell.Prim.List        public-open import Haskell.Prim.Maybe       public-open import Haskell.Prim.Monad       public-open import Haskell.Prim.Monoid      public-open import Haskell.Prim.Num         public-open import Haskell.Prim.Ord         public-open import Haskell.Prim.Show        public-open import Haskell.Prim.String      public-open import Haskell.Prim.Traversable public-open import Haskell.Prim.Tuple       public hiding (first; second; _***_)-open import Haskell.Prim.Word        public---- Problematic features---  - [Partial]:  Could pass implicit/instance arguments to prove totality.---  - [Float]:    Or Float (Agda floats are Doubles)---  - [Infinite]: Define colists and map to Haskell lists?---- Missing from the Haskell Prelude:------     Float        [Float]---     Rational------     Real(toRational),---     Integral(quot, rem, div, mod, quotRem, divMod, toInteger),---     Fractional((/), recip, fromRational),---     Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,---              asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),---     RealFrac(properFraction, truncate, round, ceiling, floor),---     RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,---               encodeFloat, exponent, significand, scaleFloat, isNaN,---               isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),------     subtract, even, odd, gcd, lcm, (^), (^^),---     fromIntegral, realToFrac,------     foldr1, foldl1, maximum, minimum      [Partial]------     until [Partial]------     iterate, repeat, cycle          [Infinite]------     ReadS, Read(readsPrec, readList),---     reads, readParen, read, lex,------     IO, putChar, putStr, putStrLn, print,---     getChar, getLine, getContents, interact,---     FilePath, readFile, writeFile, appendFile, readIO, readLn,---     IOError, ioError, userError,-------------------------------------------------------- Functions--infixr 0 _$!_--_$!_ : (a → b) → a → b-_$!_ = _$_--seq : a → b → b-seq = const id--asTypeOf : a → a → a-asTypeOf x _ = x--undefined : {@0 @(tactic absurd) i : ⊥} → a-undefined {i = ()}--error : {@0 @(tactic absurd) i : ⊥} → String → a-error {i = ()} err--errorWithoutStackTrace : {@0 @(tactic absurd) i : ⊥} → String → a-errorWithoutStackTrace {i = ()} err------------------------------------------------------ More List functions---   These uses Eq, Ord, or Foldable, so can't go in Prim.List without---   turning those dependencies around.--reverse : List a → List a-reverse = foldl (flip _∷_) []--infixl 9 _!!_ _!!ᴺ_--_!!ᴺ_ : (xs : List a) (n : Nat) → @0 ⦃ IsTrue (n < lengthNat xs) ⦄ → a-(x ∷ xs) !!ᴺ zero  = x-(x ∷ xs) !!ᴺ suc n = xs !!ᴺ n--_!!_ : (xs : List a) (n : Int)-     → ⦃ @0 nn : IsNonNegativeInt n ⦄-     → ⦃ @0 _  : IsTrue (intToNat n {{nn}} < lengthNat xs) ⦄ → a-xs !! n = xs !!ᴺ intToNat n--lookup : ⦃ Eq a ⦄ → a → List (a × b) → Maybe b-lookup x []              = Nothing-lookup x ((x₁ , y) ∷ xs) = if x == x₁ then Just y else lookup x xs------------------------------------------------------- Unsafe functions--coerce : @0 a ≡ b → a → b-coerce refl x = x--IsJust : Maybe a → Set-IsJust Nothing  = ⊥-IsJust (Just _) = ⊤--fromJust : (x : Maybe a) → @0 {IsJust x} → a-fromJust Nothing  = error "fromJust Nothing"-fromJust (Just x) = x
− lib/Haskell/Prim.agda 
@@ -1,130 +0,0 @@-{-# OPTIONS --no-auto-inline #-}---- Basic things needed by other primitive modules.--- Note that this module exports types and functions that should not--- be used directly in Haskell definitions, so you probably want to--- import Haskell.Prelude instead.--module Haskell.Prim where--open import Agda.Primitive          public-open import Agda.Builtin.Bool       public renaming (true to True; false to False)-open import Agda.Builtin.Int        public renaming (Int to Integer)-open import Agda.Builtin.Nat        public renaming (_==_ to eqNat; _<_ to ltNat; _+_ to addNat; _-_ to monusNat; _*_ to mulNat)-open import Agda.Builtin.Char       public renaming (primCharToNat to c2n)-open import Agda.Builtin.Unit       public-open import Agda.Builtin.Equality   public-open import Agda.Builtin.FromString public-open import Agda.Builtin.FromNat    public-open import Agda.Builtin.FromNeg    public-open import Agda.Builtin.String     public renaming (String to AgdaString)-open import Agda.Builtin.Word       public renaming (primWord64ToNat to w2n; primWord64FromNat to n2w)-open import Agda.Builtin.Strict     public-open import Agda.Builtin.List       public--variable-  @0 ℓ : Level-  a b c d e : Set-  f m s t : Set → Set-------------------------------------------------------- Functions--id : a → a-id x = x--infixr 9 _∘_-_∘_ : (b → c) → (a → b) → a → c-(f ∘ g) x = f (g x)--flip : (a → b → c) → b → a → c-flip f x y = f y x--const : a → b → a-const x _ = x--infixr 0 _$_-_$_ : (a → b) → a → b-f $ x = f x-------------------------------------------------------- Language constructs--infix -1 case_of_-case_of_ : (a' : a) → ((a'' : a) → @0 {{ a' ≡ a'' }} → b) → b-case x of f = f x--infix -2 if_then_else_-if_then_else_ : {@0 a : Set ℓ} → (flg : Bool) → (@0 {{ flg ≡ True }} → a) → (@0 {{ flg ≡ False }} → a) → a-if False then x else y = y-if True  then x else y = x---- for explicit type signatures (e. g. `4 :: Integer` is `the Int 4`)-the : (@0 a : Set ℓ) -> a -> a-the _ x = x------------------------------------------------------- Agda strings--instance-  iIsStringAgdaString : IsString AgdaString-  iIsStringAgdaString .IsString.Constraint _ = ⊤-  iIsStringAgdaString .fromString s = s-------------------------------------------------------- Numbers--instance-  iNumberNat : Number Nat-  iNumberNat .Number.Constraint _ = ⊤-  iNumberNat .fromNat n = n-------------------------------------------------------- Lists--lengthNat : List a → Nat-lengthNat []       = 0-lengthNat (_ ∷ xs) = addNat 1 (lengthNat xs)-------------------------------------------------------- Proof things--data ⊥ : Set where--magic : {A : Set} → ⊥ → A-magic ()----principle of explosion-exFalso : {x : Bool} → (x ≡ True) → (x ≡ False) → ⊥-exFalso {False} () b -exFalso {True} a ()---- Use to bundle up constraints-data All {a b} {A : Set a} (B : A → Set b) : List A → Set (a ⊔ b) where-  instance-    allNil  : All B []-    allCons : ∀ {x xs} ⦃ i : B x ⦄ ⦃ is : All B xs ⦄ → All B (x ∷ xs)--data Any {a b} {A : Set a} (B : A → Set b) : List A → Set (a ⊔ b) where-  instance-    anyHere  : ∀ {x xs} ⦃ i : B x ⦄ → Any B (x ∷ xs)-    anyThere : ∀ {x xs} ⦃ is : Any B xs ⦄ → Any B (x ∷ xs)--data IsTrue : Bool → Set where-  instance itsTrue : IsTrue True--data IsFalse : Bool → Set where-  instance itsFalse : IsFalse False--data NonEmpty {a : Set} : List a → Set where-  instance itsNonEmpty : ∀ {x xs} → NonEmpty (x ∷ xs)--data TypeError (err : AgdaString) : Set where--it : ∀ {@0 ℓ} {@0 a : Set ℓ} → ⦃ a ⦄ → a-it ⦃ x ⦄ = x
− lib/Haskell/Prim/Absurd.agda 
@@ -1,23 +0,0 @@--module Haskell.Prim.Absurd where--open import Haskell.Prim--open import Agda.Builtin.Reflection renaming (bindTC to _>>=_; absurd to absurdP)--private--  pattern vArg x = arg (arg-info visible (modality relevant quantity-ω)) x--  refute : Nat → Term-  refute i = def (quote _$_) ( vArg (pat-lam (absurd-clause [] (vArg (absurdP 0) ∷ []) ∷ []) [])-                             ∷ vArg (var i []) ∷ [])--  tryRefute : Nat → Term → TC ⊤-  tryRefute 0       _    = typeError (strErr "No variable of empty type found in the context" ∷ [])-  tryRefute (suc n) hole = catchTC (unify hole (refute n)) (tryRefute n hole)--absurd : Term → TC ⊤-absurd hole = do-  Γ ← getContext-  tryRefute (lengthNat Γ) hole
− lib/Haskell/Prim/Applicative.agda 
@@ -1,92 +0,0 @@-module Haskell.Prim.Applicative where--open import Haskell.Prim-open import Haskell.Prim.Either-open import Haskell.Prim.Foldable-open import Haskell.Prim.Functor-open import Haskell.Prim.IO-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Monoid-open import Haskell.Prim.Tuple-------------------------------------------------------- Applicative---- ** base-record Applicative (f : Set → Set) : Set₁ where-  infixl 4 _<*>_ _<*_ _*>_-  field-    pure  : a → f a-    _<*>_ : f (a → b) → f a → f b-    overlap ⦃ super ⦄ : Functor f-    _<*_ : f a → f b → f a-    _*>_ : f a → f b → f b--- ** defaults-record DefaultApplicative (f : Set → Set) : Set₁ where-  constructor mk-  infixl 4 _<*>_ _<*_ _*>_-  field-    pure  : a → f a-    _<*>_ : f (a → b) → f a → f b-    overlap ⦃ super ⦄ : Functor f--  _<*_ : f a → f b → f a-  x <* y = const <$> x <*> y--  _*>_ : f a → f b → f b-  x *> y = const id <$> x <*> y--- ** export-open Applicative ⦃...⦄ public-{-# COMPILE AGDA2HS Applicative existing-class #-}--- ** instances-instance-  open DefaultApplicative--  iDefaultApplicativeList : DefaultApplicative List-  iDefaultApplicativeList .pure x = x ∷ []-  iDefaultApplicativeList ._<*>_ fs xs = concatMap (λ f → map f xs) fs--  iApplicativeList : Applicative List-  iApplicativeList = record {DefaultApplicative iDefaultApplicativeList}--  iDefaultApplicativeMaybe : DefaultApplicative Maybe-  iDefaultApplicativeMaybe .pure = Just-  iDefaultApplicativeMaybe ._<*>_ (Just f) (Just x) = Just (f x)-  iDefaultApplicativeMaybe ._<*>_ _        _        = Nothing--  iApplicativeMaybe : Applicative Maybe-  iApplicativeMaybe = record {DefaultApplicative iDefaultApplicativeMaybe}--  iDefaultApplicativeEither : DefaultApplicative (Either a)-  iDefaultApplicativeEither .pure = Right-  iDefaultApplicativeEither ._<*>_ (Right f) (Right x) = Right (f x)-  iDefaultApplicativeEither ._<*>_ (Left e)  _         = Left e-  iDefaultApplicativeEither ._<*>_ _         (Left e)  = Left e--  iApplicativeEither : Applicative (Either a)-  iApplicativeEither = record{DefaultApplicative iDefaultApplicativeEither}--  iDefaultApplicativeFun : DefaultApplicative (λ b → a → b)-  iDefaultApplicativeFun .pure        = const-  iDefaultApplicativeFun ._<*>_ f g x = f x (g x)--  iApplicativeFun : Applicative (λ b → a → b)-  iApplicativeFun = record{DefaultApplicative iDefaultApplicativeFun}--  iDefaultApplicativeTuple₂ : ⦃ Monoid a ⦄ → DefaultApplicative (a ×_)-  iDefaultApplicativeTuple₂ .pure x                = mempty , x-  iDefaultApplicativeTuple₂ ._<*>_ (a , f) (b , x) = a <> b , f x--  iApplicativeTuple₂ : ⦃ Monoid a ⦄ → Applicative (a ×_)-  iApplicativeTuple₂ = record{DefaultApplicative iDefaultApplicativeTuple₂}--  iDefaultApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultApplicative (a × b ×_)-  iDefaultApplicativeTuple₃ .pure x = mempty , mempty , x-  iDefaultApplicativeTuple₃ ._<*>_ (a , u , f) (b , v , x) = a <> b , u <> v , f x--  iApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Applicative (a × b ×_)-  iApplicativeTuple₃ = record{DefaultApplicative iDefaultApplicativeTuple₃}--instance postulate iApplicativeIO : Applicative IO
− lib/Haskell/Prim/Bool.agda 
@@ -1,24 +0,0 @@--module Haskell.Prim.Bool where--open import Haskell.Prim------------------------------------------------------- Booleans--infixr 3 _&&_-_&&_ : Bool → Bool → Bool-False && _ = False-True  && x = x--infixr 2 _||_-_||_ : Bool → Bool → Bool-False || x = x-True  || _ = True--not : Bool → Bool-not False = True-not True  = False--otherwise : Bool-otherwise = True
− lib/Haskell/Prim/Bounded.agda 
@@ -1,94 +0,0 @@--module Haskell.Prim.Bounded where--open import Haskell.Prim-open import Haskell.Prim.Eq-open import Haskell.Prim.Int-open import Haskell.Prim.Maybe-open import Haskell.Prim.Ord-open import Haskell.Prim.Tuple-open import Haskell.Prim.Word------------------------------------------------------- Bounded--record BoundedBelow (a : Set) : Set where-  field-    minBound : a--record BoundedAbove (a : Set) : Set where-  field-    maxBound : a--record Bounded (a : Set) : Set where-  field-    overlap ⦃ below ⦄ : BoundedBelow a-    overlap ⦃ above ⦄ : BoundedAbove a--{-# COMPILE AGDA2HS Bounded existing-class #-}--open BoundedBelow ⦃...⦄ public-open BoundedAbove ⦃...⦄ public--instance-  iBounded : ⦃ BoundedBelow a ⦄ → ⦃ BoundedAbove a ⦄ → Bounded a-  iBounded .Bounded.below = it-  iBounded .Bounded.above = it--instance-  iBoundedBelowNat : BoundedBelow Nat-  iBoundedBelowNat .minBound = 0--  iBoundedBelowWord : BoundedBelow Word-  iBoundedBelowWord .minBound = 0-  iBoundedAboveWord : BoundedAbove Word-  iBoundedAboveWord .maxBound = 18446744073709551615--  iBoundedBelowInt : BoundedBelow Int-  iBoundedBelowInt .minBound = -9223372036854775808-  iBoundedAboveInt : BoundedAbove Int-  iBoundedAboveInt .maxBound = 9223372036854775807--  iBoundedBelowBool : BoundedBelow Bool-  iBoundedBelowBool .minBound = False-  iBoundedAboveBool : BoundedAbove Bool-  iBoundedAboveBool .maxBound = True--  iBoundedBelowChar : BoundedBelow Char-  iBoundedBelowChar .minBound = '\0'-  iBoundedAboveChar : BoundedAbove Char-  iBoundedAboveChar .maxBound = '\1114111'--  iBoundedBelowUnit : BoundedBelow ⊤-  iBoundedBelowUnit .minBound = tt--  iBoundedAboveUnit : BoundedAbove ⊤-  iBoundedAboveUnit .maxBound = tt--  iBoundedBelowTuple₂ : ⦃ BoundedBelow a ⦄ → ⦃ BoundedBelow b ⦄-                      → BoundedBelow (a × b)-  iBoundedBelowTuple₂ .minBound = minBound , minBound-  iBoundedAboveTuple₂ : ⦃ BoundedAbove a ⦄ → ⦃ BoundedAbove b ⦄-                      → BoundedAbove (a × b)-  iBoundedAboveTuple₂ .maxBound = maxBound , maxBound--  iBoundedBelowTuple₃ : ⦃ BoundedBelow a ⦄ → ⦃ BoundedBelow b ⦄ → ⦃ BoundedBelow c ⦄-                      → BoundedBelow (a × b × c)-  iBoundedBelowTuple₃ .minBound = minBound , minBound , minBound-  iBoundedAboveTuple₃ : ⦃ BoundedAbove a ⦄ → ⦃ BoundedAbove b ⦄ → ⦃ BoundedAbove c ⦄-                      → BoundedAbove (a × b × c)-  iBoundedAboveTuple₃ .maxBound = maxBound , maxBound , maxBound--  iBoundedBelowOrdering : BoundedBelow Ordering-  iBoundedBelowOrdering .minBound = LT-  iBoundedAboveOrdering : BoundedAbove Ordering-  iBoundedAboveOrdering .maxBound = GT---- Sanity checks--private-  _ : addWord maxBound 1 ≡ minBound-  _ = refl--  _ : addInt maxBound 1 ≡ minBound-  _ = refl
− lib/Haskell/Prim/Char.agda 
@@ -1,9 +0,0 @@-module Haskell.Prim.Char where--open import Haskell.Prim--import Agda.Builtin.Char -open Agda.Builtin.Char using (Char)-    -eqChar : Char → Char → Bool-eqChar a b = eqNat (c2n a) (c2n b)
− lib/Haskell/Prim/Double.agda 
@@ -1,15 +0,0 @@--module Haskell.Prim.Double where--open import Agda.Builtin.Float public renaming (Float to Double)--open import Haskell.Prim--instance-  iNumberDouble : Number Double-  iNumberDouble .Number.Constraint _ = ⊤-  iNumberDouble .fromNat n = primNatToFloat n--  iNegativeDouble : Negative Double-  iNegativeDouble .Negative.Constraint _ = ⊤-  iNegativeDouble .fromNeg n = primFloatMinus 0.0 (fromNat n)
− lib/Haskell/Prim/Either.agda 
@@ -1,20 +0,0 @@--module Haskell.Prim.Either where--open import Haskell.Prim-open import Haskell.Prim.Bool------------------------------------------------------- Either--data Either (a b : Set) : Set where-  Left  : a → Either a b-  Right : b → Either a b--either : (a → c) → (b → c) → Either a b → c-either f g (Left  x) = f x-either f g (Right y) = g y--testBool : (b : Bool) → Either (IsFalse b) (IsTrue b)-testBool False = Left  itsFalse-testBool True  = Right itsTrue
− lib/Haskell/Prim/Enum.agda 
@@ -1,263 +0,0 @@--module Haskell.Prim.Enum where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.Bounded-open import Haskell.Prim.Either-open import Haskell.Prim.Eq-open import Haskell.Prim.Functor-open import Haskell.Prim.Int-open import Haskell.Prim.Integer-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Num-open import Haskell.Prim.Ord-open import Haskell.Prim.Tuple-open import Haskell.Prim.Word-------------------------------------------------------- Enum---    Assumptions: unbounded enums have no constraints on their---    operations and bounded enums should work on all values between---    minBound and maxBound. Unbounded enums do not support enumFrom---    and enumFromThen (since they return infinite lists).--@0 IfBoundedBelow : Maybe (BoundedBelow a) → (⦃ BoundedBelow a ⦄ → Set) → Set-IfBoundedBelow Nothing  k = ⊤-IfBoundedBelow (Just i) k = k ⦃ i ⦄--@0 IfBoundedAbove : Maybe (BoundedAbove a) → (⦃ BoundedAbove a ⦄ → Set) → Set-IfBoundedAbove Nothing  k = ⊤-IfBoundedAbove (Just i) k = k ⦃ i ⦄--record Enum (a : Set) : Set₁ where-  field-    BoundedBelowEnum : Maybe (BoundedBelow a)-    BoundedAboveEnum : Maybe (BoundedAbove a)-    fromEnum         : a → Int--  private-    @0 IsBoundedBelow : Set-    IsBoundedBelow = maybe ⊥ (λ _ → ⊤) BoundedBelowEnum--    @0 IsBoundedAbove : Set-    IsBoundedAbove = maybe ⊥ (λ _ → ⊤) BoundedAboveEnum--    @0 TrueIfLB : (⦃ BoundedBelow a ⦄ → Bool) → Set-    TrueIfLB C = IfBoundedBelow BoundedBelowEnum (IsTrue C)--    @0 TrueIfUB : (⦃ BoundedAbove a ⦄ → Bool) → Set-    TrueIfUB C = IfBoundedAbove BoundedAboveEnum (IsTrue C)--    @0 FalseIfLB : (⦃ BoundedBelow a ⦄ → Bool) → Set-    FalseIfLB C = IfBoundedBelow BoundedBelowEnum (IsFalse C)--    @0 FalseIfUB : (⦃ BoundedAbove a ⦄ → Bool) → Set-    FalseIfUB C = IfBoundedAbove BoundedAboveEnum (IsFalse C)--    minInt : ⦃ BoundedBelow a ⦄ → Int-    minInt ⦃ _ ⦄ = fromEnum minBound--    maxInt : ⦃ BoundedAbove a ⦄ → Int-    maxInt ⦃ _ ⦄ = fromEnum maxBound--  field-    toEnum : (n : Int) → @0 ⦃ TrueIfLB (minInt <= n) ⦄ → @0 ⦃ TrueIfUB (n <= maxInt) ⦄ → a-    succ   : (x : a) → @0 ⦃ FalseIfUB (fromEnum x == maxInt) ⦄ → a-    pred   : (x : a) → @0 ⦃ FalseIfLB (fromEnum x == minInt) ⦄ → a--    enumFrom       : @0 ⦃ IsBoundedAbove ⦄ → a → List a-    enumFromTo     : a → a → List a-    -- In the Prelude Enum instances `enumFromThenTo x x y` gives the-    -- infinite list of `x`s. The constraint is a little bit stronger than it needs to be,-    -- since it rules out different x and x₁ that maps to the same Int, but this saves us-    -- requiring an Eq instance for `a`, and it's not a terrible limitation to not be able to-    -- write [0, 2^64 .. 2^66].-    enumFromThenTo : (x x₁ : a) → @0 ⦃ IsFalse (fromEnum x == fromEnum x₁) ⦄ → a → List a-    enumFromThen   : @0 ⦃ IsBoundedBelow ⦄ → @0 ⦃ IsBoundedAbove ⦄ → (x x₁ : a) → @0 ⦃ IsFalse (fromEnum x == fromEnum x₁) ⦄ → List a--open Enum ⦃...⦄ public--{-# COMPILE AGDA2HS Enum existing-class #-}--private-  divNat : Nat → Nat → Nat-  divNat a 0       = 0-  divNat a (suc b) = div-helper 0 b a b--  diff : Integer → Integer → Maybe Nat-  diff a b =-    case a - b of λ where-      (pos n)    → Just n-      (negsuc _) → Nothing--  unsafeIntegerToNat : Integer → Nat-  unsafeIntegerToNat (pos n) = n-  unsafeIntegerToNat (negsuc _) = 0--  integerFromCount : Integer → Integer → Nat → List Integer-  integerFromCount a step 0       = []-  integerFromCount a step (suc n) = a ∷ integerFromCount (a + step) step n--  integerFromTo : Integer → Integer → List Integer-  integerFromTo a b = maybe [] (integerFromCount a 1 ∘ suc) (diff b a)--  integerFromThenTo : (a a₁ : Integer) → @0 ⦃ IsFalse (integerToInt a == integerToInt a₁) ⦄ → Integer → List Integer-  integerFromThenTo a a₁ b =-    case compare a a₁ of λ where-      LT → maybe [] (λ d → integerFromCount a (a₁ - a) (suc (divNat d (unsafeIntegerToNat (a₁ - a))))) (diff b a)-      EQ → [] -- impossible-      GT → maybe [] (λ d → integerFromCount a (a₁ - a) (suc (divNat d (unsafeIntegerToNat (a - a₁))))) (diff a b)--instance-  iEnumInteger : Enum Integer-  iEnumInteger .BoundedBelowEnum  = Nothing-  iEnumInteger .BoundedAboveEnum  = Nothing-  iEnumInteger .fromEnum          = integerToInt-  iEnumInteger .toEnum          n = intToInteger n-  iEnumInteger .succ              = _+ 1-  iEnumInteger .pred              = _- 1-  iEnumInteger .enumFromTo        = integerFromTo-  iEnumInteger .enumFromThenTo    = integerFromThenTo--private-  fromTo : (from : a → Integer) (to : Integer → a)-         → a → a → List a-  fromTo from to a b = map to (enumFromTo (from a) (from b))--  fromThenTo : (from : a → Integer) (to : Integer → a)-             → (x x₁ : a) → @0 ⦃ IsFalse (fromEnum (from x) == fromEnum (from x₁)) ⦄ → a → List a-  fromThenTo from to a a₁ b = map to (enumFromThenTo (from a) (from a₁) (from b))---instance-  iEnumNat : Enum Nat-  iEnumNat .BoundedBelowEnum = Just it-  iEnumNat .BoundedAboveEnum = Nothing-  iEnumNat .fromEnum = integerToInt ∘ pos-  iEnumNat .toEnum n = unsafeIntegerToNat (intToInteger n)-  iEnumNat .succ n = suc n-  iEnumNat .pred (suc n) = n-  iEnumNat .enumFromTo = fromTo pos unsafeIntegerToNat-  iEnumNat .enumFromThenTo = fromThenTo pos unsafeIntegerToNat--  iEnumInt : Enum Int-  iEnumInt .BoundedBelowEnum      = Just it-  iEnumInt .BoundedAboveEnum      = Just it-  iEnumInt .fromEnum              = integerToInt ∘ intToInteger-  iEnumInt .toEnum         n      = integerToInt (intToInteger n)-  iEnumInt .succ           x      = integerToInt (intToInteger x + 1)-  iEnumInt .pred           x      = integerToInt (intToInteger x - 1)-  iEnumInt .enumFromTo     a b    = fromTo intToInteger integerToInt a b-  iEnumInt .enumFromThenTo a a₁ b = fromThenTo intToInteger integerToInt a a₁ b-  iEnumInt .enumFrom       a      = fromTo intToInteger integerToInt a maxBound-  iEnumInt .enumFromThen   a a₁   =-    if a < a₁ then fromThenTo intToInteger integerToInt a a₁ maxBound-              else fromThenTo intToInteger integerToInt a a₁ minBound--  iEnumWord : Enum Word-  iEnumWord .BoundedBelowEnum      = Just it-  iEnumWord .BoundedAboveEnum      = Just it-  iEnumWord .fromEnum              = integerToInt ∘ wordToInteger-  iEnumWord .toEnum         n      = integerToWord (intToInteger n)-  iEnumWord .succ           x      = integerToWord (wordToInteger x + 1)-  iEnumWord .pred           x      = integerToWord (wordToInteger x - 1)-  iEnumWord .enumFromTo     a b    = fromTo wordToInteger integerToWord a b-  iEnumWord .enumFromThenTo a a₁ b = fromThenTo wordToInteger integerToWord a a₁ b-  iEnumWord .enumFrom       a      = fromTo wordToInteger integerToWord a maxBound-  iEnumWord .enumFromThen   a a₁   =-    if a < a₁ then fromThenTo wordToInteger integerToWord a a₁ maxBound-              else fromThenTo wordToInteger integerToWord a a₁ minBound--private-  fromBool : Bool → Integer-  fromBool = if_then 1 else 0--  toBool : Integer → Bool-  toBool = _/= 0--instance-  iEnumBool : Enum Bool-  iEnumBool .BoundedBelowEnum      = Just it-  iEnumBool .BoundedAboveEnum      = Just it-  iEnumBool .fromEnum              = integerToInt ∘ fromBool-  iEnumBool .toEnum         n      = toBool (intToInteger n)-  iEnumBool .succ           x      = toBool (fromBool x + 1)-  iEnumBool .pred           x      = toBool (fromBool x - 1)-  iEnumBool .enumFromTo     a b    = fromTo fromBool toBool a b-  iEnumBool .enumFromThenTo a a₁ b = fromThenTo fromBool toBool a a₁ b-  iEnumBool .enumFrom       a      = fromTo fromBool toBool a maxBound-  iEnumBool .enumFromThen   a a₁   =-    if a < a₁ then fromThenTo fromBool toBool a a₁ maxBound-              else fromThenTo fromBool toBool a a₁ minBound--private-  fromOrdering : Ordering → Integer-  fromOrdering = λ where LT → 0; EQ → 1; GT → 2--  toOrdering : Integer → Ordering-  toOrdering = λ where (pos 0) → LT; (pos 1) → EQ; _ → GT--instance-  iEnumOrdering : Enum Ordering-  iEnumOrdering .BoundedBelowEnum      = Just it-  iEnumOrdering .BoundedAboveEnum      = Just it-  iEnumOrdering .fromEnum              = integerToInt ∘ fromOrdering-  iEnumOrdering .toEnum         n      = toOrdering (intToInteger n)-  iEnumOrdering .succ           x      = toOrdering (fromOrdering x + 1)-  iEnumOrdering .pred           x      = toOrdering (fromOrdering x - 1)-  iEnumOrdering .enumFromTo     a b    = fromTo fromOrdering toOrdering a b-  iEnumOrdering .enumFromThenTo a a₁ b = fromThenTo fromOrdering toOrdering a a₁ b-  iEnumOrdering .enumFrom       a      = fromTo fromOrdering toOrdering a maxBound-  iEnumOrdering .enumFromThen   a a₁   =-    if a < a₁ then fromThenTo fromOrdering toOrdering a a₁ maxBound-              else fromThenTo fromOrdering toOrdering a a₁ minBound--private-  fromUnit : ⊤ → Integer-  fromUnit _ = 0--  toUnit : Integer → ⊤-  toUnit _ = tt--instance-  iEnumUnit : Enum ⊤-  iEnumUnit .BoundedBelowEnum      = Just it-  iEnumUnit .BoundedAboveEnum      = Just it-  iEnumUnit .fromEnum              = integerToInt ∘ fromUnit-  iEnumUnit .toEnum         n      = toUnit (intToInteger n)-  iEnumUnit .succ           x      = toUnit (fromUnit x + 1)-  iEnumUnit .pred           x      = toUnit (fromUnit x - 1)-  iEnumUnit .enumFromTo     a b    = fromTo fromUnit toUnit a b-  iEnumUnit .enumFromThenTo a a₁ b = fromThenTo fromUnit toUnit a a₁ b-  iEnumUnit .enumFrom       a      = fromTo fromUnit toUnit a maxBound-  iEnumUnit .enumFromThen   a a₁   =-    if a < a₁ then fromThenTo fromUnit toUnit a a₁ maxBound-              else fromThenTo fromUnit toUnit a a₁ minBound--private-  fromChar : Char → Integer-  fromChar = pos ∘ c2n--  toChar : Integer → Char-  toChar = λ where (pos n) → primNatToChar n; _ → '_'--instance-  iEnumChar : Enum Char-  iEnumChar .BoundedBelowEnum      = Just it-  iEnumChar .BoundedAboveEnum      = Just it-  iEnumChar .fromEnum              = integerToInt ∘ fromChar-  iEnumChar .toEnum         n      = toChar (intToInteger n)-  iEnumChar .succ           x      = toChar (fromChar x + 1)-  iEnumChar .pred           x      = toChar (fromChar x - 1)-  iEnumChar .enumFromTo     a b    = fromTo fromChar toChar a b-  iEnumChar .enumFromThenTo a a₁ b = fromThenTo fromChar toChar a a₁ b-  iEnumChar .enumFrom       a      = fromTo fromChar toChar a maxBound-  iEnumChar .enumFromThen   a a₁   =-    if a < a₁ then fromThenTo fromChar toChar a a₁ maxBound-              else fromThenTo fromChar toChar a a₁ minBound--  -- Missing:-  --  Enum Double  (can't go via Integer)
− lib/Haskell/Prim/Eq.agda 
@@ -1,82 +0,0 @@--module Haskell.Prim.Eq where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.Char-open import Haskell.Prim.Integer-open import Haskell.Prim.Int-open import Haskell.Prim.Word-open import Haskell.Prim.Double-open import Haskell.Prim.Tuple-open import Haskell.Prim.Maybe-open import Haskell.Prim.Either------------------------------------------------------- Eq--record Eq (a : Set) : Set where-  infix 4 _==_-  field-    _==_ : a → a → Bool--open Eq ⦃...⦄ public--{-# COMPILE AGDA2HS Eq existing-class #-}--_/=_ : {{Eq a}} → a → a → Bool-x /= y = not (x == y)--infix 4 _/=_--instance-  iEqNat : Eq Nat-  iEqNat ._==_ = eqNat--  iEqInteger : Eq Integer-  iEqInteger ._==_ = eqInteger--  iEqInt : Eq Int-  iEqInt ._==_ = eqInt--  iEqWord : Eq Word-  iEqWord ._==_ = eqWord--  iEqDouble : Eq Double-  iEqDouble ._==_ = primFloatEquality--  iEqBool : Eq Bool-  iEqBool ._==_ False False = True-  iEqBool ._==_ True  True  = True-  iEqBool ._==_ _     _     = False--  iEqChar : Eq Char-  iEqChar ._==_ = eqChar--  iEqUnit : Eq ⊤-  iEqUnit ._==_ _ _ = True--  iEqTuple₂ : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (a × b)-  iEqTuple₂ ._==_ (x₁ , y₁) (x₂ , y₂) = x₁ == x₂ && y₁ == y₂--  iEqTuple₃ : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → ⦃ Eq c ⦄ → Eq (a × b × c)-  iEqTuple₃ ._==_ (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) = x₁ == x₂ && y₁ == y₂ && z₁ == z₂--  iEqList : ⦃ Eq a ⦄ → Eq (List a)-  iEqList {a} ._==_ = eqList-    where-      eqList : List a → List a → Bool-      eqList [] [] = True-      eqList (x ∷ xs) (y ∷ ys) = x == y && eqList xs ys-      eqList _ _ = False---  iEqMaybe : ⦃ Eq a ⦄ → Eq (Maybe a)-  iEqMaybe ._==_ Nothing  Nothing  = True-  iEqMaybe ._==_ (Just x) (Just y) = x == y-  iEqMaybe ._==_ _        _        = False--  iEqEither : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (Either a b)-  iEqEither ._==_ (Left  x) (Left  y) = x == y-  iEqEither ._==_ (Right x) (Right y) = x == y-  iEqEither ._==_ _        _          = False
− lib/Haskell/Prim/Foldable.agda 
@@ -1,122 +0,0 @@--module Haskell.Prim.Foldable where--open import Haskell.Prim-open import Haskell.Prim.Num hiding (abs)-open import Haskell.Prim.Eq-open import Haskell.Prim.List-open import Haskell.Prim.Int-open import Haskell.Prim.Bool-open import Haskell.Prim.Maybe-open import Haskell.Prim.Either-open import Haskell.Prim.Tuple-open import Haskell.Prim.Monoid------------------------------------------------------- Foldable---- ** base-record Foldable (t : Set → Set) : Set₁ where-  field-    foldMap : ⦃ Monoid b ⦄ → (a → b) → t a → b-    foldr : (a → b → b) → b → t a → b-    foldl : (b → a → b) → b → t a → b-    any : (a → Bool) → t a → Bool-    all : (a → Bool) → t a → Bool-    and : t Bool → Bool-    null : t a → Bool-    or : t Bool → Bool-    concat : t (List a) → List a-    concatMap : (a → List b) → t a → List b-    elem : ⦃ Eq a ⦄ → a → t a → Bool-    notElem : ⦃ Eq a ⦄ → a → t a → Bool-    toList : t a → List a-    sum : ⦃ iNum : Num a ⦄ → t a → a-    product : ⦃ iNum : Num a ⦄ → t a → a-    length : t a → Int--- ** defaults-record DefaultFoldable (t : Set → Set) : Set₁ where-  module M = Foldable {t = t}-  field foldMap : ⦃ Monoid b ⦄ → (a → b) → t a → b--  foldr : (a → b → b) → b → t a → b-  foldr f z t = foldMap ⦃ MonoidEndo ⦄ f t z--  foldl : (b → a → b) → b → t a → b-  foldl f z t = foldMap ⦃ MonoidEndoᵒᵖ ⦄ (flip f) t z--  any : (a → Bool) → t a → Bool-  any = foldMap ⦃ MonoidDisj ⦄--  all : (a → Bool) → t a → Bool-  all = foldMap ⦃ MonoidConj ⦄--  and : t Bool → Bool-  and = all id--  or : t Bool → Bool-  or = any id--  null : t a → Bool-  null = all (const False)--  concat : t (List a) → List a-  concat = foldMap id--  concatMap : (a → List b) → t a → List b-  concatMap = foldMap--  elem : ⦃ Eq a ⦄ → a → t a → Bool-  elem x = foldMap ⦃ MonoidDisj ⦄ (x ==_)--  notElem : ⦃ Eq a ⦄ → a → t a → Bool-  notElem x t = not (elem x t)--  toList : t a → List a-  toList = foldr _∷_ []--  sum : ⦃ iNum : Num a ⦄ → t a → a-  sum = foldMap ⦃ MonoidSum ⦄ id--  product : ⦃ iNum : Num a ⦄ → t a → a-  product = foldMap ⦃ MonoidProduct ⦄ id--  length : t a → Int-  length = foldMap ⦃ MonoidSum ⦄ (const 1)--- ** export-open Foldable ⦃...⦄ public-{-# COMPILE AGDA2HS Foldable existing-class #-}---- ** instances-instance-  iDefaultFoldableList : DefaultFoldable List-  iDefaultFoldableList .DefaultFoldable.foldMap = foldMapList-    where-      foldMapList : ⦃ Monoid b ⦄ → (a → b) → List a → b-      foldMapList f []       = mempty-      foldMapList f (x ∷ xs) = f x <> foldMapList f xs--  iFoldableList : Foldable List-  iFoldableList = record {DefaultFoldable iDefaultFoldableList}--  iDefaultFoldableMaybe : DefaultFoldable Maybe-  iDefaultFoldableMaybe .DefaultFoldable.foldMap = λ where-    _ Nothing  → mempty-    f (Just x) → f x--  iFoldableMaybe : Foldable Maybe-  iFoldableMaybe = record {DefaultFoldable iDefaultFoldableMaybe}--  iDefaultFoldableEither : DefaultFoldable (Either a)-  iDefaultFoldableEither .DefaultFoldable.foldMap = λ where-    _ (Left _)  → mempty-    f (Right x) → f x--  iFoldableEither : Foldable (Either a)-  iFoldableEither = record {DefaultFoldable iDefaultFoldableEither}--  iDefaultFoldablePair : DefaultFoldable (a ×_)-  iDefaultFoldablePair .DefaultFoldable.foldMap = λ f (_ , x) → f x--  iFoldablePair : Foldable (a ×_)-  iFoldablePair = record {DefaultFoldable iDefaultFoldablePair}
− lib/Haskell/Prim/Functor.agda 
@@ -1,89 +0,0 @@--module Haskell.Prim.Functor where--open import Haskell.Prim-open import Haskell.Prim.Either-open import Haskell.Prim.IO-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Tuple------------------------------------------------------- Functor---- ** base-record Functor (f : Set → Set) : Set₁ where-  infixl 4 _<$_-  field-    fmap : (a → b) → f a → f b-    _<$_ : (@0 {{ b }} → a) → f b → f a--- ** defaults-record DefaultFunctor (f : Set → Set) : Set₁ where-  field fmap : (a → b) → f a → f b--  infixl 4 _<$_--  _<$_ : (@0 {{ b }} → a) → f b → f a-  x <$ m = fmap (λ b → x {{b}}) m---- ** export-open Functor ⦃...⦄ public-{-# COMPILE AGDA2HS Functor existing-class #-}--_<$>_ : {{Functor f}} → (a → b) → f a → f b-_<$>_ = fmap--_<&>_ : {{Functor f}} → f a → (a → b) → f b-m <&> f = fmap f m--_$>_ : {{Functor f}} → f a → (@0 {{ a }} → b) → f b-m $> x = x <$ m--void : {{Functor f}} → f a → f ⊤-void = tt <$_--infixl 1 _<&>_-infixl 4 _<$>_ _$>_--instance-  iDefaultFunctorList : DefaultFunctor List-  iDefaultFunctorList .DefaultFunctor.fmap = map--  iFunctorList : Functor List-  iFunctorList = record{DefaultFunctor iDefaultFunctorList}--  iDefaultFunctorMaybe : DefaultFunctor Maybe-  iDefaultFunctorMaybe .DefaultFunctor.fmap = λ where-    f Nothing  → Nothing-    f (Just x) → Just (f x)--  iFunctorMaybe : Functor Maybe-  iFunctorMaybe = record{DefaultFunctor iDefaultFunctorMaybe}--  iDefaultFunctorEither : DefaultFunctor (Either a)-  iDefaultFunctorEither .DefaultFunctor.fmap = λ where-    f (Left  x) → Left x-    f (Right y) → Right (f y)--  iFunctorEither : Functor (Either a)-  iFunctorEither = record{DefaultFunctor iDefaultFunctorEither}--  iDefaultFunctorFun : DefaultFunctor (λ b → a → b)-  iDefaultFunctorFun .DefaultFunctor.fmap = _∘_--  iFunctorFun : Functor (λ b → a → b)-  iFunctorFun = record{DefaultFunctor iDefaultFunctorFun}--  iDefaultFunctorTuple₂ : DefaultFunctor (a ×_)-  iDefaultFunctorTuple₂ .DefaultFunctor.fmap = λ f (x , y) → x , f y--  iFunctorTuple₂ : Functor (a ×_)-  iFunctorTuple₂ = record{DefaultFunctor iDefaultFunctorTuple₂}--  iDefaultFunctorTuple₃ : DefaultFunctor (a × b ×_)-  iDefaultFunctorTuple₃ .DefaultFunctor.fmap = λ where f (x , y , z) → x , y , f z--  iFunctorTuple₃ : Functor (a × b ×_)-  iFunctorTuple₃ = record{DefaultFunctor iDefaultFunctorTuple₃}--instance postulate iFunctorIO : Functor IO
− lib/Haskell/Prim/IO.agda 
@@ -1,27 +0,0 @@-module Haskell.Prim.IO where--open import Haskell.Prim-open import Haskell.Prim.Show-open import Haskell.Prim.String--postulate IO : ∀{a} → Set a → Set a--FilePath = String--postulate-  -- Input functions-  interact       : (String → String) → IO ⊤-  getContents    : IO String-  getLine        : IO String-  getChar        : IO Char--  -- Output functions-  print          : ⦃ Show a ⦄ → a → IO ⊤-  putChar        : Char → IO ⊤-  putStr         : String → IO ⊤-  putStrLn       : String → IO ⊤--  -- Files-  readFile       : FilePath → IO String-  writeFile      : FilePath → String → IO ⊤-  appendFile     : FilePath → String → IO ⊤
− lib/Haskell/Prim/Int.agda 
@@ -1,110 +0,0 @@-{-# OPTIONS --no-auto-inline #-}---- Agda doesn't have an Int type (only Word64). With some work we--- can represent signed ints using Word64.--module Haskell.Prim.Int where--open import Haskell.Prim-open import Haskell.Prim.Word-open import Haskell.Prim.Integer-open import Haskell.Prim.Bool-------------------------------------------------------- Definition--data Int : Set where-  int64 : Word64 → Int--intToWord : Int → Word64-intToWord (int64 a) = a--unsafeIntToNat : Int → Nat-unsafeIntToNat a = w2n (intToWord a)-------------------------------------------------------- Literals--private-  2⁶⁴ : Nat-  2⁶⁴ = 18446744073709551616--  2⁶³ : Nat-  2⁶³ = 9223372036854775808--  maxInt : Nat-  maxInt = monusNat 2⁶³ 1--instance-  iNumberInt : Number Int-  iNumberInt .Number.Constraint n = IsTrue (ltNat n 2⁶³)-  iNumberInt .fromNat n = int64 (n2w n)--  iNegativeInt : Negative Int-  iNegativeInt .Negative.Constraint n = IsTrue (ltNat n (addNat 1 2⁶³))-  iNegativeInt .fromNeg n = int64 (n2w (monusNat 2⁶⁴ n))-------------------------------------------------------- Arithmetic--isNegativeInt : Int → Bool-isNegativeInt (int64 w) = ltNat maxInt (w2n w)--eqInt : Int → Int → Bool-eqInt (int64 a) (int64 b) = eqNat (w2n a) (w2n b)--negateInt : Int → Int-negateInt (int64 a) = int64 (n2w (monusNat 2⁶⁴ (w2n a)))--intToInteger : Int → Integer-intToInteger a = if isNegativeInt a then negsuc (monusNat (unsafeIntToNat (negateInt a)) 1)-                                    else pos (unsafeIntToNat a)--integerToInt : Integer → Int-integerToInt (pos    n) = int64 (n2w n)-integerToInt (negsuc n) = negateInt (int64 (n2w (suc n)))--private-  ltPosInt : Int → Int → Bool-  ltPosInt (int64 a) (int64 b) = ltWord a b--ltInt : Int → Int → Bool-ltInt a b with isNegativeInt a | isNegativeInt b-... | True  | False = True-... | False | True  = False-... | True  | True  = ltPosInt (negateInt b) (negateInt a)-... | False | False = ltPosInt a b--addInt : Int → Int → Int-addInt (int64 a) (int64 b) = int64 (addWord a b)--subInt : Int → Int → Int-subInt a b = addInt a (negateInt b)--mulInt : Int → Int → Int-mulInt (int64 a) (int64 b) = int64 (mulWord a b)--absInt : Int → Int-absInt a = if isNegativeInt a then negateInt a else a--signInt : Int → Int-signInt a = if      isNegativeInt a then -1-            else if eqInt a 0       then 0 else 1--showInt : Int → List Char-showInt a = showInteger (intToInteger a)-------------------------------------------------------- Constraints--@0 IsNonNegativeInt : Int → Set-IsNonNegativeInt a@(int64 _) =-  if isNegativeInt a then TypeError (primStringAppend (primStringFromList (showInt a)) " is negative")-                     else ⊤--intToNat : (a : Int) → @0 ⦃ IsNonNegativeInt a ⦄ → Nat-intToNat a = unsafeIntToNat a
− lib/Haskell/Prim/Integer.agda 
@@ -1,106 +0,0 @@--module Haskell.Prim.Integer where--open import Haskell.Prim-open import Haskell.Prim.Bool--{-|-This module contains functions that should not be used-within code that is supposed to be translated to Haskell.-Nevertheless, these functions must be accessible for-proofs (within the standard library).-Hence, these functions are not flagged as private but-instead are collected in a dedicated module that is not-opened by default.--}-module Internal where-  negNat : Nat → Integer-  negNat 0       = pos 0-  negNat (suc n) = negsuc n--  subNat : Nat → Nat → Integer-  subNat n       zero    = pos n-  subNat zero    (suc m) = negsuc m-  subNat (suc n) (suc m) = subNat n m-open Internal------------------------------------------------------- Literals---instance-  iNumberInteger : Number Integer-  iNumberInteger .Number.Constraint _ = ⊤-  iNumberInteger .fromNat n = pos n--  iNegativeInteger : Negative Integer-  iNegativeInteger .Negative.Constraint _ = ⊤-  iNegativeInteger .fromNeg n = negNat n-------------------------------------------------------- Arithmetic--negateInteger : Integer → Integer-negateInteger (pos 0)       = pos 0-negateInteger (pos (suc n)) = negsuc n-negateInteger (negsuc n)    = pos (suc n)--addInteger : Integer → Integer → Integer-addInteger (pos    n) (pos    m) = pos (addNat n m)-addInteger (pos    n) (negsuc m) = subNat n (suc m)-addInteger (negsuc n) (pos    m) = subNat m (suc n)-addInteger (negsuc n) (negsuc m) = negsuc (suc (addNat n m))--subInteger : Integer → Integer → Integer-subInteger n m = addInteger n (negateInteger m)--mulInteger : Integer → Integer → Integer-mulInteger (pos    n) (pos    m) = pos (mulNat n m)-mulInteger (pos    n) (negsuc m) = negNat (mulNat n (suc m))-mulInteger (negsuc n) (pos    m) = negNat (mulNat (suc n) m)-mulInteger (negsuc n) (negsuc m) = pos (mulNat (suc n) (suc m))--absInteger : Integer → Integer-absInteger (pos    n) = pos n-absInteger (negsuc n) = pos (suc n)--signInteger : Integer → Integer-signInteger (pos 0)       = 0-signInteger (pos (suc _)) = 1-signInteger (negsuc _)    = -1-------------------------------------------------------- Comparisons--eqInteger : Integer → Integer → Bool-eqInteger (pos n)    (pos m)    = eqNat n m-eqInteger (negsuc n) (negsuc m) = eqNat n m-eqInteger _          _          = False--ltInteger : Integer → Integer → Bool-ltInteger (pos    n) (pos    m) = ltNat n m-ltInteger (pos    n) (negsuc _) = False-ltInteger (negsuc n) (pos    _) = True-ltInteger (negsuc n) (negsuc m) = ltNat m n-------------------------------------------------------- Show--showInteger : Integer → List Char-showInteger n = primStringToList (primShowInteger n)-------------------------------------------------------- Constraints--isNegativeInteger : Integer → Bool-isNegativeInteger (pos _)    = False-isNegativeInteger (negsuc _) = True--@0 IsNonNegativeInteger : Integer → Set-IsNonNegativeInteger (pos _)      = ⊤-IsNonNegativeInteger n@(negsuc _) =-  TypeError (primStringAppend (primShowInteger n) (" is negative"))
− lib/Haskell/Prim/List.agda 
@@ -1,128 +0,0 @@--module Haskell.Prim.List where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.Tuple-open import Haskell.Prim.Int-------------------------------------------------------- List--map : (a → b) → List a → List b-map f []       = []-map f (x ∷ xs) = f x ∷ map f xs--infixr 5 _++_-_++_ : ∀ {@0 ℓ} {@0 a : Set ℓ} → List a → List a → List a-[]       ++ ys = ys-(x ∷ xs) ++ ys = x ∷ xs ++ ys--filter : (a → Bool) → List a → List a-filter p []       = []-filter p (x ∷ xs) = if p x then x ∷ filter p xs else filter p xs--scanl : (b → a → b) → b → List a → List b-scanl f z []       = z ∷ []-scanl f z (x ∷ xs) = z ∷ scanl f (f z x) xs--scanr : (a → b → b) → b → List a → List b-scanr f z [] = z ∷ []-scanr f z (x ∷ xs) =-  case scanr f z xs of λ where-    []         → [] -- impossible-    qs@(q ∷ _) → f x q ∷ qs--scanl1 : (a → a → a) → List a → List a-scanl1 f []       = []-scanl1 f (x ∷ xs) = scanl f x xs--scanr1 : (a → a → a) → List a → List a-scanr1 f []       = []-scanr1 f (x ∷ []) = x ∷ []-scanr1 f (x ∷ xs) =-  case scanr1 f xs of λ where-    []         → [] -- impossible-    qs@(q ∷ _) → f x q ∷ qs--takeWhile : (a → Bool) → List a → List a-takeWhile p [] = []-takeWhile p (x ∷ xs) = if p x then x ∷ takeWhile p xs else []--dropWhile : (a → Bool) → List a → List a-dropWhile p [] = []-dropWhile p (x ∷ xs) = if p x then dropWhile p xs else x ∷ xs--span : (a → Bool) → List a → List a × List a-span p [] = [] , []-span p (x ∷ xs) = if p x then first (x ∷_) (span p xs)-                         else ([] , x ∷ xs)--break : (a → Bool) → List a → List a × List a-break p = span (not ∘ p)--zipWith : (a → b → c) → List a → List b → List c-zipWith f []       _        = []-zipWith f _        []       = []-zipWith f (x ∷ xs) (y ∷ ys) = f x y ∷ zipWith f xs ys--zip : List a → List b → List (a × b)-zip = zipWith _,_--zipWith3 : (a → b → c → d) → List a → List b → List c → List d-zipWith3 f []       _        _        = []-zipWith3 f _        []       _        = []-zipWith3 f _        _        []       = []-zipWith3 f (x ∷ xs) (y ∷ ys) (z ∷ zs) = f x y z ∷ zipWith3 f xs ys zs--zip3 : List a → List b → List c → List (a × b × c)-zip3 = zipWith3 _,_,_--unzip : List (a × b) → List a × List b-unzip []              = [] , []-unzip ((x , y) ∷ xys) = (x ∷_) *** (y ∷_) $ unzip xys--unzip3 : List (a × b × c) → List a × List b × List c-unzip3 []                   = [] , [] , []-unzip3 ((x , y , z) ∷ xyzs) =-  case unzip3 xyzs of λ where-    (xs , ys , zs) → x ∷ xs , y ∷ ys , z ∷ zs--takeNat : Nat → List a → List a-takeNat n       [] = []-takeNat zero    xs = []-takeNat (suc n) (x ∷ xs) = x ∷ takeNat n xs--take : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a-take n xs = takeNat (intToNat n) xs--dropNat : Nat → List a → List a-dropNat n       [] = []-dropNat zero    xs = xs-dropNat (suc n) (_ ∷ xs) = dropNat n xs--drop : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a-drop n xs = dropNat (intToNat n) xs--splitAtNat : (n : Nat) → List a → List a × List a-splitAtNat _       []       = [] , []-splitAtNat 0       xs       = [] , xs-splitAtNat (suc n) (x ∷ xs) = first (x ∷_) (splitAtNat n xs)--splitAt : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a × List a-splitAt n xs = splitAtNat (intToNat n) xs--head : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a-head (x ∷ _) = x--tail : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a-tail (_ ∷ xs) = xs--last : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a-last (x ∷ [])         = x-last (_ ∷ xs@(_ ∷ _)) = last xs--init : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a-init (x ∷ [])         = []-init (x ∷ xs@(_ ∷ _)) = x ∷ init xs
− lib/Haskell/Prim/Maybe.agda 
@@ -1,17 +0,0 @@--module Haskell.Prim.Maybe where------------------------------------------------------- Maybe--data Maybe {@0 ℓ} (a : Set ℓ) : Set ℓ where-  Nothing : Maybe a-  Just    : a -> Maybe a--maybe : ∀ {@0 ℓ₁ ℓ₂} {@0 a : Set ℓ₁} {@0 b : Set ℓ₂} → b → (a → b) → Maybe a → b-maybe n j Nothing  = n-maybe n j (Just x) = j x--fromMaybe : {a : Set} → a → Maybe a → a-fromMaybe d Nothing = d-fromMaybe _ (Just x) = x
− lib/Haskell/Prim/Monad.agda 
@@ -1,129 +0,0 @@--module Haskell.Prim.Monad where--open import Haskell.Prim-open import Haskell.Prim.Applicative-open import Haskell.Prim.Either-open import Haskell.Prim.Foldable-open import Haskell.Prim.Functor-open import Haskell.Prim.IO-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Monoid-open import Haskell.Prim.String-open import Haskell.Prim.Tuple------------------------------------------------------- Monad--module Do where--  -- ** base-  record Monad (m : Set → Set) : Set₁ where-    field-      _>>=_ : m a → (a → m b) → m b-      overlap ⦃ super ⦄ : Applicative m-      return : a → m a-      _>>_ : m a → (@0 {{ a }} → m b) → m b-  -- ** defaults-  record DefaultMonad (m : Set → Set) : Set₁ where-    field-      _>>=_ : m a → (a → m b) → m b-      overlap ⦃ super ⦄ : Applicative m-    return : a → m a-    return = pure--    _>>_ : m a → (@0 {{ a }} → m b) → m b-    m >> m₁ = m >>= λ x → m₁ {{x}}--  -- ** export-  open Monad ⦃...⦄ public-  {-# COMPILE AGDA2HS Monad existing-class #-}---- Use `Dont._>>=_` and `Dont._>>_` if you do not want agda2hs to use--- do-notation.-module Dont where--  open Do using (Monad)--  _>>=_ : ⦃ Monad m ⦄ → m a → (a → m b) → m b-  _>>=_ = Do._>>=_--  _>>_ : ⦃ Monad m ⦄ → m a → (@0 {{ a }} → m b) → m b-  _>>_ = Do._>>_--open Do public--_=<<_ : {{Monad m}} → (a → m b) → m a → m b-_=<<_ = flip _>>=_--mapM₋ : ⦃ Monad m ⦄ → ⦃ Foldable t ⦄ → (a → m b) → t a → m ⊤-mapM₋ f = foldr (λ x k → f x >> k) (pure tt)--sequence₋ : ⦃ Monad m ⦄ → ⦃ Foldable t ⦄ → t (m a) → m ⊤-sequence₋ = foldr (λ mx my → mx >> my) (pure tt)---- ** instances-private-  mkMonad : DefaultMonad t → Monad t-  mkMonad x = record {DefaultMonad x}--  infix 0 bind=_-  bind=_ : ⦃ Applicative m ⦄ → (∀ {a b} → m a → (a → m b) → m b) → Monad m-  bind= x = record {DefaultMonad (record {_>>=_ = x})}-instance-  iDefaultMonadList : DefaultMonad List-  iDefaultMonadList .DefaultMonad._>>=_ = flip concatMap--  iMonadList : Monad List-  iMonadList = record {DefaultMonad iDefaultMonadList}--  iDefaultMonadMaybe : DefaultMonad Maybe-  iDefaultMonadMaybe .DefaultMonad._>>=_ = flip (maybe Nothing)--  iMonadMaybe : Monad Maybe-  iMonadMaybe = record {DefaultMonad iDefaultMonadMaybe}--  iDefaultMonadEither : DefaultMonad (Either a)-  iDefaultMonadEither .DefaultMonad._>>=_ = flip (either Left)--  iMonadEither : Monad (Either a)-  iMonadEither = record {DefaultMonad iDefaultMonadEither}--  iDefaultMonadFun : DefaultMonad (λ b → a → b)-  iDefaultMonadFun .DefaultMonad._>>=_ = λ f k r → k (f r) r--  iMonadFun : Monad (λ b → a → b)-  iMonadFun = record {DefaultMonad iDefaultMonadFun}--  iDefaultMonadTuple₂ : ⦃ Monoid a ⦄ → DefaultMonad (a ×_)-  iDefaultMonadTuple₂ .DefaultMonad._>>=_ = λ (a , x) k → first (a <>_) (k x)--  iMonadTuple₂ : ⦃ Monoid a ⦄ → Monad (a ×_)-  iMonadTuple₂ = record {DefaultMonad iDefaultMonadTuple₂}--  iDefaultMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultMonad (a × b ×_)-  iDefaultMonadTuple₃ .DefaultMonad._>>=_ = λ where-    (a , b , x) k → case k x of λ where-      (a₁ , b₁ , y) → a <> a₁ , b <> b₁ , y--  iMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monad (a × b ×_)-  iMonadTuple₃ = record {DefaultMonad iDefaultMonadTuple₃}--instance postulate iMonadIO : Monad IO--record MonadFail (m : Set → Set) : Set₁ where-  field-    fail : String → m a-    overlap ⦃ super ⦄ : Monad m--open MonadFail ⦃...⦄ public--{-# COMPILE AGDA2HS MonadFail existing-class #-}--instance-  MonadFailList : MonadFail List-  MonadFailList .fail _ = []--  MonadFailMaybe : MonadFail Maybe-  MonadFailMaybe .fail _ = Nothing
− lib/Haskell/Prim/Monoid.agda 
@@ -1,130 +0,0 @@--module Haskell.Prim.Monoid where--open import Haskell.Prim-open import Haskell.Prim.Bool-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Either-open import Haskell.Prim.Tuple------------------------------------------------------- Semigroup--record Semigroup (a : Set) : Set where-  infixr 6 _<>_-  field _<>_ : a → a → a-open Semigroup ⦃...⦄ public-{-# COMPILE AGDA2HS Semigroup existing-class #-}--instance-  iSemigroupList : Semigroup (List a)-  iSemigroupList ._<>_ = _++_--  iSemigroupMaybe : ⦃ Semigroup a ⦄ → Semigroup (Maybe a)-  iSemigroupMaybe ._<>_          Nothing m = m-  iSemigroupMaybe ._<>_ m        Nothing   = m-  iSemigroupMaybe ._<>_ (Just x) (Just y)  = Just (x <> y)--  iSemigroupEither : Semigroup (Either a b)-  iSemigroupEither ._<>_ (Left _) e = e-  iSemigroupEither ._<>_ e        _ = e--  iSemigroupFun : ⦃ Semigroup b ⦄ → Semigroup (a → b)-  iSemigroupFun ._<>_ f g x = f x <> g x--  iSemigroupUnit : Semigroup ⊤-  iSemigroupUnit ._<>_ _ _ = tt---  iSemigroupTuple₂ : ⦃ Semigroup a ⦄ → ⦃ Semigroup b ⦄ → Semigroup (a × b)-  iSemigroupTuple₂ ._<>_ (x₁ , y₁) (x₂ , y₂) = x₁ <> x₂ , y₁ <> y₂--  iSemigroupTuple₃ : ⦃ Semigroup a ⦄ → ⦃ Semigroup b ⦄ → ⦃ Semigroup c ⦄ → Semigroup (a × b × c)-  iSemigroupTuple₃ ._<>_ (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) = x₁ <> x₂ , y₁ <> y₂ , z₁ <> z₂-------------------------------------------------------- Monoid---- ** base-record Monoid (a : Set) : Set where-  field-    mempty : a-    overlap ⦃ super ⦄ : Semigroup a-    mappend : a → a → a-    mconcat : List a → a--- ** defaults-record DefaultMonoid (a : Set) : Set where-  field-    mempty : a-    overlap ⦃ super ⦄ : Semigroup a--  mappend : a → a → a-  mappend = _<>_--  mconcat : List a → a-  mconcat []       = mempty-  mconcat (x ∷ xs) = x <> mconcat xs--- ** export-open Monoid ⦃...⦄ public-{-# COMPILE AGDA2HS Monoid existing-class #-}--- ** instances-instance-  iDefaultMonoidList : DefaultMonoid (List a)-  iDefaultMonoidList .DefaultMonoid.mempty = []--  iMonoidList : Monoid (List a)-  iMonoidList = record{DefaultMonoid iDefaultMonoidList}--  iDefaultMonoidMaybe : ⦃ Semigroup a ⦄ → DefaultMonoid (Maybe a)-  iDefaultMonoidMaybe .DefaultMonoid.mempty = Nothing--  iMonoidMaybe : ⦃ Semigroup a ⦄ → Monoid (Maybe a)-  iMonoidMaybe = record{DefaultMonoid iDefaultMonoidMaybe}--  iDefaultMonoidFun : ⦃ Monoid b ⦄ → DefaultMonoid (a → b)-  iDefaultMonoidFun .DefaultMonoid.mempty = λ _ → mempty--  iMonoidFun : ⦃ Monoid b ⦄ → Monoid (a → b)-  iMonoidFun = record{DefaultMonoid iDefaultMonoidFun}--  iDefaultMonoidUnit : DefaultMonoid ⊤-  iDefaultMonoidUnit .DefaultMonoid.mempty = tt--  iMonoidUnit : Monoid ⊤-  iMonoidUnit = record{DefaultMonoid iDefaultMonoidUnit}--  iDefaultMonoidTuple₂ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultMonoid (a × b)-  iDefaultMonoidTuple₂ .DefaultMonoid.mempty = (mempty , mempty)--  iMonoidTuple₂ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monoid (a × b)-  iMonoidTuple₂ = record{DefaultMonoid iDefaultMonoidTuple₂}--  iDefaultMonoidTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → ⦃ Monoid c ⦄ → DefaultMonoid (a × b × c)-  iDefaultMonoidTuple₃ .DefaultMonoid.mempty = (mempty , mempty , mempty)--  iMonoidTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → ⦃ Monoid c ⦄ →  Monoid (a × b × c)-  iMonoidTuple₃ = record{DefaultMonoid iDefaultMonoidTuple₃}--open DefaultMonoid--MonoidEndo : Monoid (a → a)-MonoidEndo = record {DefaultMonoid (λ where-      .mempty → id-      .super ._<>_ → _∘_)}--MonoidEndoᵒᵖ : Monoid (a → a)-MonoidEndoᵒᵖ = record {DefaultMonoid (λ where-  .mempty      → id-  .super ._<>_ → flip _∘_) }--MonoidConj : Monoid Bool-MonoidConj = record {DefaultMonoid (λ where-  .mempty      → True-  .super ._<>_ → _&&_)}--MonoidDisj : Monoid Bool-MonoidDisj = record {DefaultMonoid (λ where-  .mempty      → False-  .super ._<>_ → _||_)}
− lib/Haskell/Prim/Num.agda 
@@ -1,120 +0,0 @@-{-# OPTIONS --no-auto-inline #-}--module Haskell.Prim.Num where--open import Haskell.Prim-open import Haskell.Prim.Word-open import Haskell.Prim.Int-open import Haskell.Prim.Integer-open import Haskell.Prim.Double-open import Haskell.Prim.Eq-open import Haskell.Prim.Ord-open import Haskell.Prim.Monoid------------------------------------------------------- Num--record Num (a : Set) : Set₁ where-  infixl 6 _+_ _-_-  infixl 7 _*_-  field-    @0 MinusOK       : a → a → Set-    @0 NegateOK      : a → Set-    @0 FromIntegerOK : Integer → Set-    _+_           : a → a → a-    _-_           : (x y : a) → @0 ⦃ MinusOK x y ⦄ → a-    _*_           : a → a → a-    negate        : (x : a) → @0 ⦃ NegateOK x ⦄ → a-    abs           : a → a-    signum        : a → a-    fromInteger   : (n : Integer) → @0 ⦃ FromIntegerOK n ⦄ → a-    overlap ⦃ number ⦄  : Number a-    overlap ⦃ numZero ⦄ : number .Number.Constraint 0-    overlap ⦃ numOne ⦄  : number .Number.Constraint 1--open Num ⦃...⦄ public hiding (FromIntegerOK; number)--{-# COMPILE AGDA2HS Num existing-class #-}--instance-  iNumNat : Num Nat-  iNumNat .MinusOK n m      = IsFalse (ltNat n m)-  iNumNat .NegateOK 0       = ⊤-  iNumNat .NegateOK (suc _) = ⊥-  iNumNat .Num.FromIntegerOK (negsuc _) = ⊥-  iNumNat .Num.FromIntegerOK (pos _) = ⊤-  iNumNat ._+_ n m = addNat n m-  iNumNat ._-_ n m = monusNat n m-  iNumNat ._*_ n m = mulNat n m-  iNumNat .negate n = n-  iNumNat .abs    n = n-  iNumNat .signum 0       = 0-  iNumNat .signum (suc n) = 1-  iNumNat .fromInteger (pos n) = n-  iNumNat .fromInteger (negsuc _) ⦃ () ⦄--  iNumInt : Num Int-  iNumInt .MinusOK _ _         = ⊤-  iNumInt .NegateOK _          = ⊤-  iNumInt .Num.FromIntegerOK _ = ⊤-  iNumInt ._+_ x y             = addInt x y-  iNumInt ._-_ x y             = subInt x y-  iNumInt ._*_ x y             = mulInt x y-  iNumInt .negate x            = negateInt x-  iNumInt .abs x               = absInt x-  iNumInt .signum x            = signInt x-  iNumInt .fromInteger n       = integerToInt n--  iNumInteger : Num Integer-  iNumInteger .MinusOK _ _ = ⊤-  iNumInteger .NegateOK _          = ⊤-  iNumInteger .Num.FromIntegerOK _ = ⊤-  iNumInteger ._+_ x y             = addInteger x y-  iNumInteger ._-_ x y             = subInteger x y-  iNumInteger ._*_ x y             = mulInteger x y-  iNumInteger .negate x            = negateInteger x-  iNumInteger .abs x               = absInteger x-  iNumInteger .signum x            = signInteger x-  iNumInteger .fromInteger n       = n--  iNumWord : Num Word-  iNumWord .MinusOK _ _         = ⊤-  iNumWord .NegateOK _          = ⊤-  iNumWord .Num.FromIntegerOK _ = ⊤-  iNumWord ._+_ x y             = addWord x y-  iNumWord ._-_ x y             = subWord x y-  iNumWord ._*_ x y             = mulWord x y-  iNumWord .negate x            = negateWord x-  iNumWord .abs x               = x-  iNumWord .signum x            = if x == 0 then 0 else 1-  iNumWord .fromInteger n       = integerToWord n--  iNumDouble : Num Double-  iNumDouble .MinusOK _ _         = ⊤-  iNumDouble .NegateOK _          = ⊤-  iNumDouble .Num.FromIntegerOK _ = ⊤-  iNumDouble ._+_ x y             = primFloatPlus x y-  iNumDouble ._-_ x y             = primFloatMinus x y-  iNumDouble ._*_ x y             = primFloatTimes x y-  iNumDouble .negate x            = primFloatMinus 0.0 x-  iNumDouble .abs x               = if x < 0.0 then primFloatMinus 0.0 x else x-  iNumDouble .signum x            = case compare x 0.0 of λ where-                                      LT → -1.0-                                      EQ → x-                                      GT → 1.0-  iNumDouble .fromInteger (pos    n) = fromNat n-  iNumDouble .fromInteger (negsuc n) = fromNeg (suc n)--open DefaultMonoid--MonoidSum : ⦃ iNum : Num a ⦄ → Monoid a-MonoidSum = record {DefaultMonoid (λ where-  .mempty      → 0-  .super ._<>_ → _+_- )}--MonoidProduct : ⦃ iNum : Num a ⦄ → Monoid a-MonoidProduct = record {DefaultMonoid (λ where-  .mempty      → 1-  .super ._<>_ → _*_- )}
− lib/Haskell/Prim/Ord.agda 
@@ -1,234 +0,0 @@--module Haskell.Prim.Ord where--open import Haskell.Prim-open import Haskell.Prim.Eq-open import Haskell.Prim.Bool-open import Haskell.Prim.Int-open import Haskell.Prim.Word-open import Haskell.Prim.Integer-open import Haskell.Prim.Double-open import Haskell.Prim.Tuple-open import Haskell.Prim.Monoid-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Either------------------------------------------------------- Ordering--data Ordering : Set where-  LT EQ GT : Ordering--instance-  iEqOrdering : Eq Ordering-  iEqOrdering ._==_ LT LT = True-  iEqOrdering ._==_ EQ EQ = True-  iEqOrdering ._==_ GT GT = True-  iEqOrdering ._==_ _  _  = False--  iSemigroupOrdering : Semigroup Ordering-  iSemigroupOrdering ._<>_ LT _ = LT-  iSemigroupOrdering ._<>_ EQ o = o-  iSemigroupOrdering ._<>_ GT _ = GT--  iMonoidOrdering : Monoid Ordering-  iMonoidOrdering = record {DefaultMonoid (record {mempty = EQ})}------------------------------------------------------- Ord--record Ord (a : Set) : Set where-  field-    compare : a → a → Ordering-    _<_  : a → a → Bool-    _>_  : a → a → Bool-    _>=_ : a → a → Bool-    _<=_ : a → a → Bool-    max  : a → a → a-    min  : a → a → a-    overlap ⦃ super ⦄ : Eq a--  infix 4 _<_ _>_ _<=_ _>=_--record OrdFromCompare (a : Set) : Set where-  field-    compare : a → a → Ordering-    overlap ⦃ super ⦄ : Eq a--  _<_  : a → a → Bool-  x < y = compare x y == LT--  _>_  : a → a → Bool-  x > y = compare x y == GT--  _>=_ : a → a → Bool-  x >= y = compare x y /= LT--  _<=_ : a → a → Bool-  x <= y = compare x y /= GT--  max  : a → a → a-  max x y = if compare x y == LT then y else x--  min  : a → a → a-  min x y = if compare x y == GT then y else x--record OrdFromLessThan (a : Set) : Set where-  field-    _<_ : a → a → Bool-    overlap ⦃ super ⦄ : Eq a--  compare : a → a → Ordering-  compare x y = if x < y then LT else if x == y then EQ else GT--  _>_  : a → a → Bool-  x > y = y < x--  _>=_ : a → a → Bool-  x >= y = y < x || x == y--  _<=_ : a → a → Bool-  x <= y = x < y || x == y--  max  : a → a → a-  max x y = if x < y then y else x--  min  : a → a → a-  min x y = if y < x then y else x---open Ord ⦃...⦄ public--{-# COMPILE AGDA2HS Ord existing-class #-}--private-  compareFromLt : ⦃ Eq a ⦄ → (a → a → Bool) → a → a → Ordering-  compareFromLt _<_ x y = if x < y then LT else if x == y then EQ else GT--private-  maxNat : Nat → Nat → Nat-  maxNat zero    y       = y-  maxNat (suc x) zero    = suc x-  maxNat (suc x) (suc y) = suc (maxNat x y)--  minNat : Nat → Nat → Nat-  minNat zero    y       = zero-  minNat (suc x) zero    = zero-  minNat (suc x) (suc y) = suc (minNat x y)--instance-  iOrdFromLessThanNat : OrdFromLessThan Nat-  iOrdFromLessThanNat .OrdFromLessThan._<_ = ltNat--  iOrdNat : Ord Nat-  iOrdNat = record-    { OrdFromLessThan iOrdFromLessThanNat-    ; max = maxNat-    ; min = minNat-    }--  iOrdFromLessThanInteger : OrdFromLessThan Integer-  iOrdFromLessThanInteger .OrdFromLessThan._<_ = ltInteger--  iOrdInteger : Ord Integer-  iOrdInteger = record {OrdFromLessThan iOrdFromLessThanInteger}--  iOrdFromLessThanInt : OrdFromLessThan Int-  iOrdFromLessThanInt .OrdFromLessThan._<_ = ltInt--  iOrdInt : Ord Int-  iOrdInt = record {OrdFromLessThan iOrdFromLessThanInt}--  iOrdFromLessThanWord : OrdFromLessThan Word-  iOrdFromLessThanWord .OrdFromLessThan._<_ = ltWord--  iOrdWord : Ord Word-  iOrdWord = record {OrdFromLessThan iOrdFromLessThanWord}--  iOrdFromLessThanDouble : OrdFromLessThan Double-  iOrdFromLessThanDouble .OrdFromLessThan._<_ = primFloatLess--  iOrdDouble : Ord Double-  iOrdDouble = record {OrdFromLessThan iOrdFromLessThanDouble}--  iOrdFromLessThanChar : OrdFromLessThan Char-  iOrdFromLessThanChar .OrdFromLessThan._<_ x y = c2n x < c2n y--  iOrdChar : Ord Char-  iOrdChar = record {OrdFromLessThan iOrdFromLessThanChar}--  iOrdFromCompareBool : OrdFromCompare Bool-  iOrdFromCompareBool .OrdFromCompare.compare = λ where-    False True  → LT-    True  False → GT-    _     _     → EQ--  iOrdBool : Ord Bool-  iOrdBool = record {OrdFromCompare iOrdFromCompareBool}--  iOrdFromCompareUnit : OrdFromCompare ⊤-  iOrdFromCompareUnit .OrdFromCompare.compare = λ _ _ → EQ--  iOrdUnit : Ord ⊤-  iOrdUnit = record {OrdFromCompare iOrdFromCompareUnit}--  iOrdFromCompareTuple₂ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → OrdFromCompare (a × b)-  iOrdFromCompareTuple₂ .OrdFromCompare.compare = λ where-    (x₁ , y₁) (x₂ , y₂) → compare x₁ x₂ <> compare y₁ y₂--  iOrdTuple₂ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → Ord (a × b)-  iOrdTuple₂ = record {OrdFromCompare iOrdFromCompareTuple₂}--  iOrdFromCompareTuple₃ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → ⦃ Ord c ⦄ → OrdFromCompare (a × b × c)-  iOrdFromCompareTuple₃ .OrdFromCompare.compare = λ where-    (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) → compare x₁ x₂ <> compare y₁ y₂ <> compare z₁ z₂--  iOrdTuple₃ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → ⦃ Ord c ⦄ → Ord (a × b × c)-  iOrdTuple₃ = record {OrdFromCompare iOrdFromCompareTuple₃}--compareList : ⦃ Ord a ⦄ → List a → List a → Ordering-compareList []       []       = EQ-compareList []       (_ ∷ _)  = LT-compareList (_ ∷ _)  []       = GT-compareList (x ∷ xs) (y ∷ ys) = compare x y <> compareList xs ys--instance-  iOrdFromCompareList : ⦃ Ord a ⦄ → OrdFromCompare (List a)-  iOrdFromCompareList .OrdFromCompare.compare = compareList--  iOrdList : ⦃ Ord a ⦄ → Ord (List a)-  iOrdList = record {OrdFromCompare iOrdFromCompareList}--  iOrdFromCompareMaybe : ⦃ Ord a ⦄ → OrdFromCompare (Maybe a)-  iOrdFromCompareMaybe .OrdFromCompare.compare = λ where-    Nothing  Nothing  → EQ-    Nothing  (Just _) → LT-    (Just _) Nothing  → GT-    (Just x) (Just y) → compare x y--  iOrdMaybe : ⦃ Ord a ⦄ → Ord (Maybe a)-  iOrdMaybe = record {OrdFromCompare iOrdFromCompareMaybe}--  iOrdFromCompareEither : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → OrdFromCompare (Either a b)-  iOrdFromCompareEither .OrdFromCompare.compare = λ where-    (Left  x) (Left  y) → compare x y-    (Left  _) (Right _) → LT-    (Right _) (Left  _) → GT-    (Right x) (Right y) → compare x y--  iOrdEither : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → Ord (Either a b)-  iOrdEither = record {OrdFromCompare iOrdFromCompareEither}--  iOrdFromCompareOrdering : OrdFromCompare Ordering-  iOrdFromCompareOrdering .OrdFromCompare.compare = λ where-    LT LT → EQ-    LT _  → LT-    _  LT → GT-    EQ EQ → EQ-    EQ GT → LT-    GT EQ → GT-    GT GT → EQ--  iOrdOrdering : Ord Ordering-  iOrdOrdering = record {OrdFromCompare iOrdFromCompareOrdering}
− lib/Haskell/Prim/Show.agda 
@@ -1,159 +0,0 @@--module Haskell.Prim.Show where--open import Haskell.Prim-open import Haskell.Prim.String-open import Haskell.Prim.List-open import Haskell.Prim.Word-open import Haskell.Prim.Double-open import Haskell.Prim.Maybe-open import Haskell.Prim.Eq-open import Haskell.Prim.Tuple-open import Haskell.Prim.Ord-open import Haskell.Prim.Either-open import Haskell.Prim.Integer-open import Haskell.Prim.Bool-open import Haskell.Prim.Int-open import Haskell.Prim.Foldable-------------------------------------------------------- Show--ShowS : Set-ShowS = String → String--showChar : Char → ShowS-showChar = _∷_--showString : String → ShowS-showString = _++_--showParen : Bool → ShowS → ShowS-showParen False s = s-showParen True  s = showString "(" ∘ s ∘ showString ")"--defaultShowList : (a → ShowS) → List a → ShowS-defaultShowList shows = λ where-  []       → showString "[]"-  (x ∷ xs) → showString "["-           ∘ foldl (λ s x → s ∘ showString "," ∘ shows x) (shows x) xs-           ∘ showString "]"---- ** base-record Show (a : Set) : Set where-  field-    showsPrec : Int → a → ShowS-    showList  : List a → ShowS-    show      : a → String--- ** export-record Show₁ (a : Set) : Set where-  field showsPrec : Int → a → ShowS--  show : a → String-  show x = showsPrec 0 x ""--  showList : List a → ShowS-  showList = defaultShowList (showsPrec 0)-record Show₂ (a : Set) : Set where-  field show : a → String--  showsPrec : Int → a → ShowS-  showsPrec _ x s = show x ++ s--  showList : List a → ShowS-  showList = defaultShowList (showsPrec 0)--- ** export-open Show ⦃...⦄ public--shows : ⦃ Show a ⦄ → a → ShowS-shows = showsPrec 0--{-# COMPILE AGDA2HS Show existing-class #-}---- ** instances-instance-  iShow₂Nat : Show₂ Nat-  iShow₂Nat .Show₂.show = primStringToList ∘ primShowNat--  iShowNat : Show Nat-  iShowNat = record {Show₂ iShow₂Nat}--  iShow₂Integer : Show₂ Integer-  iShow₂Integer .Show₂.show = showInteger--  iShowInteger : Show Integer-  iShowInteger = record {Show₂ iShow₂Integer}--  iShow₂Int : Show₂ Int-  iShow₂Int .Show₂.show = showInt--  iShowInt : Show Int-  iShowInt = record{Show₂ iShow₂Int}--  iShow₂Word : Show₂ Word-  iShow₂Word .Show₂.show = showWord--  iShowWord : Show Word-  iShowWord = record{Show₂ iShow₂Word}--  iShow₂Double : Show₂ Double-  iShow₂Double .Show₂.show = primStringToList ∘ primShowFloat--  iShowDouble : Show Double-  iShowDouble = record{Show₂ iShow₂Double}--  iShow₂Bool : Show₂ Bool-  iShow₂Bool .Show₂.show = λ where False → "False"; True → "True"--  iShowBool : Show Bool-  iShowBool = record{Show₂ iShow₂Bool}--  iShow₁Char : Show₁ Char-  iShow₁Char .Show₁.showsPrec _ = showString ∘ primStringToList ∘ primShowChar--  iShowChar : Show Char-  iShowChar = record{Show₁ iShow₁Char}--  iShow₁List : ⦃ Show a ⦄ → Show₁ (List a)-  iShow₁List .Show₁.showsPrec _ = showList--  iShowList : ⦃ Show a ⦄ → Show (List a)-  iShowList = record{Show₁ iShow₁List}--private-  showApp₁ : ⦃ Show a ⦄ → Int → String → a → ShowS-  showApp₁ p tag x = showParen (p > 10) $-    showString tag ∘ showString " " ∘ showsPrec 11 x--instance-  iShow₁Maybe : ⦃ Show a ⦄ → Show₁ (Maybe a)-  iShow₁Maybe .Show₁.showsPrec = λ where-    p Nothing  → showString "Nothing"-    p (Just x) → showApp₁ p "Just" x--  iShowMaybe : ⦃ Show a ⦄ → Show (Maybe a)-  iShowMaybe = record{Show₁ iShow₁Maybe}--  iShow₁Either : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show₁ (Either a b)-  iShow₁Either .Show₁.showsPrec = λ where-    p (Left  x) → showApp₁ p "Left"  x-    p (Right y) → showApp₁ p "Right" y--  iShowEither : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show (Either a b)-  iShowEither = record{Show₁ iShow₁Either}--instance-  iShow₁Tuple₂ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show₁ (a × b)-  iShow₁Tuple₂ .Show₁.showsPrec = λ _ → λ where-    (x , y) → showString "(" ∘ shows x ∘ showString ", " ∘ shows y ∘ showString ")"--  iShowTuple₂ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show (a × b)-  iShowTuple₂ = record{Show₁ iShow₁Tuple₂}--  iShow₁Tuple₃ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → ⦃ Show c ⦄ → Show₁ (a × b × c)-  iShow₁Tuple₃ .Show₁.showsPrec = λ _ → λ where-    (x , y , z) → showString "(" ∘ shows x ∘ showString ", " ∘ shows y ∘ showString ", " ∘ shows z ∘ showString ")"--  iShowTuple₃ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → ⦃ Show c ⦄ → Show (a × b × c)-  iShowTuple₃ = record{Show₁ iShow₁Tuple₃}
− lib/Haskell/Prim/Strict.agda 
@@ -1,12 +0,0 @@--module Haskell.Prim.Strict where--open import Haskell.Prim--record Strict (a : Set ℓ) : Set ℓ where-  constructor !_-  field-    force : a-open Strict public--{-# COMPILE AGDA2HS Strict unboxed-strict #-}
− lib/Haskell/Prim/String.agda 
@@ -1,52 +0,0 @@--module Haskell.Prim.String where--open import Haskell.Prim-open import Haskell.Prim.List-open import Haskell.Prim.Foldable------------------------------------------------------- String--- This is _not_ the builtin String type of Agda--- which is defined by postulates.--- `fromString` can be used to convert back--- to builtin Agda strings.--String = List Char--instance-  iIsStringString : IsString String-  iIsStringString .IsString.Constraint _ = ⊤-  iIsStringString .fromString s = primStringToList s--private-  cons : Char → List String → List String-  cons c []       = (c ∷ []) ∷ []-  cons c (s ∷ ss) = (c ∷ s) ∷ ss--lines : String → List String-lines []         = []-lines ('\n' ∷ s) = [] ∷ lines s-lines (c    ∷ s) = cons c (lines s)--private- mutual-  space : String → List String-  space [] = []-  space (c ∷ s) = if primIsSpace c then space s else cons c (word s)--  word  : String → List String-  word []      = []-  word (c ∷ s) = if primIsSpace c then [] ∷ space s else cons c (word s)--words : String → List String-words [] = []-words s@(c ∷ s₁) = if primIsSpace c then space s₁ else word s--unlines : List String → String-unlines = concatMap (_++ "\n")--unwords : List String → String-unwords [] = ""-unwords (w ∷ []) = w-unwords (w ∷ ws) = w ++ ' ' ∷ unwords ws
− lib/Haskell/Prim/Thunk.agda 
@@ -1,15 +0,0 @@-{-# OPTIONS --sized-types #-}--module Haskell.Prim.Thunk where--open import Agda.Builtin.Size public--open import Haskell.Prim--record Thunk {ℓ} (a : @0 Size → Set ℓ) (@0 i : Size) : Set ℓ where-  constructor delay-  coinductive-  field force : {@0 j : Size< i} → a j-open Thunk public--{-# COMPILE AGDA2HS Thunk unboxed #-}
− lib/Haskell/Prim/Traversable.agda 
@@ -1,78 +0,0 @@---module Haskell.Prim.Traversable where--open import Haskell.Prim-open import Haskell.Prim.Applicative-open import Haskell.Prim.Functor-open import Haskell.Prim.Foldable-open import Haskell.Prim.Monad-open import Haskell.Prim.List-open import Haskell.Prim.Maybe-open import Haskell.Prim.Either-open import Haskell.Prim.Tuple------------------------------------------------------- Traversable---- ** base-record Traversable (t : Set → Set) : Set₁ where-  field-    traverse : ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b)-    overlap ⦃ functor ⦄ : Functor t-    overlap ⦃ foldable ⦄ : Foldable t--    sequenceA : ⦃ Applicative f ⦄ → t (f a) → f (t a)-    mapM : ⦃ Monad m ⦄ → (a → m b) → t a → m (t b)-    sequence : ⦃ Monad m ⦄ → t (m a) → m (t a)--- ** defaults-record DefaultTraversable (t : Set → Set) : Set₁ where-  field-    traverse : ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b)-    overlap ⦃ functor ⦄ : Functor t-    overlap ⦃ foldable ⦄ : Foldable t--  sequenceA : ⦃ Applicative f ⦄ → t (f a) → f (t a)-  sequenceA = traverse id--  mapM : ⦃ Monad m ⦄ → (a → m b) → t a → m (t b)-  mapM = traverse--  sequence : ⦃ Monad m ⦄ → t (m a) → m (t a)-  sequence = sequenceA--- ** export-open Traversable ⦃...⦄ public-{-# COMPILE AGDA2HS Traversable existing-class #-}--- ** instances-private-  mkTraversable : DefaultTraversable t → Traversable t-  mkTraversable x = record {DefaultTraversable x}--  infix 0 traverse=_-  traverse=_ : ⦃ Functor t ⦄ → ⦃ Foldable t ⦄-            → (∀ {f a b} → ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b))-            → Traversable t-  traverse= x = record {DefaultTraversable (record {traverse = x})}-instance-  open DefaultTraversable--  iTraversableList : Traversable List-  iTraversableList = traverse= traverseList-    where-      traverseList : ⦃ Applicative f ⦄ → (a → f b) → List a → f (List b)-      traverseList f []       = pure []-      traverseList f (x ∷ xs) = ⦇ f x ∷ traverseList f xs ⦈--  iTraversableMaybe : Traversable Maybe-  iTraversableMaybe = traverse= λ where-    f Nothing  → pure Nothing-    f (Just x) → Just <$> f x--  iTraversableEither : Traversable (Either a)-  iTraversableEither = traverse= λ where-    f (Left  x) → pure (Left x)-    f (Right y) → Right <$> f y--  iTraversablePair : Traversable (a ×_)-  iTraversablePair = traverse= λ-    f (x , y) → (x ,_) <$> f y
− lib/Haskell/Prim/Tuple.agda 
@@ -1,45 +0,0 @@--module Haskell.Prim.Tuple where--open import Haskell.Prim------------------------------------------------------- Tuples--infix 3 _×_ _×_×_--infix -1 _,_ _,_,_--record _×_ (a b : Set) : Set where-  constructor _,_-  field-    fst : a-    snd : b-open _×_ public--{-# COMPILE AGDA2HS _×_ tuple #-}--record _×_×_ (a b c : Set) : Set where-  no-eta-equality; pattern-  constructor _,_,_-  field-    fst3 : a-    snd3 : b-    thd3 : c--{-# COMPILE AGDA2HS _×_×_ tuple #-}--uncurry : (a → b → c) → a × b → c-uncurry f (x , y) = f x y--curry : (a × b → c) → a → b → c-curry f x y = f (x , y)--first : (a → b) → a × c → b × c-first f (x , y) = f x , y--second : (a → b) → c × a → c × b-second f (x , y) = x , f y--_***_ : (a → b) → (c → d) → a × c → b × d-(f *** g) (x , y) = f x , g y
− lib/Haskell/Prim/Word.agda 
@@ -1,54 +0,0 @@--module Haskell.Prim.Word where--open import Haskell.Prim-open import Haskell.Prim.Integer--import Agda.Builtin.Word renaming (Word64 to Word)-open Agda.Builtin.Word public using (Word)-------------------------------------------------------- Literals--module WordInternal where-  2⁶⁴ : Nat-  2⁶⁴ = 18446744073709551616-open WordInternal--instance-  iNumberWord : Number Word-  iNumberWord .Number.Constraint n = IsTrue (ltNat n 2⁶⁴)-  iNumberWord .fromNat n = n2w n-------------------------------------------------------- Arithmetic--negateWord : Word → Word-negateWord a = n2w (monusNat 2⁶⁴ (w2n a))--addWord : Word → Word → Word-addWord a b = n2w (addNat (w2n a) (w2n b))--subWord : Word → Word → Word-subWord a b = addWord a (negateWord b)--mulWord : Word → Word → Word-mulWord a b = n2w (mulNat (w2n a) (w2n b))--eqWord : Word → Word → Bool-eqWord a b = eqNat (w2n a) (w2n b)--ltWord : Word → Word → Bool-ltWord a b = ltNat (w2n a) (w2n b)--showWord : Word → List Char-showWord a = primStringToList (primShowNat (w2n a))--integerToWord : Integer → Word-integerToWord (pos n)    = n2w n-integerToWord (negsuc n) = negateWord (n2w (suc n))--wordToInteger : Word → Integer-wordToInteger n = pos (w2n n)
+ lib/base/Haskell/Control/Exception.agda view
@@ -0,0 +1,11 @@+module Haskell.Control.Exception where++open import Haskell.Prim++open import Haskell.Extra.Dec+open import Haskell.Extra.Refinement++assert : (@0 b : Type ℓ) → {{Dec b}} → (@0 {{b}} → a) → a+assert _ {{True  ⟨ p ⟩}} x = x {{p}}+assert _ {{False ⟨ _ ⟩}} x = oops+  where postulate oops : _
+ lib/base/Haskell/Control/Monad.agda view
@@ -0,0 +1,11 @@+module Haskell.Control.Monad where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.Monad+open import Haskell.Prim.String+open import Haskell.Extra.Erase++guard : {{ MonadFail m }} → (b : Bool) → m (Erase (b ≡ True))+guard True = return (Erased refl)+guard False = fail "Guard was not True"
+ lib/base/Haskell/Data/List.agda view
@@ -0,0 +1,90 @@+module Haskell.Data.List where++open import Haskell.Prelude++open import Haskell.Data.Ord using (comparing)++open import Haskell.Law.Eq+open import Haskell.Law.Equality++{-----------------------------------------------------------------------------+    Operations+------------------------------------------------------------------------------}++partition : (a → Bool) → List a → (List a × List a)+partition p xs = (filter p xs , filter (not ∘ p) xs)++-- | Delete all occurrences of an item.+-- Not part of 'Data.List'.+deleteAll : ⦃ _ : Eq a ⦄ → @0 ⦃ IsLawfulEq a ⦄ → a → List a → List a+deleteAll x = filter (not ∘ (x ==_))++-- | These semantics of 'nub' assume that the 'Eq' instance+-- is lawful.+-- These semantics are inefficient, but good for proofs.+nub : ⦃ _ : Eq a ⦄ → @0 ⦃ IsLawfulEq a ⦄ → List a → List a+nub [] = []+nub (x ∷ xs) = x ∷ deleteAll x (nub xs)++postulate+  sortBy : (a → a → Ordering) → List a → List a++sort : ⦃ Ord a ⦄ → List a → List a+sort = sortBy compare++sortOn : ⦃ Ord b ⦄ → (a → b) → List a → List a+sortOn f =+    map snd+    ∘ sortBy (comparing fst)+    ∘ map (λ x → let y = f x in seq y (y , x))++{-----------------------------------------------------------------------------+    Properties+------------------------------------------------------------------------------}++-- | A deleted item is no longer an element.+--+prop-elem-deleteAll+  : ∀ ⦃ _ : Eq a ⦄ ⦃ _ : IsLawfulEq a ⦄+      (x y : a) (zs : List a)+  → elem x (deleteAll y zs)+    ≡ (if x == y then False else elem x zs)+--+prop-elem-deleteAll x y []+  with x == y+... | False = refl+... | True  = refl+prop-elem-deleteAll x y (z ∷ zs)+  with recurse ← prop-elem-deleteAll x y zs+  with y == z in eqyz+... | True+    with x == z in eqxz+...   | True+      rewrite equality' _ _ (trans (equality x z eqxz) (sym (equality y z eqyz)))+      = recurse+...   | False+      = recurse+prop-elem-deleteAll x y (z ∷ zs)+    | False+    with x == z in eqxz+...   | True+      rewrite equality x z eqxz | eqSymmetry y z | eqyz+      = refl+...   | False+      = recurse++-- | An item is an element of the 'nub' iff it is+-- an element of the original list.+--+prop-elem-nub+  : ∀ ⦃ _ : Eq a ⦄ ⦃ _ : IsLawfulEq a ⦄+      (x : a) (ys : List a)+  → elem x (nub ys)+    ≡ elem x ys+--+prop-elem-nub x [] = refl+prop-elem-nub x (y ∷ ys)+  rewrite prop-elem-deleteAll x y (nub ys)+  with x == y+... | True = refl+... | False = prop-elem-nub x ys
+ lib/base/Haskell/Data/Maybe.agda view
@@ -0,0 +1,34 @@+module Haskell.Data.Maybe where++open import Haskell.Prelude++isJust : Maybe a → Bool+isJust Nothing  = False+isJust (Just _) = True++isNothing : Maybe a → Bool+isNothing Nothing  = True+isNothing (Just _) = False++fromJust : (x : Maybe a) → @0 {IsJust x} → a+fromJust Nothing  = error "fromJust Nothing"+fromJust (Just x) = x++fromMaybe : {a : Type} → a → Maybe a → a+fromMaybe d Nothing = d+fromMaybe _ (Just x) = x++listToMaybe : List a → Maybe a+listToMaybe [] = Nothing+listToMaybe (x ∷ _) = Just x++maybeToList : Maybe a → List a+maybeToList Nothing = []+maybeToList (Just x) = x ∷ []++mapMaybe : (a → Maybe b) → List a → List b+mapMaybe f [] = []+mapMaybe f (x ∷ xs) = maybe id _∷_ (f x) (mapMaybe f xs)++catMaybes : List (Maybe a) → List a+catMaybes = mapMaybe id
+ lib/base/Haskell/Data/Ord.agda view
@@ -0,0 +1,9 @@+module Haskell.Data.Ord where++open import Haskell.Prelude++comparing : ⦃ Ord a ⦄ → (b → a) → b → b → Ordering+comparing p x y = compare (p x) (p y)++clamp : ⦃ Ord a ⦄ → (a × a) → a → a+clamp (low , high) a = min high (max a low)
+ lib/base/Haskell/Extra/Dec.agda view
@@ -0,0 +1,65 @@+module Haskell.Extra.Dec where++open import Haskell.Prelude+open import Haskell.Extra.Refinement+open import Agda.Primitive++private variable+  ℓ : Level+  P : Type++@0 Reflects : Type ℓ → Bool → Type ℓ+Reflects P True  = P+Reflects P False = P → ⊥++of : {b : Bool} → if b then P else (P → ⊥) → Reflects P b+of {b = False} np = np+of {b = True}  p  = p++invert : ∀ {b} → Reflects P b → if b then P else (P → ⊥)+invert {b = False} np = np+invert {b = True}  p  = p++extractTrue : ∀ { b } → ⦃ true : b ≡ True ⦄ → Reflects P b → P+extractTrue {b = True} p = p++extractFalse : ∀ { b } → ⦃ true : b ≡ False ⦄ → Reflects P b → (P → ⊥)+extractFalse {b = False} np = np++mapReflects : ∀ {cond} → (a → b) → (b → a)+            → Reflects a cond → Reflects b cond+mapReflects {cond = False} f g x = x ∘ g+mapReflects {cond = True}  f g x = f x++Dec : ∀ {ℓ} → @0 Type ℓ → Type ℓ+Dec P = ∃ Bool (Reflects P)+{-# COMPILE AGDA2HS Dec inline #-}++mapDec : {@0 a b : Type}+       → @0 (a → b)+       → @0 (b → a)+       → Dec a → Dec b+mapDec f g (True  ⟨ x ⟩) = True  ⟨ f x   ⟩+mapDec f g (False ⟨ h ⟩) = False ⟨ h ∘ g ⟩+{-# COMPILE AGDA2HS mapDec transparent #-}++ifDec : Dec a → (@0 {{a}} → b) → (@0 {{a → ⊥}} → b) → b+ifDec (b ⟨ p ⟩) x y = if b then (λ where {{refl}} → x {{p}}) else (λ where {{refl}} → y {{p}})+{-# COMPILE AGDA2HS ifDec inline #-}++instance+  iDecIsTrue : {b : Bool} → Dec (IsTrue b)+  iDecIsTrue {False} = False ⟨ (λ ()) ⟩+  iDecIsTrue {True}  = True  ⟨ IsTrue.itsTrue ⟩+  {-# COMPILE AGDA2HS iDecIsTrue transparent #-}++  iDecIsFalse : {b : Bool} → Dec (IsFalse b)+  iDecIsFalse {b} = mapDec isTrueNotIsFalse isFalseIsTrueNot (iDecIsTrue {not b})+    where+      @0 isTrueNotIsFalse : {b : Bool} → IsTrue (not b) → IsFalse b+      isTrueNotIsFalse {False} IsTrue.itsTrue = IsFalse.itsFalse++      @0 isFalseIsTrueNot : {b : Bool} → IsFalse b → IsTrue (not b)+      isFalseIsTrueNot {False} IsFalse.itsFalse = IsTrue.itsTrue+  {-# COMPILE AGDA2HS iDecIsFalse inline #-}+
+ lib/base/Haskell/Extra/Delay.agda view
@@ -0,0 +1,41 @@+{-# OPTIONS --sized-types #-}++module Haskell.Extra.Delay where++open import Agda.Builtin.Size public++open import Haskell.Prelude++open import Haskell.Data.Maybe+open import Haskell.Extra.Refinement+open import Haskell.Prim.Thunk++private variable+  x y z : a+  @0 i : Size++data Delay (a : Type) (@0 i : Size) : Type where+  now : a → Delay a i+  later : Thunk (Delay a) i → Delay a i++data HasResult (x : a) : Delay a i → Type where+  now   : HasResult x (now x)+  later : HasResult x (y .force) → HasResult x (later y)++runDelay : {@0 x : a} (y : Delay a ∞) → @0 HasResult x y → a+runDelay (now x) now = x+runDelay (later y) (later p) = runDelay (y .force) p++runDelaySound : {@0 x : a} (y : Delay a ∞) → (@0 hr : HasResult x y) → runDelay y hr ≡ x+runDelaySound (now x) now = refl+runDelaySound (later y) (later hr) = runDelaySound (y .force) hr++-- tryDelay and unDelay cannot and should not be compiled to Haskell,+-- so they are marked as erased.+@0 tryDelay : (y : Delay a ∞) → Nat → Maybe (∃ a (λ x → HasResult x y))+tryDelay (now x)   _       = Just (x ⟨ now ⟩)+tryDelay (later y) zero    = Nothing+tryDelay (later y) (suc n) = fmap (mapRefine later) (tryDelay (y .force) n)++@0 unDelay : (y : Delay a ∞) (n : Nat) → @0 {IsJust (tryDelay y n)} → a+unDelay y n {p} = fromJust (tryDelay y n) {p} .value
+ lib/base/Haskell/Extra/Erase.agda view
@@ -0,0 +1,82 @@+module Haskell.Extra.Erase where++  open import Agda.Primitive+  open import Agda.Builtin.Sigma+  open import Agda.Builtin.Equality++  open import Haskell.Prim+  open import Haskell.Prim.List+  open import Haskell.Extra.Refinement+  open import Haskell.Law.Equality++  private variable+    @0 x y : a+    @0 xs  : List a++  record Erase (@0 a : Type ℓ) : Type ℓ where+    instance constructor iErased+    field @0 {{get}} : a+  open Erase public+  {-# COMPILE AGDA2HS Erase tuple #-}++  pattern Erased x = iErased {{x}}++  infixr 4 ⟨_⟩_+  record Σ0 (@0 a : Type) (b : @0 a → Type) : Type where+    constructor ⟨_⟩_+    field+      @0 proj₁ : a+      proj₂ : b proj₁+  open Σ0 public+  {-# COMPILE AGDA2HS Σ0 unboxed #-}++  pattern <_> x = record { proj₁ = _ ; proj₂ = x }++  -- Resurrection of erased values+  Singleton : (@0 x : a) → Type+  Singleton x = ∃ _ (x ≡_)++  {-# COMPILE AGDA2HS Singleton inline #-}++  pattern sing x = x ⟨ refl ⟩++  instance+    sing-id : {x : a} → Singleton x+    sing-id = sing _+  {-# COMPILE AGDA2HS sing-id inline #-}++  singCong : {@0 a : Type} {@0 x : a} (f : a → b) → Singleton x → Singleton (f x)+  singCong f (x ⟨ p ⟩) = f x ⟨ cong f p ⟩+  {-# COMPILE AGDA2HS singCong inline #-}++  singCong2 : (f : a → b → c) → Singleton x → Singleton y → Singleton (f x y)+  singCong2 f (x ⟨ p ⟩) (y ⟨ q ⟩) = f x y ⟨ cong₂ f p q ⟩+  {-# COMPILE AGDA2HS singCong2 inline #-}++  singHead : Singleton (x ∷ xs) → Singleton x+  singHead {x = x} (ys ⟨ p ⟩) =+    head ys+    ⟨ subst (λ ys → ⦃ @0 _ : NonEmpty ys ⦄ → x ≡ head ys)+            p refl ⟩+    where instance @0 ne : NonEmpty ys+                   ne = subst NonEmpty p itsNonEmpty+  {-# COMPILE AGDA2HS singHead inline #-}++  singTail : Singleton (x ∷ xs) → Singleton xs+  singTail {xs = xs} (ys ⟨ p ⟩) =+    tail ys+    ⟨ subst (λ ys → ⦃ @0 _ : NonEmpty ys ⦄ → xs ≡ tail ys)+            p refl ⟩+    where instance @0 ne : NonEmpty ys+                   ne = subst NonEmpty p itsNonEmpty+  {-# COMPILE AGDA2HS singTail inline #-}++  singErase : {@0 a : Type} {@0 x : a} → Singleton (Erased x)+  singErase {x = x} = Erased x ⟨ refl ⟩+  {-# COMPILE AGDA2HS singErase inline #-}++  erase-injective : Erased x ≡ Erased y → x ≡ y+  erase-injective refl = refl++  inspect_by_ : (x : a) → (Singleton x → b) → b+  inspect x by f = f (sing x)
+ lib/base/Haskell/Extra/Refinement.agda view
@@ -0,0 +1,28 @@+module Haskell.Extra.Refinement where++open import Haskell.Prelude+open import Agda.Primitive++private variable+  ℓ ℓ′ : Level++record ∃ (a : Type ℓ) (@0 P : a → Type ℓ′) : Type (ℓ ⊔ ℓ′) where+  constructor _⟨_⟩+  field+    value    : a+    @0 proof : P value+open ∃ public+{-# COMPILE AGDA2HS ∃ unboxed #-}++mapRefine : {@0 P Q : a → Type ℓ} (@0 f : ∀ {x} → P x → Q x) → ∃ a P → ∃ a Q+mapRefine f (x ⟨ p ⟩) = x ⟨ f p ⟩++{-# COMPILE AGDA2HS mapRefine transparent #-}++refineMaybe : {@0 P : a → Type ℓ} +            → (mx : Maybe a) → @0 (∀ {x} → mx ≡ Just x → P x)+            → Maybe (∃ a P)+refineMaybe Nothing f = Nothing+refineMaybe (Just x) f = Just (x ⟨ f refl ⟩)++{-# COMPILE AGDA2HS refineMaybe transparent #-}
+ lib/base/Haskell/Extra/Sigma.agda view
@@ -0,0 +1,19 @@+module Haskell.Extra.Sigma where++open import Haskell.Prelude++record Σ (a : Type) (b : @0 a → Type) : Type where+  constructor _,_+  field+    fst : a+    snd : b fst+open Σ public+{-# COMPILE AGDA2HS Σ tuple #-}++infix 2 Σ-syntax++Σ-syntax : (a : Type) → (@0 a → Type) → Type+Σ-syntax = Σ+{-# COMPILE AGDA2HS Σ-syntax inline #-}++syntax Σ-syntax a (λ x → b) = Σ[ x ∈ a ] b
+ lib/base/Haskell/Law.agda view
@@ -0,0 +1,20 @@+module Haskell.Law where++open import Haskell.Prim+open import Haskell.Prim.Bool++open import Haskell.Law.Def          public+open import Haskell.Law.Applicative  public+open import Haskell.Law.Bool         public+open import Haskell.Law.Either       public+open import Haskell.Law.Eq           public+open import Haskell.Law.Equality     public+open import Haskell.Law.Functor      public+open import Haskell.Law.Int          public+open import Haskell.Law.Integer      public+open import Haskell.Law.List         public+open import Haskell.Law.Maybe        public+open import Haskell.Law.Monad        public+open import Haskell.Law.Monoid       public+open import Haskell.Law.Nat          public+open import Haskell.Law.Ord          public
+ lib/base/Haskell/Law/Applicative.agda view
@@ -0,0 +1,7 @@+module Haskell.Law.Applicative where++open import Haskell.Law.Applicative.Def    public+open import Haskell.Law.Applicative.Either public+open import Haskell.Law.Applicative.IO     public+open import Haskell.Law.Applicative.List   public+open import Haskell.Law.Applicative.Maybe  public
+ lib/base/Haskell/Law/Applicative/Def.agda view
@@ -0,0 +1,41 @@+module Haskell.Law.Applicative.Def where++open import Haskell.Prim+open import Haskell.Prim.Functor++open import Haskell.Prim.Applicative+open import Haskell.Prim.Monoid+open import Haskell.Prim.Tuple++open import Haskell.Law.Functor++record IsLawfulApplicative (F : Type → Type) ⦃ iAppF : Applicative F ⦄ : Type₁ where+  field+    overlap ⦃ super ⦄ : IsLawfulFunctor F++    -- Identity: pure id <*> v = v+    identity : (v : F a) → (pure id <*> v) ≡ v++    -- Composition: pure (.) <*> u <*> v <*> w = u <*> (v <*> w)+    composition : {a b c : Type} → (u : F (b → c)) (v : F (a → b)) (w : F a)+      → (pure _∘_ <*> u <*> v <*> w) ≡ (u <*> (v <*> w))++    -- Homomorphism: pure f <*> pure x = pure (f x)+    homomorphism : {a b : Type} → (f : a → b) (x : a)+      → (Applicative._<*>_ iAppF (pure f) (pure x)) ≡ (pure (f x))++    -- Interchange: u <*> pure y = pure ($ y) <*> u+    interchange : {a b : Type} → (u : F (a → b)) (y : a)+      → (u <*> (pure y)) ≡ (pure (_$ y) <*> u)++    -- fmap f x = pure f <*> x+    functor : (f : a → b) (x : F a) → (fmap f x) ≡ ((pure f) <*> x)++open IsLawfulApplicative ⦃ ... ⦄ public++instance postulate+  iLawfulApplicativeFun : IsLawfulApplicative (λ b → a → b)++  iLawfulApplicativeTuple₂ : ⦃ Monoid a ⦄ → Applicative (a ×_)++  iLawfulApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Applicative (a × b ×_)
+ lib/base/Haskell/Law/Applicative/Either.agda view
@@ -0,0 +1,29 @@+module Haskell.Law.Applicative.Either where++open import Haskell.Prim+open import Haskell.Prim.Either++open import Haskell.Prim.Applicative++open import Haskell.Law.Applicative.Def++open import Haskell.Law.Functor.Either++instance+  iLawfulApplicativeEither : IsLawfulApplicative (Either a)+  -- (λ { true → true ; false → false })++  iLawfulApplicativeEither .identity = λ { (Left _) → refl; (Right _) → refl }++  iLawfulApplicativeEither .composition =+    λ { (Left _)  _         _         → refl+      ; (Right _) (Left _)  _         → refl+      ; (Right _) (Right _) (Left _)  → refl+      ; (Right _) (Right _) (Right _) → refl+      }++  iLawfulApplicativeEither .homomorphism _ _ = refl++  iLawfulApplicativeEither .interchange = λ { (Left _) _ → refl; (Right _) _ → refl }++  iLawfulApplicativeEither .functor = λ { _ (Left _) → refl; _ (Right _) → refl }
+ lib/base/Haskell/Law/Applicative/FromMonad.agda view
@@ -0,0 +1,129 @@+module Haskell.Law.Applicative.FromMonad where++open import Haskell.Prim++open import Haskell.Prim.Applicative+open import Haskell.Prim.Functor+open import Haskell.Prim.Monad++open import Haskell.Law.Applicative.Def+open import Haskell.Law.Monad.Def as Monad+open import Haskell.Law.Equality+open import Haskell.Law.Functor+open import Haskell.Law.Functor.FromMonad++-------------------------------------------------------------------------------+-- Prove the Applicative laws from the Monad laws++--+prop-PreLawfulMonad→IsLawfulApplicative+  : ∀ ⦃ _ : Monad m ⦄ ⦃ _ : PreLawfulMonad m ⦄+  → IsLawfulApplicative m+--+prop-PreLawfulMonad→IsLawfulApplicative {m} = record+    { super = prop-PreLawfulMonad→IsLawfulFunctor+    ; identity = midentity+    ; composition = mcomposition+    ; homomorphism = mhomomorphism+    ; interchange = minterchange+    ; functor = mfunctor+    }+  where+    midentity : ∀ {a} (ma : m a) → (pure id <*> ma) ≡ ma+    midentity {a} ma+      rewrite def-pure-return (id {a})+      | def-<*>->>= (return id) ma+      = begin+        return id >>= (λ f → ma >>= (λ x → return (f x)))+      ≡⟨ Monad.leftIdentity _ _ ⟩+        ma >>= (λ x → return (id x))+      ≡⟨ Monad.rightIdentity _ ⟩+        ma+      ∎++    mfunctor : ∀ {a b} (f : a → b) (u : m a) → fmap f u ≡ (pure f <*> u)+    mfunctor f u = begin+        fmap f u+      ≡⟨ Monad.def-fmap->>= _ _ ⟩+        (do x ← u; return (f x))+      ≡⟨ sym (Monad.leftIdentity _ _) ⟩+        (do f' ← return f; x ← u; return (f' x))+      ≡⟨ cong (λ o → o >>= _) (sym (def-pure-return _)) ⟩+        (do f' ← pure f; x ← u; return (f' x))+      ≡⟨ sym (def-<*>->>= _ _) ⟩+        pure f <*> u+      ∎++    mcomposition+      : ∀ {a b c} (u : m (b → c)) (v : m (a → b)) (w : m a)+      → (pure _∘_ <*> u <*> v <*> w) ≡ (u <*> (v <*> w))+    mcomposition u v w+      = begin+        pure _∘_ <*> u <*> v <*> w+      ≡⟨ cong (λ o → o <*> u <*> v <*> w) (def-pure-return _∘_) ⟩+        return _∘_ <*> u <*> v <*> w+      ≡⟨ cong (λ o → o <*> v <*> w) (def-<*>->>= _ _ ) ⟩+        (do comp ← return _∘_; g ← u; return (comp g)) <*> v <*> w+      ≡⟨ cong (λ o → o <*> v <*> w) (Monad.leftIdentity _ _) ⟩+        (do g ← u; return (_∘_ g)) <*> v <*> w+      ≡⟨ cong (λ o → o <*> w) (def-<*>->>= _ _ ) ⟩+        (do g' ← (do g ← u; return (_∘_ g)); f ← v; return (g' f)) <*> w+      ≡⟨ cong (λ o → o <*> w) (sym (Monad.associativity u _ _)) ⟩+        (do g ← u; g' ← return (_∘_ g); f ← v; return (g' f)) <*> w+      ≡⟨ cong (λ o → o <*> w) (cong-monad u (λ g → Monad.leftIdentity _ _)) ⟩+        (do g ← u; f ← v; return (g ∘ f)) <*> w+      ≡⟨ def-<*>->>= _ _ ⟩+        (do gf ← (do g ← u; f ← v; return (g ∘ f)); x ← w; return (gf x))+      ≡⟨ sym (Monad.associativity u _ _) ⟩+        (do g ← u; gf ← (do f ← v; return (g ∘ f)); x ← w; return (gf x))+      ≡⟨ cong-monad u (λ g → sym (Monad.associativity v _ _)) ⟩+        (do g ← u; do f ← v; gf ← return (g ∘ f); x ← w; return (gf x))+      ≡⟨ cong-monad u (λ g → cong-monad v (λ f → Monad.leftIdentity _ _)) ⟩+        (do g ← u; f ← v; x ← w; return (g (f x)))+      ≡⟨ cong-monad u (λ g → cong-monad v λ f → cong-monad w (λ x → sym (Monad.leftIdentity _ _))) ⟩+        (do g ← u; f ← v; x ← w; y ← return (f x); return (g y))+      ≡⟨ cong-monad u (λ g → cong-monad v λ x → Monad.associativity _ _ _) ⟩+        (do g ← u; f ← v; y ← (do x ← w; return (f x)); return (g y))+      ≡⟨ cong-monad u (λ g → Monad.associativity _ _ _) ⟩+        (do g ← u; y ← (do f ← v; x ← w; return (f x)); return (g y))+      ≡⟨ sym (def-<*>->>= _ _) ⟩+        u <*> (do f ← v; x ← w; return (f x))+      ≡⟨ cong (λ o → u <*> o) (sym (def-<*>->>= _ _)) ⟩+        u <*> (v <*> w)+      ∎++    mhomomorphism+      : ∀ {a b} (f : a → b) (x : a)+      → (pure {m} f <*> pure x) ≡ pure (f x)+    mhomomorphism f x = begin+        pure {m} f <*> pure x+      ≡⟨ cong₂ (_<*>_) (def-pure-return f) (def-pure-return x) ⟩+        return {m} f <*> return x+      ≡⟨ def-<*>->>= _ _ ⟩+        (do f' ← return f; x' ← return x; return (f' x'))+      ≡⟨ Monad.leftIdentity _ _ ⟩+        (do x' ← return x; return (f x'))+      ≡⟨ Monad.leftIdentity _ _ ⟩+        return (f x)+      ≡⟨ sym (def-pure-return _) ⟩+        pure (f x)+      ∎++    minterchange+      : ∀ {a b} (u : m (a → b)) (y : a)+      → (u <*> pure y) ≡ (pure (_$ y) <*> u)+    minterchange u y = begin+        u <*> pure y+      ≡⟨ cong (u <*>_) (def-pure-return _) ⟩+        u <*> return y+      ≡⟨ def-<*>->>= _ _ ⟩+        (do f ← u; y' ← return y; return (f y'))+      ≡⟨ cong-monad u (λ f → Monad.leftIdentity y _) ⟩+        (do f ← u; return (f y))+      ≡⟨ sym (Monad.leftIdentity _ _) ⟩+        (do y'' ← return (_$ y); f ← u; return (y'' f))+      ≡⟨ sym (def-<*>->>= _ _) ⟩+        return (_$ y) <*> u+      ≡⟨ sym (cong (_<*> u) (def-pure-return _)) ⟩+        pure (_$ y) <*> u+      ∎
+ lib/base/Haskell/Law/Applicative/IO.agda view
@@ -0,0 +1,12 @@+module Haskell.Law.Applicative.IO where++open import Haskell.Prim+open import Haskell.Prim.IO++open import Haskell.Prim.Applicative++open import Haskell.Law.Applicative.Def++open import Haskell.Law.Functor.IO++instance postulate iLawfulApplicativeIO : IsLawfulApplicative IO
+ lib/base/Haskell/Law/Applicative/List.agda view
@@ -0,0 +1,54 @@+module Haskell.Law.Applicative.List where++open import Haskell.Prim+open import Haskell.Prim.List++open import Haskell.Prim.Applicative+open import Haskell.Prim.Functor++open import Haskell.Law.Applicative.Def++open import Haskell.Law.Equality+open import Haskell.Law.Functor.List+open import Haskell.Law.List++private+  identityList : {a : Type} → (v : List a) → (pure id <*> v) ≡ v+  identityList [] = refl+  identityList (x ∷ xs)+    rewrite identityList xs+    = refl++  compositionList : {a b c : Type} → (u : List (b → c)) (v : List (a → b)) (w : List a)+    → ((((pure _∘_) <*> u) <*> v) <*> w) ≡ (u <*> (v <*> w))+  compositionList [] _  _  = refl+  compositionList (u ∷ us) v w+    rewrite sym $ concatMap-++-distr (map (u ∘_) v) (((pure _∘_) <*> us) <*> v) (λ f → map f w)+      | sym $ map-<*>-recomp v w u+      | compositionList us v w+    = refl ++  interchangeList : {a b : Type} → (u : List (a → b)) → (y : a)+    → (u <*> (pure y)) ≡ (pure (_$ y) <*> u)+  interchangeList [] _ = refl+  interchangeList (x ∷ xs) y+      rewrite interchangeList xs y+      = refl++  functorList : {a b : Type} → (f : a → b) → (x : List a)+    → (fmap f x) ≡ ((pure f) <*> x)+  functorList _ [] = refl+  functorList f (x ∷ xs)+      rewrite functorList f xs+        | ++-[] (map f xs)+        | ++-[] (f x ∷ map f xs)+      = refl++instance+  iLawfulApplicativeList : IsLawfulApplicative List+  iLawfulApplicativeList = λ where+    .identity → identityList+    .composition → compositionList+    .homomorphism _ x → refl+    .interchange → interchangeList+    .functor → functorList
+ lib/base/Haskell/Law/Applicative/Maybe.agda view
@@ -0,0 +1,27 @@+module Haskell.Law.Applicative.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Maybe++open import Haskell.Prim.Applicative++open import Haskell.Law.Applicative.Def++open import Haskell.Law.Functor.Maybe++instance+  iLawfulApplicativeMaybe : IsLawfulApplicative Maybe+  iLawfulApplicativeMaybe .identity = λ { Nothing → refl; (Just _) → refl }++  iLawfulApplicativeMaybe .composition =+    λ { Nothing  _        _        → refl+      ; (Just _) Nothing  _        → refl+      ; (Just _) (Just _) Nothing  → refl+      ; (Just _) (Just _) (Just _) → refl+      }++  iLawfulApplicativeMaybe .homomorphism _ _ = refl++  iLawfulApplicativeMaybe .interchange = λ { Nothing _ → refl; (Just _) _ → refl }++  iLawfulApplicativeMaybe .functor = λ { _ Nothing → refl; _ (Just _) → refl }
+ lib/base/Haskell/Law/Bool.agda view
@@ -0,0 +1,264 @@+module Haskell.Law.Bool where++open import Haskell.Prim+open import Haskell.Prim.Bool++open import Haskell.Law.Equality++{-----------------------------------------------------------------------------+    Properties+    Logical operations and constants+------------------------------------------------------------------------------}+--+prop-x-&&-True+  : ∀ (x : Bool)+  → (x && True) ≡ x+--+prop-x-&&-True True = refl+prop-x-&&-True False = refl++--+prop-x-&&-False+  : ∀ (x : Bool)+  → (x && False) ≡ False+--+prop-x-&&-False True = refl+prop-x-&&-False False = refl++--+prop-x-||-True+  : ∀ (x : Bool)+  → (x || True) ≡ True+--+prop-x-||-True True = refl+prop-x-||-True False = refl++--+prop-x-||-False+  : ∀ (x : Bool)+  → (x || False) ≡ x+--+prop-x-||-False True = refl+prop-x-||-False False = refl++{-----------------------------------------------------------------------------+    Properties+    Boolean algebra+    https://en.wikipedia.org/wiki/Boolean_algebra_(structure)+------------------------------------------------------------------------------}+--+prop-||-idem+  : ∀ (a : Bool)+  → (a || a) ≡ a+--+prop-||-idem False = refl+prop-||-idem True = refl++--+prop-||-assoc+  : ∀ (a b c : Bool)+  → ((a || b) || c) ≡ (a || (b || c))+--+prop-||-assoc False b c = refl+prop-||-assoc True b c = refl++--+prop-||-sym+  : ∀ (a b : Bool)+  → (a || b) ≡ (b || a)+--+prop-||-sym False False = refl+prop-||-sym False True = refl+prop-||-sym True False = refl+prop-||-sym True True = refl++--+prop-||-absorb+  : ∀ (a b : Bool)+  → (a || (a && b)) ≡ a+--+prop-||-absorb False b = refl+prop-||-absorb True b = refl++--+prop-||-identity+  : ∀ (a : Bool)+  → (a || False) ≡ a+--+prop-||-identity False = refl+prop-||-identity True = refl++--+prop-||-&&-distribute+  : ∀ (a b c : Bool)+  → (a || (b && c)) ≡ ((a || b) && (a || c))+--+prop-||-&&-distribute False b c = refl+prop-||-&&-distribute True b c = refl++--+prop-||-complement+  : ∀ (a : Bool)+  → (a || not a) ≡ True+--+prop-||-complement False = refl+prop-||-complement True = refl++--+prop-&&-idem+  : ∀ (a : Bool)+  → (a && a) ≡ a+--+prop-&&-idem False = refl+prop-&&-idem True = refl++--+prop-&&-assoc+  : ∀ (a b c : Bool)+  → ((a && b) && c) ≡ (a && (b && c))+--+prop-&&-assoc False b c = refl+prop-&&-assoc True b c = refl++--+prop-&&-sym+  : ∀ (a b : Bool)+  → (a && b) ≡ (b && a)+--+prop-&&-sym False False = refl+prop-&&-sym False True = refl+prop-&&-sym True False = refl+prop-&&-sym True True = refl++--+prop-&&-absorb+  : ∀ (a b : Bool)+  → (a && (a || b)) ≡ a+--+prop-&&-absorb False b = refl+prop-&&-absorb True b = refl++--+prop-&&-identity+  : ∀ (a : Bool)+  → (a && True) ≡ a+--+prop-&&-identity False = refl+prop-&&-identity True = refl++--+prop-&&-||-distribute+  : ∀ (a b c : Bool)+  → (a && (b || c)) ≡ ((a && b) || (a && c))+--+prop-&&-||-distribute False b c = refl+prop-&&-||-distribute True b c = refl++--+prop-&&-complement+  : ∀ (a : Bool)+  → (a && not a) ≡ False+--+prop-&&-complement False = refl+prop-&&-complement True = refl++--+prop-deMorgan-not-&&+  : ∀ (a b : Bool)+  → not (a && b) ≡ (not a || not b)+--+prop-deMorgan-not-&& False b = refl+prop-deMorgan-not-&& True b = refl++--+prop-deMorgan-not-||+  : ∀ (a b : Bool)+  → not (a || b) ≡ (not a && not b)+--+prop-deMorgan-not-|| False b = refl+prop-deMorgan-not-|| True b = refl++{-----------------------------------------------------------------------------+    Properties+    Other+------------------------------------------------------------------------------}++--------------------------------------------------+-- &&++&&-sym : ∀ (a b : Bool) → (a && b) ≡ (b && a)+&&-sym False False = refl+&&-sym False True = refl+&&-sym True False = refl+&&-sym True True = refl++&&-semantics : ∀ (a b : Bool) → a ≡ True → b ≡ True → (a && b) ≡ True+&&-semantics True True _ _ = refl++&&-leftAssoc : ∀ (a b c : Bool) → (a && b && c) ≡ True → ((a && b) && c) ≡ True+&&-leftAssoc True True True _ = refl++&&-leftAssoc' : ∀ (a b c : Bool) → (a && b && c) ≡ ((a && b) && c)+&&-leftAssoc' False b c = refl+&&-leftAssoc' True b c = refl++&&-leftTrue : ∀ (a b : Bool) → (a && b) ≡ True → a ≡ True+&&-leftTrue True True _ = refl++&&-leftTrue' : ∀ (a b c : Bool) → a ≡ (b && c) → a ≡ True → c ≡ True+&&-leftTrue' .True True True _ refl = refl++&&-rightTrue : ∀ (a b : Bool) → (a && b) ≡ True → b ≡ True+&&-rightTrue True True _ = refl++&&-rightTrue' : ∀ (a b c : Bool) → a ≡ (b && c) → a ≡ True → b ≡ True+&&-rightTrue' .True True True _ refl = refl++--------------------------------------------------+-- ||++-- if a then True else b++||-excludedMiddle : ∀ (a b : Bool) → (a || not a) ≡ True+||-excludedMiddle False _ = refl+||-excludedMiddle True  _ = refl++||-leftTrue : ∀ (a b : Bool) → a ≡ True → (a || b) ≡ True+||-leftTrue .True b refl = refl++||-rightTrue : ∀ (a b : Bool) → b ≡ True → (a || b) ≡ True+||-rightTrue False .True refl = refl+||-rightTrue True  .True refl = refl++--------------------------------------------------+-- not++not-not : ∀ (a : Bool) → not (not a) ≡ a+not-not False = refl+not-not True = refl++not-involution : ∀ (a b : Bool) → a ≡ not b → not a ≡ b+not-involution .(not b) b refl = not-not b++--------------------------------------------------+-- if_then_else_++ifFlip : ∀ (b)+       → (t : {{not b ≡ True}} → a)+       → (e : {{not b ≡ False}} → a)+       → (if not b then t                             else e) ≡+         (if b     then (e {{not-involution _ _ it}}) else t {{not-involution _ _ it}})+ifFlip False _ _ = refl+ifFlip True  _ _ = refl++ifTrueEqThen : ∀ (b : Bool)+             → {thn : {{b ≡ True}} → a}+             → {els : {{b ≡ False}} → a}+             → (pf : b ≡ True) → (if b then thn else els) ≡ thn {{pf}}+ifTrueEqThen .True refl = refl++ifFalseEqElse : ∀ (b : Bool)+             → {thn : {{b ≡ True}} → a}+             → {els : {{b ≡ False}} → a}+             → (pf : b ≡ False) → (if b then thn else els) ≡ els {{pf}}+ifFalseEqElse .False refl = refl
+ lib/base/Haskell/Law/Def.agda view
@@ -0,0 +1,6 @@+module Haskell.Law.Def where++open import Haskell.Prim++Injective : (a → b) → Type _+Injective f = ∀ {x y} → f x ≡ f y → x ≡ y
+ lib/base/Haskell/Law/Either.agda view
@@ -0,0 +1,12 @@+module Haskell.Law.Either where++open import Haskell.Prim+open import Haskell.Prim.Either++open import Haskell.Law.Def++Left-injective : Injective (Left {a}{b})+Left-injective refl = refl++Right-injective : Injective (Right {a}{b})+Right-injective refl = refl
+ lib/base/Haskell/Law/Eq.agda view
@@ -0,0 +1,4 @@+module Haskell.Law.Eq where++open import Haskell.Law.Eq.Def       public+open import Haskell.Law.Eq.Instances public
+ lib/base/Haskell/Law/Eq/Def.agda view
@@ -0,0 +1,75 @@+module Haskell.Law.Eq.Def where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.Double++open import Haskell.Prim.Eq++open import Haskell.Extra.Dec+open import Haskell.Extra.Refinement++open import Haskell.Law.Bool+open import Haskell.Law.Equality++record IsLawfulEq (e : Type) ⦃ iEq : Eq e ⦄ : Type₁ where+  field+    isEquality : ∀ (x y : e) → Reflects (x ≡ y) (x == y)++  equality : ∀ (x y : e) → (x == y) ≡ True → x ≡ y+  equality x y h = extractTrue ⦃ h ⦄ (isEquality x y)++  nequality : ∀ (x y : e) → (x == y) ≡ False → (x ≡ y → ⊥)+  nequality x y h = extractFalse ⦃ h ⦄ (isEquality x y)++  -- contrapositive of nequality+  equality' : ∀ (x y : e) → x ≡ y → (x == y) ≡ True+  equality' x y h with x == y in eq+  ... | False = magic (nequality x y eq h)+  ... | True = refl++  -- contrapositive of equality+  nequality' : ∀ (x y : e) → (x ≡ y → ⊥) → (x == y) ≡ False+  nequality' x y h with x == y in eq+  ... | True = magic (h (equality x y eq))+  ... | False = refl++open IsLawfulEq ⦃ ... ⦄ public++-- Types with a lawful Eq instance have decidable equality+_≟_ : {{_ : Eq a}} {{_ : IsLawfulEq a}} → (x y : a) → Dec (x ≡ y)+x ≟ y = (x == y) ⟨ isEquality x y ⟩++{-# COMPILE AGDA2HS _≟_ inline #-}++-- Reflexivity: x == x = True+eqReflexivity : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄+              → ∀ (x : e) → (x == x) ≡ True+eqReflexivity x = equality' x x refl++-- Symmetry: x == y = y == x+eqSymmetry : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄+           → ∀ (x y : e) → (x == y) ≡ (y == x)+eqSymmetry x y with x == y in eq+... | True  = sym (equality' y x (sym (equality x y eq)))+... | False = sym (nequality' y x (λ qe → (nequality x y eq) (sym qe)))++-- Transitivity: if x == y && y == z = True, then x == z = True+eqTransitivity : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄+               → ∀ (x y z : e) → ((x == y) && (y == z)) ≡ True → (x == z) ≡ True+eqTransitivity x y z h+  = equality' x z (trans+    (equality x y (&&-leftTrue (x == y) (y == z) h))+    (equality y z (&&-rightTrue (x == y) (y == z) h)))++-- Extensionality: if x == y = True and f is a function whose return type is an instance of Eq, then f x == f y = True+eqExtensionality : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄+                 → ⦃ iEq : Eq a ⦄ → ⦃ iLawfulEq : IsLawfulEq a ⦄+                 → ∀ ( x y : e ) ( f : e → a ) → (x == y) ≡ True → (f x == f y) ≡ True+eqExtensionality x y f h = equality' (f x) (f y) (cong f (equality x y h))++-- Negation: x /= y = not (x == y)+eqNegation : ⦃ iEq : Eq e ⦄ → ⦃ IsLawfulEq e ⦄+           → ∀ { x y : e } → (x /= y) ≡ not (x == y)+eqNegation = refl+
+ lib/base/Haskell/Law/Eq/Instances.agda view
@@ -0,0 +1,138 @@+module Haskell.Law.Eq.Instances where++open import Agda.Builtin.Char.Properties renaming (primCharToNatInjective to c2n-injective)+open import Agda.Builtin.Word.Properties renaming (primWord64ToNatInjective to w2n-injective)++open import Haskell.Prim+open import Haskell.Prim.Eq++open import Haskell.Prim.Either using ( Either; Left; Right )+open import Haskell.Prim.Int    using ( Int; int64 )+open import Haskell.Prim.Maybe+open import Haskell.Prim.Ord    using ( Ordering; LT; GT; EQ )+open import Haskell.Prim.Tuple+open import Haskell.Prim.Word   using ( Word )++open import Haskell.Extra.Dec   using ( mapReflects )++open import Haskell.Law.Eq.Def+open import Haskell.Law.Equality++open import Haskell.Law.Either+open import Haskell.Law.Int+open import Haskell.Law.Integer+open import Haskell.Law.List    using ( ∷-injective-left; ∷-injective-right )+open import Haskell.Law.Maybe+open import Haskell.Law.Nat++open _×_×_++instance+  iLawfulEqNat : IsLawfulEq Nat+  iLawfulEqNat .isEquality zero    zero    = refl+  iLawfulEqNat .isEquality zero    (suc _) = λ ()+  iLawfulEqNat .isEquality (suc _) zero    = λ ()+  iLawfulEqNat .isEquality (suc x) (suc y) = mapReflects+    (cong suc)+    suc-injective+    (isEquality x y)++  iLawfulEqWord : IsLawfulEq Word+  iLawfulEqWord .isEquality x y+    with (w2n x) in h₁ | (w2n y) in h₂+  ... | a | b  = mapReflects+    (λ h → w2n-injective x y $ sym $ trans (trans h₂ $ sym h) (sym h₁))+    (λ h → trans (sym $ trans (cong w2n (sym h)) h₁) h₂)+    (isEquality a b)++  iLawfulEqBool : IsLawfulEq Bool+  iLawfulEqBool .isEquality False False = refl+  iLawfulEqBool .isEquality False True  = λ()+  iLawfulEqBool .isEquality True  False = λ()+  iLawfulEqBool .isEquality True  True  = refl++  iLawfulEqChar : IsLawfulEq Char+  iLawfulEqChar .isEquality x y+    with (c2n x) in h₁ | (c2n y) in h₂+  ... | a | b  = mapReflects { a ≡ b } { x ≡ y } { eqNat a b }+    (λ h → c2n-injective x y $ sym $ trans (trans h₂ $ sym h) (sym h₁))+    (λ h → trans (sym $ trans (cong c2n (sym h)) h₁) h₂)+    (isEquality a b)++  iLawfulEqEither : ⦃ iEqA : Eq a ⦄ → ⦃ iEqB : Eq b ⦄+    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄+    → IsLawfulEq (Either a b)+  iLawfulEqEither .isEquality (Left  _) (Right _) = λ ()+  iLawfulEqEither .isEquality (Right _) (Left  _) = λ ()+  iLawfulEqEither .isEquality (Left  x) (Left  y) = mapReflects+    (cong Left) (Left-injective) (isEquality x y)+  iLawfulEqEither .isEquality (Right x) (Right y) = mapReflects+    (cong Right) (Right-injective) (isEquality x y)++  iLawfulEqInt : IsLawfulEq Int+  iLawfulEqInt .isEquality (int64 x) (int64 y) = mapReflects+    (cong int64) int64-injective (isEquality x y)++  iLawfulEqInteger : IsLawfulEq Integer+  iLawfulEqInteger .isEquality (pos n)    (pos m)    = mapReflects+    (cong pos) pos-injective (isEquality n m)+  iLawfulEqInteger .isEquality (pos _)    (negsuc _) = λ ()+  iLawfulEqInteger .isEquality (negsuc _) (pos _)    = λ ()+  iLawfulEqInteger .isEquality (negsuc n) (negsuc m) = mapReflects+    (cong negsuc) neg-injective (isEquality n m)++  iLawfulEqList : ⦃ iEqA : Eq a ⦄ → ⦃ IsLawfulEq a ⦄ → IsLawfulEq (List a)+  iLawfulEqList .isEquality []       []      = refl+  iLawfulEqList .isEquality []       (_ ∷ _) = λ ()+  iLawfulEqList .isEquality (_ ∷ _)  []      = λ ()+  iLawfulEqList .isEquality (x ∷ xs) (y ∷ ys)+    with (x == y) in h₁+  ... | True  = mapReflects+    (λ h → cong₂ (_∷_) (equality x y h₁)  h)+    ∷-injective-right+    (isEquality xs ys)+  ... | False = λ h → (nequality x y h₁) (∷-injective-left h)++  iLawfulEqMaybe : ⦃ iEqA : Eq a ⦄ → ⦃ IsLawfulEq a ⦄ → IsLawfulEq (Maybe a)+  iLawfulEqMaybe .isEquality Nothing  Nothing  = refl+  iLawfulEqMaybe .isEquality Nothing  (Just _) = λ()+  iLawfulEqMaybe .isEquality (Just _) Nothing  = λ()+  iLawfulEqMaybe .isEquality (Just x) (Just y) = mapReflects+    (cong Just) Just-injective (isEquality x y)++  iLawfulEqOrdering : IsLawfulEq Ordering+  iLawfulEqOrdering .isEquality LT LT = refl+  iLawfulEqOrdering .isEquality LT EQ = λ()+  iLawfulEqOrdering .isEquality LT GT = λ()+  iLawfulEqOrdering .isEquality EQ LT = λ()+  iLawfulEqOrdering .isEquality EQ EQ = refl+  iLawfulEqOrdering .isEquality EQ GT = λ()+  iLawfulEqOrdering .isEquality GT LT = λ()+  iLawfulEqOrdering .isEquality GT EQ = λ()+  iLawfulEqOrdering .isEquality GT GT = refl++  iLawfulEqTuple₂ : ⦃ iEqA : Eq a ⦄ ⦃ iEqB : Eq b ⦄+    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄+    → IsLawfulEq (a × b)+  iLawfulEqTuple₂ .isEquality (x₁ , x₂) (y₁ , y₂)+    with (x₁ == y₁) in h₁+  ... | True  = mapReflects+    (λ h → cong₂ _,_ (equality x₁ y₁ h₁) h)+    (cong snd)+    (isEquality x₂ y₂)+  ... | False = λ h → exFalso (equality' x₁ y₁ (cong fst h)) h₁++  iLawfulEqTuple₃ : ⦃ iEqA : Eq a ⦄ ⦃ iEqB : Eq b ⦄ ⦃ iEqC : Eq c ⦄+    → ⦃ IsLawfulEq a ⦄ → ⦃ IsLawfulEq b ⦄ → ⦃ IsLawfulEq c ⦄+    → IsLawfulEq (a × b × c)+  iLawfulEqTuple₃ .isEquality (x₁ , x₂ , x₃) (y₁ , y₂ , y₃)+    with (x₁ == y₁) in h₁+  ... | True  = mapReflects+    (λ h → cong₂ (λ a (b , c) → a , b , c) (equality x₁ y₁ h₁) h)+    (cong λ h → snd3 h , thd3 h)+    (isEquality (x₂ , x₃) (y₂ , y₃))+  ... | False = λ h → exFalso (equality' x₁ y₁ (cong fst3 h)) h₁+++  iLawfulEqUnit : IsLawfulEq ⊤+  iLawfulEqUnit .isEquality tt tt = refl
+ lib/base/Haskell/Law/Equality.agda view
@@ -0,0 +1,67 @@+module Haskell.Law.Equality where++open import Haskell.Prim++open import Agda.Builtin.TrustMe++_≠_ : {A : Type} → A → A → Type+_≠_ a b = a ≡ b → ⊥++infix 4 _≠_++--------------------------------------------------+-- Basic Laws++cong : {A B : Type} → ∀ (f : A → B) {x y} → x ≡ y → f x ≡ f y+cong f refl = refl++cong₂ : ∀ (f : a → b → c) {x y u v} → x ≡ y → u ≡ v → f x u ≡ f y v+cong₂ f refl refl = refl++sym : ∀ {A : Type} {x y : A} → x ≡ y → y ≡ x+sym refl = refl++trans : ∀ {A : Type} {x y z : A} → x ≡ y → y ≡ z → x ≡ z+trans refl refl = refl++subst : ∀ {A : Type} (P : A → Type) {x y : A} → x ≡ y → P x → P y+subst P refl z = z++--------------------------------------------------+-- Scary Things++trustMe : ∀ {a} {A : Type a} {x y : A} → x ≡ y+trustMe = primTrustMe++--------------------------------------------------+-- ≡-Reasoning++infix  1 begin_+infixr 2 _≡⟨⟩_ step-≡ step-≡˘+infix  3 _∎++begin_ : ∀{x y : a} → x ≡ y → x ≡ y+begin_ x≡y = x≡y++_≡⟨⟩_ : ∀ (x {y} : a) → x ≡ y → x ≡ y+_ ≡⟨⟩ x≡y = x≡y++step-≡ : ∀ (x {y z} : a) → y ≡ z → x ≡ y → x ≡ z+step-≡ _ y≡z x≡y = trans x≡y y≡z++step-≡˘ : ∀ (x {y z} : a) → y ≡ z → y ≡ x → x ≡ z+step-≡˘ _ y≡z y≡x = trans (sym y≡x) y≡z++_∎ : ∀ (x : a) → x ≡ x+_∎ _ = refl++syntax step-≡  x y≡z x≡y = x ≡⟨  x≡y ⟩ y≡z+syntax step-≡˘ x y≡z y≡x = x ≡˘⟨ y≡x ⟩ y≡z+++-------------------------------------------------+-- Utility Functions++subst0 : {@0 a : Type} (@0 p : @0 a → Type) {@0 x y : a} → @0 x ≡ y → p x → p y+subst0 p refl z = z+{-# COMPILE AGDA2HS subst0 transparent #-}
+ lib/base/Haskell/Law/Extensionality.agda view
@@ -0,0 +1,12 @@+module Haskell.Law.Extensionality where++open import Haskell.Prim++-------------------------------------------------------------------------------+-- Axiom: Functions are equal if they agree on all arguments.+--+-- This axiom is sometimes needed for proving properties of higher-order+-- functions, such as 'filter', 'fmap', or '(>>=)'.++postulate+  ext : ∀ {f g : a → b} → (∀ x → f x ≡ g x) → f ≡ g
+ lib/base/Haskell/Law/Function.agda view
@@ -0,0 +1,171 @@+module Haskell.Law.Function where++open import Haskell.Prim+open import Haskell.Law.Equality+++{-|+Pointwise equality on functions.+This says that two functions produce the same+result for all input values.+-}+infix 4 _≗_+_≗_ : ∀ {A B : Type} (f g : A → B) → Type+f ≗ g = ∀ a → f a ≡ g a++Commutative : {a : Type} → (a → a → a) → Type+Commutative _+_ = ∀ x y → x + y ≡ y + x++Associative : {a : Type} → (a → a → a) → Type+Associative _+_ = ∀ x y z → (x + y) + z ≡ x + (y + z)++Identityˡ : {a : Type} → (a → a → a) → a → Type+Identityˡ _+_ 𝟘 = ∀ x → 𝟘 + x ≡ x++Identityʳ : {a : Type} → (a → a → a) → a → Type+Identityʳ _+_ 𝟘 = ∀ x → x + 𝟘 ≡ x++Distributiveˡ : {a : Type} → (_+_ : a → a → a) → (_*_ : a → a → a) → Type+Distributiveˡ _+_ _*_ = ∀ x y z → x * (y + z) ≡ (x * y) + (x * z)++Distributiveʳ : {a : Type} → (_+_ : a → a → a) → (_*_ : a → a → a) → Type+Distributiveʳ _+_ _*_ =  ∀ x y z → (y + z) * x ≡ (y * x) + (z * x)++{-|+Definition of homomorphism over unary functions.+A function φ is homomorphic w.r.t. some function or structure f+when it preserves this structure in its target domain b+(where this structure is called g).+-}+Homomorphism₁ : ∀ {a b : Type} (f : a → a) (g : b → b)+  → (φ : a → b) → Type+Homomorphism₁ f g φ = φ ∘ f ≗ g ∘ φ++{-|+Definition of homomorphism over binary functions.+A function φ is homomorphic w.r.t. some structure _+ᵃ_+when it preserves this structure in its target domain b+(where this structure is called _+ᵇ_).+-}+Homomorphism₂ : ∀ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b)+  → (φ : a → b) → Type+Homomorphism₂ _+ᵃ_ _+ᵇ_ φ = ∀ x y → φ (x +ᵃ y) ≡ φ x +ᵇ φ y++record Embedding₂ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) : Type where+  field+    hom   : Homomorphism₂ _+ᵃ_ _+ᵇ_ φ+    embed : φ⁻¹ ∘ φ ≗ id++record MonoidEmbedding₂ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) (0ᵃ : a) (0ᵇ : b) : Type where+  field+    embedding : Embedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹+    0-hom     : φ 0ᵃ ≡ 0ᵇ++map-comm : ∀ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a)+  → Embedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹+  → Commutative _+ᵇ_+  → Commutative _+ᵃ_+map-comm _+ᵃ_ _+ᵇ_ φ φ⁻¹ proj comm x y =+  begin+    x +ᵃ y+  ≡˘⟨ embed (x +ᵃ y) ⟩+    φ⁻¹ (φ (x +ᵃ y))+  ≡⟨ cong φ⁻¹ (hom x y) ⟩+    φ⁻¹ (φ x +ᵇ φ y)+  ≡⟨ cong φ⁻¹ (comm (φ x) (φ y)) ⟩+    φ⁻¹ (φ y +ᵇ φ x)+  ≡˘⟨ cong φ⁻¹ (hom y x) ⟩+    φ⁻¹ (φ (y +ᵃ x))+  ≡⟨ embed (y +ᵃ x) ⟩+    y +ᵃ x+  ∎+  where+    open Embedding₂ proj++map-assoc : ∀ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a)+  → Embedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹+  → Associative _+ᵇ_+  → Associative _+ᵃ_+map-assoc _+ᵃ_ _+ᵇ_ φ φ⁻¹ proj assoc x y z =+  begin+    (x +ᵃ y) +ᵃ z+  ≡⟨ sym (embed ((x +ᵃ y) +ᵃ z)) ⟩+    φ⁻¹ (φ ((x +ᵃ y) +ᵃ z))+  ≡⟨ cong φ⁻¹ (hom (x +ᵃ y) z) ⟩+    φ⁻¹ (φ (x +ᵃ y) +ᵇ φ z)+  ≡⟨ cong φ⁻¹ (cong (_+ᵇ φ z) (hom x y)) ⟩+    φ⁻¹ ((φ x +ᵇ φ y) +ᵇ φ z)+  ≡⟨ cong φ⁻¹ (assoc (φ x) (φ y) (φ z)) ⟩+    φ⁻¹ (φ x +ᵇ (φ y +ᵇ φ z))+  ≡⟨ cong φ⁻¹ (cong (φ x +ᵇ_) (sym (hom y z))) ⟩+    φ⁻¹ (φ x +ᵇ φ (y +ᵃ z))+  ≡⟨ cong φ⁻¹ (sym (hom x (y +ᵃ z))) ⟩+    φ⁻¹ (φ (x +ᵃ (y +ᵃ z)))+  ≡⟨ embed (x +ᵃ (y +ᵃ z)) ⟩+    x +ᵃ (y +ᵃ z)+  ∎+  where+    open Embedding₂ proj++map-idˡ : ∀ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) (0ᵃ : a) (0ᵇ : b)+  → MonoidEmbedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹ 0ᵃ 0ᵇ+  → Identityˡ _+ᵇ_ 0ᵇ+  → Identityˡ _+ᵃ_ 0ᵃ+map-idˡ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ membed idˡ x =+  0ᵃ +ᵃ x         ≡⟨ sym (embed (0ᵃ +ᵃ x)) ⟩+  g (f (0ᵃ +ᵃ x)) ≡⟨ cong g (hom 0ᵃ x) ⟩+  g (f 0ᵃ +ᵇ f x) ≡⟨ cong g (cong (_+ᵇ f x) 0-hom) ⟩+  g (0ᵇ +ᵇ f x)   ≡⟨ cong g (idˡ (f x)) ⟩+  g (f x)        ≡⟨ embed x ⟩+  x              ∎+  where+    open MonoidEmbedding₂ membed+    open Embedding₂ embedding++map-idʳ : ∀ {a b : Type} (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b) (φ : a → b) (φ⁻¹ : b → a) (0ᵃ : a) (0ᵇ : b)+  → MonoidEmbedding₂ _+ᵃ_ _+ᵇ_ φ φ⁻¹ 0ᵃ 0ᵇ+  → Identityʳ _+ᵇ_ 0ᵇ+  → Identityʳ _+ᵃ_ 0ᵃ+map-idʳ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ membed idʳ x =+  x +ᵃ 0ᵃ         ≡⟨ sym (embed (x +ᵃ 0ᵃ)) ⟩+  g (f (x +ᵃ 0ᵃ)) ≡⟨ cong g (hom x 0ᵃ) ⟩+  g (f x +ᵇ f 0ᵃ) ≡⟨ cong g (cong (f x +ᵇ_) 0-hom) ⟩+  g (f x +ᵇ 0ᵇ)   ≡⟨ cong g (idʳ (f x)) ⟩+  g (f x)        ≡⟨ embed x ⟩+  x              ∎+  where+    open MonoidEmbedding₂ membed+    open Embedding₂ embedding++module _ {a b : Type}+  (_+ᵃ_ : a → a → a) (_+ᵇ_ : b → b → b)+  (_*ᵃ_ : a → a → a) (_*ᵇ_ : b → b → b)+  (f : a → b) (g : b → a)+  (embed : g ∘ f ≗ id)+  (+-hom : Homomorphism₂ _+ᵃ_ _+ᵇ_ f)+  (*-hom : Homomorphism₂ _*ᵃ_ _*ᵇ_ f)+  where++  map-distributeˡ : Distributiveˡ _+ᵇ_ _*ᵇ_ → Distributiveˡ _+ᵃ_ _*ᵃ_+  map-distributeˡ distributeˡ-b x y z =+    x *ᵃ (y +ᵃ z)                    ≡˘⟨ embed (x *ᵃ (y +ᵃ z)) ⟩+    g (f (x *ᵃ (y +ᵃ z)))            ≡⟨ cong g (*-hom x (y +ᵃ z)) ⟩+    g (f x *ᵇ f (y +ᵃ z))            ≡⟨ cong g (cong (f x *ᵇ_) (+-hom y z)) ⟩+    g (f x *ᵇ (f y +ᵇ f z))          ≡⟨ cong g (distributeˡ-b (f x) (f y) (f z)) ⟩+    g ((f x *ᵇ f y) +ᵇ (f x *ᵇ f z)) ≡˘⟨ cong g (cong (_+ᵇ (f x *ᵇ f z)) (*-hom x y)) ⟩+    g (f (x *ᵃ y) +ᵇ (f x *ᵇ f z))   ≡˘⟨ cong g (cong (f (x *ᵃ y) +ᵇ_) (*-hom x z)) ⟩+    g (f (x *ᵃ y) +ᵇ f (x *ᵃ z))     ≡˘⟨ cong g (+-hom (x *ᵃ y) (x *ᵃ z)) ⟩+    g (f ((x *ᵃ y) +ᵃ (x *ᵃ z)))     ≡⟨ embed ((x *ᵃ y) +ᵃ (x *ᵃ z)) ⟩+    (x *ᵃ y) +ᵃ (x *ᵃ z)             ∎++  map-distributeʳ : Distributiveʳ _+ᵇ_ _*ᵇ_ → Distributiveʳ _+ᵃ_ _*ᵃ_+  map-distributeʳ distributeʳ-b x y z =+    (y +ᵃ z) *ᵃ x                    ≡˘⟨ embed ((y +ᵃ z) *ᵃ x) ⟩+    g (f ((y +ᵃ z) *ᵃ x))            ≡⟨ cong g (*-hom (y +ᵃ z) x) ⟩+    g (f (y +ᵃ z) *ᵇ f x)            ≡⟨ cong g (cong (_*ᵇ f x) (+-hom y z)) ⟩+    g ((f y +ᵇ f z) *ᵇ f x)          ≡⟨ cong g (distributeʳ-b (f x) (f y) (f z)) ⟩+    g ((f y *ᵇ f x) +ᵇ (f z *ᵇ f x)) ≡˘⟨ cong g (cong (_+ᵇ (f z *ᵇ f x)) (*-hom y x)) ⟩+    g (f (y *ᵃ x) +ᵇ (f z *ᵇ f x))   ≡˘⟨ cong g (cong (f (y *ᵃ x) +ᵇ_) (*-hom z x)) ⟩+    g (f (y *ᵃ x) +ᵇ f (z *ᵃ x))     ≡˘⟨ cong g (+-hom (y *ᵃ x) (z *ᵃ x)) ⟩+    g (f ((y *ᵃ x) +ᵃ (z *ᵃ x)))     ≡⟨ embed ((y *ᵃ x) +ᵃ (z *ᵃ x)) ⟩+    (y *ᵃ x) +ᵃ (z *ᵃ x)             ∎
+ lib/base/Haskell/Law/Functor.agda view
@@ -0,0 +1,7 @@+module Haskell.Law.Functor where++open import Haskell.Law.Functor.Def    public+open import Haskell.Law.Functor.Either public+open import Haskell.Law.Functor.IO     public+open import Haskell.Law.Functor.List   public+open import Haskell.Law.Functor.Maybe  public
+ lib/base/Haskell/Law/Functor/Def.agda view
@@ -0,0 +1,24 @@+module Haskell.Law.Functor.Def where++open import Haskell.Prim+open import Haskell.Prim.Tuple++open import Haskell.Prim.Functor++record IsLawfulFunctor (F : Type → Type) ⦃ iFuncF : Functor F ⦄ : Type₁ where+  field+    -- Identity: fmap id == id+    identity : (fa : F a) → (fmap id) fa ≡ id fa++    -- Composition: fmap (f . g) == fmap f . fmap g+    composition : (fa : F a) (f : a → b) (g : b → c)+      → fmap (g ∘ f) fa ≡ (fmap g ∘ fmap f) fa++open IsLawfulFunctor ⦃ ... ⦄ public++instance postulate+  iLawfulFunctorFun : IsLawfulFunctor (λ b → a → b)++  iLawfulFunctorTuple₂ : IsLawfulFunctor (a ×_)++  iLawfulFunctorTuple₃ : IsLawfulFunctor (a × b ×_)
+ lib/base/Haskell/Law/Functor/Either.agda view
@@ -0,0 +1,14 @@+module Haskell.Law.Functor.Either where++open import Haskell.Prim+open import Haskell.Prim.Either++open import Haskell.Prim.Functor++open import Haskell.Law.Functor.Def++instance+  iLawfulFunctorEither : IsLawfulFunctor (Either a)+  iLawfulFunctorEither .identity = λ { (Left _) → refl; (Right _) → refl }++  iLawfulFunctorEither .composition = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
+ lib/base/Haskell/Law/Functor/FromMonad.agda view
@@ -0,0 +1,33 @@+module Haskell.Law.Functor.FromMonad where++open import Haskell.Prim++open import Haskell.Prim.Functor+open import Haskell.Prim.Monad++open import Haskell.Law.Monad.Def as Monad+open import Haskell.Law.Equality+open import Haskell.Law.Functor++-------------------------------------------------------------------------------+-- Prove the Functor laws from the Monad laws++--+prop-PreLawfulMonad→IsLawfulFunctor+  : ∀ ⦃ _ : Monad m ⦄ ⦃ _ : PreLawfulMonad m ⦄+  → IsLawfulFunctor m+--+prop-PreLawfulMonad→IsLawfulFunctor .identity fa+  rewrite Monad.def-fmap->>= id fa+  = Monad.rightIdentity fa+prop-PreLawfulMonad→IsLawfulFunctor .composition fa f g+  rewrite Monad.def-fmap->>= g (fmap f fa)+  | Monad.def-fmap->>= f fa+  | Monad.def-fmap->>= (g ∘ f) fa+  = begin+    fa >>= (return ∘ g ∘ f)+  ≡⟨ cong-monad fa (λ x → sym (Monad.leftIdentity (f x) _)) ⟩+    fa >>= (λ x → return (f x) >>= (return ∘ g))+  ≡⟨ Monad.associativity _ _ _ ⟩+    (fa >>= (return ∘ f)) >>= (return ∘ g)+  ∎
+ lib/base/Haskell/Law/Functor/IO.agda view
@@ -0,0 +1,10 @@+module Haskell.Law.Functor.IO where++open import Haskell.Prim+open import Haskell.Prim.IO++open import Haskell.Prim.Functor++open import Haskell.Law.Functor.Def++instance postulate isLawFulFunctorIO : IsLawfulFunctor IO
+ lib/base/Haskell/Law/Functor/List.agda view
@@ -0,0 +1,25 @@+module Haskell.Law.Functor.List where++open import Haskell.Prim+open import Haskell.Prim.List++open import Haskell.Prim.Functor++open import Haskell.Law.Equality+open import Haskell.Law.Functor.Def++private+  identityList : (fa : List a) → (fmap id) fa ≡ id fa+  identityList [] = refl+  identityList (x ∷ xs) rewrite identityList xs = refl++  compositionList : (fa : List a) → (f : a → b) → (g : b → c)+    → fmap (g ∘ f) fa ≡ (fmap g ∘ fmap f) fa+  compositionList [] _ _ = refl+  compositionList (x ∷ xs) f g rewrite compositionList xs f g = refl++instance+  iLawfulFunctorList : IsLawfulFunctor List+  iLawfulFunctorList = λ where+    .identity → identityList+    .composition → compositionList
+ lib/base/Haskell/Law/Functor/Maybe.agda view
@@ -0,0 +1,14 @@+module Haskell.Law.Functor.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Maybe++open import Haskell.Prim.Functor++open import Haskell.Law.Functor.Def++instance+  iLawfulFunctorMaybe : IsLawfulFunctor Maybe+  iLawfulFunctorMaybe .identity = λ { Nothing → refl; (Just _) → refl }++  iLawfulFunctorMaybe .composition = λ { Nothing _ _ → refl; (Just _) _ _ → refl }
+ lib/base/Haskell/Law/Int.agda view
@@ -0,0 +1,9 @@+module Haskell.Law.Int where++open import Haskell.Prim+open import Haskell.Prim.Int using ( int64 )++open import Haskell.Law.Def++int64-injective : Injective int64+int64-injective refl = refl
+ lib/base/Haskell/Law/Integer.agda view
@@ -0,0 +1,11 @@+module Haskell.Law.Integer where++open import Haskell.Prim++open import Haskell.Law.Def++pos-injective : Injective pos+pos-injective refl = refl++neg-injective : Injective negsuc+neg-injective refl = refl
+ lib/base/Haskell/Law/List.agda view
@@ -0,0 +1,145 @@+module Haskell.Law.List where++open import Haskell.Law.Equality+open import Haskell.Prim renaming (addNat to _+ₙ_)+open import Haskell.Prim.Foldable+open import Haskell.Prim.List+open import Haskell.Prim.Applicative++[]≠∷ : ∀ x (xs : List a) → [] ≠ x ∷ xs+[]≠∷ x xs ()++--------------------------------------------------+-- _∷_++module _ {x y : a} {xs ys : List a} where  +  ∷-injective-left : x ∷ xs ≡ y ∷ ys → x ≡ y+  ∷-injective-left refl = refl++  ∷-injective-right : x ∷ xs ≡ y ∷ ys → xs ≡ ys+  ∷-injective-right refl = refl++--------------------------------------------------+-- map++map-id : (xs : List a) → map id xs ≡ xs+map-id []       = refl+map-id (x ∷ xs) = cong (x ∷_) (map-id xs)++map-++ : ∀ (f : a → b) xs ys → map f (xs ++ ys) ≡ map f xs ++ map f ys+map-++ f [] ys       = refl+map-++ f (x ∷ xs) ys = cong (f x ∷_) (map-++ f xs ys)++lengthMap : ∀ (f : a → b) xs → lengthNat (map f xs) ≡ lengthNat xs+lengthMap f []       = refl+lengthMap f (x ∷ xs) = cong suc (lengthMap f xs)++map-∘ : ∀ (g : b → c) (f : a → b) xs → map (g ∘ f) xs ≡ (map g ∘ map f) xs+map-∘ g f []       = refl+map-∘ g f (x ∷ xs) = cong (_ ∷_) (map-∘ g f xs)++map-concatMap : ∀ (f : a → b) (xs : List a) → (map f xs) ≡ concatMap (λ g → f g ∷ []) xs+map-concatMap f [] = refl+map-concatMap f (x ∷ xs) +  rewrite map-concatMap f xs+  = refl++map-<*>-recomp : {a b c : Type} → (xs : List (a → b)) → (ys : List a) → (u : (b → c))  +  → ((map (u ∘_) xs) <*> ys) ≡ map u (xs <*> ys)+map-<*>-recomp [] _ _  = refl+map-<*>-recomp (x ∷ xs) ys u +  rewrite map-∘ u x ys+    | map-++ u (map x ys) (xs <*> ys)+    | map-<*>-recomp  xs ys u+  = refl++--------------------------------------------------+-- _++_++lengthNat-++ : ∀ (xs : List a) {ys} →+            lengthNat (xs ++ ys) ≡ lengthNat xs +ₙ lengthNat ys+lengthNat-++ []       = refl+lengthNat-++ (x ∷ xs) = cong suc (lengthNat-++ xs)++++-[] : ∀ (xs : List a) → xs ++ [] ≡ xs+++-[] [] = refl+++-[] (x ∷ xs) rewrite ++-[] xs = refl++[]-++ : ∀ (xs : List a) → [] ++ xs ≡ xs+[]-++ xs = refl++++-assoc : ∀ (xs ys zs : List a) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)+++-assoc [] ys zs = refl+++-assoc (x ∷ xs) ys zs rewrite ++-assoc xs ys zs = refl++++-∷-assoc : ∀ xs y (ys : List a) → xs ++ y ∷ ys ≡ (xs ++ y ∷ []) ++ ys+++-∷-assoc [] y ys = refl+++-∷-assoc (x ∷ xs) y ys = cong (x ∷_) (++-∷-assoc xs y ys)++∷-++-assoc : ∀ x xs (ys : List a) → (x ∷ xs) ++ ys ≡ x ∷ (xs ++ ys)+∷-++-assoc x xs ys = refl++++-identity-right-unique : ∀ (xs : List a) {ys} → xs ≡ xs ++ ys → ys ≡ []+++-identity-right-unique []       refl = refl+++-identity-right-unique (x ∷ xs) eq   =+  ++-identity-right-unique xs (∷-injective-right eq)++++-identity-left-unique : ∀ {xs} (ys : List a) → xs ≡ ys ++ xs → ys ≡ []+++-identity-left-unique               []       _  = refl+++-identity-left-unique {xs = x ∷ xs} (y ∷ ys) eq+  with ++-identity-left-unique (ys ++ (x ∷ [])) (begin+        xs                  ≡⟨ ∷-injective-right eq ⟩+        ys ++ x ∷ xs        ≡⟨ sym (++-assoc ys (x ∷ []) xs) ⟩+        (ys ++ x ∷ []) ++ xs ∎)+++-identity-left-unique {xs = x ∷ xs} (y ∷ []   ) eq | ()+++-identity-left-unique {xs = x ∷ xs} (y ∷ _ ∷ _) eq | ()++++-cancel-left : ∀ (xs ys : List a) {zs} → xs ++ ys ≡ xs ++ zs → ys ≡ zs+++-cancel-left []       ys eq = eq+++-cancel-left (x ∷ xs) ys eq = ++-cancel-left xs ys (∷-injective-right eq)++++-cancel-right : ∀ (xs ys : List a) {zs} → xs ++ zs ≡ ys ++ zs → xs ≡ ys+++-cancel-right []       []       eq = refl+++-cancel-right (x ∷ xs) []       eq = ++-identity-left-unique (x ∷ xs) (sym eq)+++-cancel-right []       (y ∷ ys) eq = sym $ ++-identity-left-unique (y ∷ ys) eq+++-cancel-right (x ∷ xs) (y ∷ ys) eq +  rewrite ∷-injective-left eq = cong (y ∷_) $ ++-cancel-right xs ys (∷-injective-right eq)++++-conical-left : (xs ys : List a) → xs ++ ys ≡ [] → xs ≡ []+++-conical-left [] _ refl = refl++++-conical-right : (xs ys : List a) → xs ++ ys ≡ [] → ys ≡ []+++-conical-right [] _ refl = refl++∷-not-identity : ∀ x (xs ys : List a) → (x ∷ xs) ++ ys ≡ ys → ⊥+∷-not-identity x xs ys eq = []≠∷ x xs (sym $ ++-identity-left-unique (x ∷ xs) (sym eq))++concatMap-++-distr : ∀ (xs ys : List a) (f : a → List b) → +  ((concatMap f xs) ++ (concatMap f ys)) ≡ (concatMap f (xs ++ ys))+concatMap-++-distr [] ys f = refl+concatMap-++-distr (x ∷ xs) ys f+  rewrite ++-assoc (f x) (concatMap f xs) (concatMap f ys)+  | concatMap-++-distr xs ys f+ = refl++--------------------------------------------------+-- foldr++foldr-universal : ∀ (h : List a → b) f e → (h [] ≡ e) →+                  (∀ x xs → h (x ∷ xs) ≡ f x (h xs)) →+                  ∀ xs → h xs ≡ foldr f e xs+foldr-universal h f e base step []       = base+foldr-universal h f e base step (x ∷ xs) rewrite step x xs = cong (f x) (foldr-universal h f e base step xs) ++foldr-cong : ∀ {f g : a → b → b} {d e : b} →+            (∀ x y → f x y ≡ g x y) → d ≡ e →+             ∀ (xs : List a) → foldr f d xs ≡ foldr g e xs+foldr-cong f≡g d≡e []       = d≡e+foldr-cong f≡g d≡e (x ∷ xs) rewrite foldr-cong f≡g d≡e xs = f≡g x _++foldr-fusion : (h : b → c) {f : a → b → b} {g : a → c → c} (e : b) →+               (∀ x y → h (f x y) ≡ g x (h y)) →+               ∀ (xs : List a) → h (foldr f e xs) ≡ foldr g (h e) xs+foldr-fusion h {f} {g} e fuse =+  foldr-universal (h ∘ foldr f e) g (h e) refl+                  (λ x xs → fuse x (foldr f e xs))
+ lib/base/Haskell/Law/Maybe.agda view
@@ -0,0 +1,9 @@+module Haskell.Law.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Maybe++open import Haskell.Law.Def++Just-injective : Injective (Just {a = a})+Just-injective refl = refl
+ lib/base/Haskell/Law/Monad.agda view
@@ -0,0 +1,7 @@+module Haskell.Law.Monad where++open import Haskell.Law.Monad.Def    public+open import Haskell.Law.Monad.Either public+open import Haskell.Law.Monad.IO     public+open import Haskell.Law.Monad.List   public+open import Haskell.Law.Monad.Maybe  public
+ lib/base/Haskell/Law/Monad/Def.agda view
@@ -0,0 +1,75 @@+module Haskell.Law.Monad.Def where++open import Haskell.Prim++open import Haskell.Prim.Applicative+open import Haskell.Prim.Functor+open import Haskell.Prim.Monad+open import Haskell.Prim.Monoid+open import Haskell.Prim.Tuple++open import Haskell.Law.Applicative+open import Haskell.Law.Equality+open import Haskell.Law.Extensionality++-- Helper function: Substitution in the second argument of '(>>=)'.+cong-monad+  : ∀ ⦃ _ : Monad m ⦄ (mx : m a) {f g : a → m b}+  → (∀ x → f x ≡ g x)+  → (do x ← mx; f x) ≡ (do x ← mx; g x)+--+cong-monad mx {f} {g} eq = cong (mx >>=_) (ext eq)++-------------------------------------------------------------------------------+-- Monad laws+--+-- `PreLawfulMonad` contains all laws that we expect a 'Monad' to satisfy,+-- except that we do not yet require that the superclasses are themselves+-- lawful, this is deferred to `IsLawfulMonad`.+-- The lawfulness of the superclasses can be proven from `PreLawfulMonad`.++record PreLawfulMonad (m : Type → Type) ⦃ _ : Monad m ⦄ : Type₁ where+  field+    -- The three monad laws+    leftIdentity  : ∀ {a} (x : a) (k : a → m b)+      → (return x >>= k) ≡ k x++    rightIdentity : ∀ {a} (ma : m a)+      → (ma >>= return) ≡ ma++    associativity : ∀ {a b c} (ma : m a) (f : a → m b) (g : b → m c)+      → (ma >>= (λ x → f x >>= g)) ≡ ((ma >>= f) >>= g)++    -- Default functions+    def->>->>= : ∀ {a b} (ma : m a) (mb : m b)+      → ma >> mb ≡ ma >>= (λ x → mb)++    def-pure-return : ∀ {a} (x : a)+      → pure {m} x ≡ return x++    -- Superclass functions+    def-fmap->>= : ∀ {a b} (f : a → b) (ma : m a)+      → fmap f ma ≡ ma >>= (return ∘ f)++    def-<*>->>= : ∀ {a b} (mab : m (a → b)) (ma : m a)+      → (mab <*> ma) ≡ (mab >>= (λ f → (ma >>= (λ x → return (f x)))))++open PreLawfulMonad ⦃ ... ⦄ public++-- All laws together+record IsLawfulMonad (m : Type → Type) ⦃ _ : Monad m ⦄ : Type₁ where+  field+    overlap ⦃ applicative ⦄ : IsLawfulApplicative m+    overlap ⦃ monad ⦄       : PreLawfulMonad m++open IsLawfulMonad ⦃ ... ⦄ public++-------------------------------------------------------------------------------+-- postulated monad laws, to be proven++instance postulate+  iLawfulMonadFun : IsLawfulMonad (λ b → a → b)++  iLawfulMonadTuple₂ : ⦃ Monoid a ⦄ → Monad (a ×_)++  iLawfulMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monad (a × b ×_)
+ lib/base/Haskell/Law/Monad/Either.agda view
@@ -0,0 +1,31 @@+module Haskell.Law.Monad.Either where++open import Haskell.Prim+open import Haskell.Prim.Either++open import Haskell.Prim.Monad++open import Haskell.Law.Monad.Def++open import Haskell.Law.Applicative.Either++instance+  iPreLawfulMonadEither : PreLawfulMonad (Either a)+  iPreLawfulMonadEither = λ where+    .leftIdentity _ _ → refl+    .rightIdentity (Left  x) → refl+    .rightIdentity (Right x) → refl+    .associativity (Left  x) _ _ → refl+    .associativity (Right x) _ _ → refl+    .def->>->>= _ _ → refl+    .def-pure-return _ → refl+    .def-fmap->>= _ → λ where+      (Left  x) → refl+      (Right x) → refl+    .def-<*>->>= → λ where+      (Left  _) _ → refl+      (Right _) (Left  _) → refl+      (Right _) (Right _) → refl++  iIsLawfulMonadEither : IsLawfulMonad (Either a)+  iIsLawfulMonadEither = record {}
+ lib/base/Haskell/Law/Monad/IO.agda view
@@ -0,0 +1,17 @@+module Haskell.Law.Monad.IO where++open import Haskell.Prim+open import Haskell.Prim.IO++open import Haskell.Prim.Monad++open import Haskell.Law.Monad.Def++open import Haskell.Law.Applicative.IO using (iLawfulApplicativeIO)++instance+  postulate+    iPreLawfulMonadIO : PreLawfulMonad IO++  iIsLawfulMonadIO : IsLawfulMonad IO+  iIsLawfulMonadIO = record { applicative = iLawfulApplicativeIO }
+ lib/base/Haskell/Law/Monad/List.agda view
@@ -0,0 +1,43 @@+module Haskell.Law.Monad.List where++open import Haskell.Prim+open import Haskell.Prim.List++open import Haskell.Prim.Monad++open import Haskell.Law.Monad.Def+open import Haskell.Law.List++open import Haskell.Law.Applicative.List++instance+  iPreLawfulMonadList : PreLawfulMonad List+  iPreLawfulMonadList .leftIdentity _ _ = ++-[] _++  iPreLawfulMonadList .rightIdentity [] = refl+  iPreLawfulMonadList .rightIdentity (x ∷ xs)+    rewrite iPreLawfulMonadList .PreLawfulMonad.rightIdentity xs+    = refl++  iPreLawfulMonadList .associativity []       f g = refl+  iPreLawfulMonadList .associativity (x ∷ xs) f g+    rewrite associativity xs f g+    | concatMap-++-distr (f x) (xs >>= f) g+    = refl++  iPreLawfulMonadList .def->>->>= _ _ = refl+  iPreLawfulMonadList .def-pure-return _ = refl++  iPreLawfulMonadList .def-fmap->>= _ [] = refl+  iPreLawfulMonadList .def-fmap->>= f (x ∷ xs)+    rewrite iPreLawfulMonadList .PreLawfulMonad.def-fmap->>= f xs+    = refl++  iPreLawfulMonadList .def-<*>->>= []       xs = refl+  iPreLawfulMonadList .def-<*>->>= (f ∷ fs) xs+    rewrite iPreLawfulMonadList .PreLawfulMonad.def-<*>->>= fs xs+    | map-concatMap f xs+    = refl++  iIsLawfulMonadList : IsLawfulMonad List+  iIsLawfulMonadList = record {}
+ lib/base/Haskell/Law/Monad/Maybe.agda view
@@ -0,0 +1,35 @@+module Haskell.Law.Monad.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Maybe++open import Haskell.Prim.Monad++open import Haskell.Law.Monad.Def++open import Haskell.Law.Applicative.Maybe++instance+  iPreLawfulMonadMaybe : PreLawfulMonad Maybe+  iPreLawfulMonadMaybe = λ where+    .leftIdentity _ _ → refl+    .rightIdentity → λ where+      Nothing  → refl+      (Just _) → refl+    .associativity → λ where+      Nothing  _ _ → refl+      (Just _) _ _ → refl++    .def->>->>= _ _ → refl+    .def-pure-return _ → refl++    .def-fmap->>= _ → λ where+      Nothing → refl+      (Just _) → refl+    .def-<*>->>= → λ where+      Nothing  _        → refl+      (Just _) Nothing  → refl+      (Just _) (Just _) → refl++  iIsLawfulMonadMaybe : IsLawfulMonad Maybe+  iIsLawfulMonadMaybe = record {}
+ lib/base/Haskell/Law/Monoid.agda view
@@ -0,0 +1,10 @@+module Haskell.Law.Monoid where++open import Haskell.Law.Semigroup.Def    public+open import Haskell.Law.Semigroup.Either public+open import Haskell.Law.Semigroup.List   public+open import Haskell.Law.Semigroup.Maybe  public++open import Haskell.Law.Monoid.Def       public+open import Haskell.Law.Monoid.List      public+open import Haskell.Law.Monoid.Maybe     public
+ lib/base/Haskell/Law/Monoid/Def.agda view
@@ -0,0 +1,38 @@+module Haskell.Law.Monoid.Def where++open import Haskell.Prim+open import Haskell.Prim.Tuple++open import Haskell.Prim.Foldable+open import Haskell.Prim.Monoid++open import Haskell.Law.Semigroup.Def++record IsLawfulMonoid (a : Type) ⦃ iMonoidA : Monoid a ⦄ : Type₁ where+  field+    overlap ⦃ super ⦄ : IsLawfulSemigroup a++    -- Right identity: x <> mempty = x+    rightIdentity : (x : a) → x <> mempty ≡ x++    -- Left identity: mempty <> x = x+    leftIdentity : (x : a) → mempty <> x ≡ x++    -- Concatenation: mconcat = foldr (<>) mempty+    concatenation : (xs : List a) → mconcat xs ≡ foldr _<>_ mempty xs++open IsLawfulMonoid ⦃ ... ⦄ public++postulate instance+  iLawfulMonoidFun : ⦃ iSemB : Monoid b ⦄ → ⦃ IsLawfulMonoid b ⦄ → IsLawfulMonoid (a → b)++  iLawfulMonoidUnit : IsLawfulMonoid ⊤++  iLawfulMonoidTuple₂ : ⦃ iSemA : Monoid a ⦄ ⦃ iSemB : Monoid b ⦄+                      → ⦃ IsLawfulMonoid a ⦄ → ⦃ IsLawfulMonoid b ⦄+                      → IsLawfulMonoid (a × b)++  iLawfulMonoidTuple₃ : ⦃ iSemA : Monoid a ⦄ ⦃ iSemB : Monoid b ⦄ ⦃ iSemC : Monoid c ⦄+                      → ⦃ IsLawfulMonoid a ⦄ → ⦃ IsLawfulMonoid b ⦄ → ⦃ IsLawfulMonoid c ⦄+                      → IsLawfulMonoid (a × b × c)+
+ lib/base/Haskell/Law/Monoid/List.agda view
@@ -0,0 +1,26 @@+module Haskell.Law.Monoid.List where++open import Haskell.Prim+open import Haskell.Prim.List++open import Haskell.Prim.Monoid++open import Haskell.Law.List+open import Haskell.Law.Monoid.Def+open import Haskell.Law.Semigroup.Def+open import Haskell.Law.Semigroup.List++instance+  iLawfulMonoidList : IsLawfulMonoid (List a)+  iLawfulMonoidList .rightIdentity [] = refl+  iLawfulMonoidList .rightIdentity (x ∷ xs)+    rewrite ++-[] (x ∷ xs)+    = refl++  iLawfulMonoidList .leftIdentity [] = refl+  iLawfulMonoidList .leftIdentity (x ∷ xs) = refl++  iLawfulMonoidList .concatenation [] = refl+  iLawfulMonoidList .concatenation (x ∷ xs)+    rewrite concatenation xs+    = refl
+ lib/base/Haskell/Law/Monoid/Maybe.agda view
@@ -0,0 +1,21 @@+module Haskell.Law.Monoid.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Maybe++open import Haskell.Prim.Monoid++open import Haskell.Law.Monoid.Def+open import Haskell.Law.Semigroup.Def+open import Haskell.Law.Semigroup.Maybe++instance+  iLawfulMonoidMaybe : ⦃ iMonoidA : Monoid a ⦄ → ⦃ iLawfulMonoidA : IsLawfulMonoid a ⦄ → IsLawfulMonoid (Maybe a)+  iLawfulMonoidMaybe .rightIdentity = λ { Nothing → refl; (Just _) → refl }++  iLawfulMonoidMaybe .leftIdentity = λ { Nothing → refl; (Just _) → refl }++  iLawfulMonoidMaybe .concatenation [] = refl+  iLawfulMonoidMaybe .concatenation (x ∷ xs) +    rewrite (concatenation xs)+    = refl
+ lib/base/Haskell/Law/Nat.agda view
@@ -0,0 +1,51 @@+module Haskell.Law.Nat where++open import Haskell.Prim+open import Haskell.Prim.Num++open import Haskell.Law.Def+open import Haskell.Law.Equality++suc-injective : Injective suc+suc-injective refl = refl++{-|+The canonical formalization of the+less-than-or-equal-to relation for natural numbers.+-}+data _≤_ : Nat → Nat → Type where+  z≤n : ∀ {n}                 → zero  ≤ n+  s≤s : ∀ {m n} (m≤n : m ≤ n) → suc m ≤ suc n++≤-refl : ∀ (x : Nat) → x ≤ x+≤-refl zero    = z≤n+≤-refl (suc x) = s≤s (≤-refl x)++≤-antisym : ∀ {x y : Nat}+  → x ≤ y+  → y ≤ x+    -----+  → x ≡ y+≤-antisym z≤n       z≤n       = refl+≤-antisym (s≤s x≤y) (s≤s y≤x) = cong suc (≤-antisym x≤y y≤x)++≤-trans : ∀ {x y z : Nat}+  → x ≤ y+  → y ≤ z+    -----+  → x ≤ z+≤-trans z≤n y≤z = z≤n+≤-trans (s≤s x≤y) (s≤s y≤z) = s≤s (≤-trans x≤y y≤z)++x≤x+1 : ∀ (x : Nat) → x ≤ suc x+x≤x+1 zero    = z≤n+x≤x+1 (suc x) = s≤s (x≤x+1 x)++x+[y-x]≡y : ∀ (x y : Nat) → x ≤ y → x + monusNat y x ≡ y+x+[y-x]≡y   zero       y       x≤y  = refl+x+[y-x]≡y (suc x) (suc y) (s≤s x≤y) = cong suc (x+[y-x]≡y x y x≤y)++y-x≤y : ∀ (x y : Nat) → monusNat y x ≤ y+y-x≤y zero         y  = ≤-refl y+y-x≤y (suc x)   zero  = z≤n+y-x≤y (suc x) (suc y) = ≤-trans (y-x≤y x y) (x≤x+1 y)
+ lib/base/Haskell/Law/Num.agda view
@@ -0,0 +1,7 @@+module Haskell.Law.Num where++open import Haskell.Law.Num.Def     public+open import Haskell.Law.Num.Int     public+open import Haskell.Law.Num.Integer public+open import Haskell.Law.Num.Nat     public+open import Haskell.Law.Num.Word    public
+ lib/base/Haskell/Law/Num/Def.agda view
@@ -0,0 +1,125 @@+module Haskell.Law.Num.Def where++open import Haskell.Prim+open import Haskell.Prim.Num+open import Haskell.Prim.Integer++record IsLawfulNum (a : Type) ⦃ iNum : Num a ⦄ : Type₁ where+  field+    +-assoc : ∀ (x y z : a) → (x + y) + z ≡ x + (y + z)++    +-comm : ∀ (x y : a) → x + y ≡ y + x++    +-idˡ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 0}}+      → fromInteger 0 + x ≡ x+    +-idʳ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 0}}+      → x + fromInteger 0 ≡ x++    neg-inv : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 0}} {{@0 _ : Num.NegateOK iNum x}}+      → x + negate x ≡ fromInteger 0++    *-assoc : ∀ (x y z : a) → (x * y) * z ≡ x * (y * z)++    *-idˡ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 1}}+      → fromInteger 1 * x ≡ x+    *-idʳ : ∀ (x : a) {{@0 _ : Num.FromIntegerOK iNum 1}}+      → x * fromInteger 1 ≡ x++    distributeˡ : ∀ (x y z : a) → x * (y + z) ≡ (x * y) + (x * z)+    distributeʳ : ∀ (x y z : a) → (y + z) * x ≡ (y * x) + (z * x)++    -- We are currently missing the following because toInteger is missing in our Prelude.+    -- "if the type also implements Integral, then fromInteger is a left inverse for toInteger, i.e. fromInteger (toInteger i) == i"+open IsLawfulNum ⦃ ... ⦄ public++open import Haskell.Law.Equality+open import Haskell.Law.Function++{-|+A number homomorphism establishes a homomorphism from one Num type a to another one b.+In particular, zero and one are mapped to zero and one in the other Num type,+and addition, multiplication, and negation are homorphic.+-}+record NumHomomorphism (a b : Type) ⦃ iNuma : Num a ⦄ ⦃ iNumb : Num b ⦄ (φ : a → b) : Type where+  0ᵃ = Num.fromInteger iNuma (pos 0)+  0ᵇ = Num.fromInteger iNumb (pos 0)+  1ᵃ = Num.fromInteger iNuma (pos 1)+  1ᵇ = Num.fromInteger iNumb (pos 1)++  field+    +-hom : Homomorphism₂ _+_ _+_ φ+    *-hom : Homomorphism₂ _*_ _*_ φ+    ⦃ minus-ok ⦄       : ∀ {x y : a}     → ⦃ MinusOK x y ⦄               → MinusOK (φ x) (φ y)+    ⦃ negate-ok ⦄      : ∀ {x   : a}     → ⦃ NegateOK x ⦄                → NegateOK (φ x)+    ⦃ fromInteger-ok ⦄ : ∀ {i : Integer} → ⦃ Num.FromIntegerOK iNuma i ⦄ → Num.FromIntegerOK iNumb i+    0-hom : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 0) ⦄ → φ 0ᵃ ≡ 0ᵇ+    1-hom : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 1) ⦄ → φ 1ᵃ ≡ 1ᵇ+    negate-hom : ∀ (x : a) → ⦃ @0 _ : Num.NegateOK iNuma x ⦄ → φ (negate x) ≡ negate (φ x) --Homomorphism₁ inlined for type instances++{-|+A number embedding is an invertible number homomorphism.+-}+record NumEmbedding (a b : Type) ⦃ iNuma : Num a ⦄ ⦃ iNumb : Num b ⦄ (φ : a → b) (φ⁻¹ : b → a) : Type where+  field+    hom   : NumHomomorphism a b φ+    embed : φ⁻¹ ∘ φ ≗ id++  open NumHomomorphism hom++  +-Embedding₂ : Embedding₂ _+_ _+_ φ φ⁻¹+  Embedding₂.hom   +-Embedding₂ = +-hom+  Embedding₂.embed +-Embedding₂ = embed++  *-Embedding₂ : Embedding₂ _*_ _*_ φ φ⁻¹+  Embedding₂.hom   *-Embedding₂ = *-hom+  Embedding₂.embed *-Embedding₂ = embed++  +-MonoidEmbedding₂ : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 0) ⦄ → MonoidEmbedding₂ _+_ _+_ φ φ⁻¹ 0ᵃ 0ᵇ+  MonoidEmbedding₂.embedding +-MonoidEmbedding₂ = +-Embedding₂+  MonoidEmbedding₂.0-hom     +-MonoidEmbedding₂ = 0-hom++  *-MonoidEmbedding₂ : ⦃ @0 _ : Num.FromIntegerOK iNuma (pos 1) ⦄ → MonoidEmbedding₂ _*_ _*_ φ φ⁻¹ 1ᵃ 1ᵇ+  MonoidEmbedding₂.embedding *-MonoidEmbedding₂ = *-Embedding₂+  MonoidEmbedding₂.0-hom     *-MonoidEmbedding₂ = 1-hom++{-|+Given an embedding from one number type a onto another one b,+we can conclude that b satisfies the laws of Num if a satisfies the+laws of Num.+-}+map-IsLawfulNum : ∀ {a b : Type} ⦃ iNuma : Num a ⦄ ⦃ iNumb : Num b ⦄+  → (a2b : a → b) (b2a : b → a)+  → NumEmbedding a b a2b b2a+  → IsLawfulNum b+    -----------------------+  → IsLawfulNum a+map-IsLawfulNum {a} {b} {{numa}} {{numb}} f g proj lawb =+  record+  { +-assoc = map-assoc _+ᵃ_ _+ᵇ_ f g +-Embedding₂ (+-assoc lawb)+  ; +-comm  = map-comm  _+ᵃ_ _+ᵇ_ f g +-Embedding₂ (+-comm lawb)+  ; +-idˡ = λ x → map-idˡ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ +-MonoidEmbedding₂ (λ y → +-idˡ lawb y) x+  ; +-idʳ = λ x → map-idʳ _+ᵃ_ _+ᵇ_ f g 0ᵃ 0ᵇ +-MonoidEmbedding₂ (λ y → +-idʳ lawb y) x+  ; neg-inv = map-neg-inv+  ; *-assoc = map-assoc _*ᵃ_ _*ᵇ_ f g *-Embedding₂ (*-assoc lawb)+  ; *-idˡ = λ x → map-idˡ _*ᵃ_ _*ᵇ_ f g 1ᵃ 1ᵇ *-MonoidEmbedding₂ (λ y → *-idˡ lawb y) x+  ; *-idʳ = λ x → map-idʳ _*ᵃ_ _*ᵇ_ f g 1ᵃ 1ᵇ *-MonoidEmbedding₂ (λ y → *-idʳ lawb y) x+  ; distributeˡ = map-distributeˡ _+ᵃ_ _+ᵇ_ _*ᵃ_ _*ᵇ_ f g embed +-hom *-hom (distributeˡ lawb)+  ; distributeʳ = map-distributeʳ _+ᵃ_ _+ᵇ_ _*ᵃ_ _*ᵇ_ f g embed +-hom *-hom (distributeʳ lawb)+  }+  where+    open NumEmbedding proj+    open NumHomomorphism hom+    open IsLawfulNum lawb+    open Num numa renaming (_+_ to _+ᵃ_; _*_ to _*ᵃ_; negate to negateᵃ)+    open Num numb renaming (_+_ to _+ᵇ_; _*_ to _*ᵇ_; negate to negateᵇ)++    map-neg-inv : ∀ (x : a) ⦃ @0 _ : Num.FromIntegerOK numa (pos 0) ⦄ ⦃ @0 _ : Num.NegateOK numa x ⦄+      → x +ᵃ negateᵃ x ≡ 0ᵃ+    map-neg-inv x =+      x +ᵃ negateᵃ x           ≡˘⟨ embed (x +ᵃ negateᵃ x) ⟩+      g (f (x +ᵃ negateᵃ x))   ≡⟨ cong g (+-hom x (negateᵃ x)) ⟩+      g (f x +ᵇ f (negateᵃ x)) ≡⟨ cong g (cong (f x +ᵇ_) (negate-hom x)) ⟩+      g (f x +ᵇ negateᵇ (f x)) ≡⟨ cong g (neg-inv lawb (f x)) ⟩+      g 0ᵇ                     ≡˘⟨ cong g 0-hom ⟩+      g (f 0ᵃ)                 ≡⟨ embed 0ᵃ ⟩+      0ᵃ ∎
+ lib/base/Haskell/Law/Num/Int.agda view
@@ -0,0 +1,27 @@+module Haskell.Law.Num.Int where++open import Haskell.Prim using (refl; tt)+open import Haskell.Prim.Num+open import Haskell.Prim.Int+open import Haskell.Prim.Word++open import Haskell.Law.Num.Def+open import Haskell.Law.Num.Word++instance+  open NumHomomorphism+  open NumEmbedding++  iNumEmbeddingIntWord : NumEmbedding Int Word intToWord int64+  +-hom          (hom iNumEmbeddingIntWord) (int64 _) (int64 _) = refl+  *-hom          (hom iNumEmbeddingIntWord) (int64 _) (int64 _) = refl+  minus-ok       (hom iNumEmbeddingIntWord) = tt+  negate-ok      (hom iNumEmbeddingIntWord) = tt+  fromInteger-ok (hom iNumEmbeddingIntWord) = tt+  0-hom          (hom iNumEmbeddingIntWord) = refl+  1-hom          (hom iNumEmbeddingIntWord) = refl+  negate-hom     (hom iNumEmbeddingIntWord) (int64 _) = refl+  embed               iNumEmbeddingIntWord  (int64 _) = refl++  iLawfulNumInt : IsLawfulNum Int+  iLawfulNumInt = map-IsLawfulNum intToWord int64 iNumEmbeddingIntWord iLawfulNumWord
+ lib/base/Haskell/Law/Num/Integer.agda view
@@ -0,0 +1,297 @@+module Haskell.Law.Num.Integer where++open import Haskell.Prim+open import Haskell.Prim.Num+open import Haskell.Prim.Integer++open import Haskell.Law.Equality+open import Haskell.Law.Num.Def+open import Haskell.Law.Num.Nat++-- Open the internal definitions because+-- these must be transparent for proofs.+open Haskell.Prim.Integer.Internal++addInteger-idˡ : ∀ (x : Integer) → 0 + x ≡ x+addInteger-idˡ (pos _)    = refl+addInteger-idˡ (negsuc _) = cong negsuc refl++addInteger-idʳ : ∀ (x : Integer) → x + 0 ≡ x+addInteger-idʳ (pos n)    = cong pos    $ addNat-idʳ n+addInteger-idʳ (negsuc _) = cong negsuc refl++mulInteger-idˡ : ∀ (x : Integer) → 1 * x ≡ x+mulInteger-idˡ (pos x)    = cong pos    (addNat-idʳ x)+mulInteger-idˡ (negsuc x) = cong negsuc (addNat-idʳ x)++mulInteger-idʳ : ∀ (x : Integer) → x * 1 ≡ x+mulInteger-idʳ (pos x)    = cong pos    (mulNat-idʳ x)+mulInteger-idʳ (negsuc x) = cong negsuc (mulNat-idʳ x)++subNat-refl : ∀ (x : Nat) → subNat x x ≡ 0+subNat-refl zero    = refl+subNat-refl (suc x) = subNat-refl x++n-n≡0-Nat : ∀ (x y : Nat) → subNat (x + y) x ≡ pos y+n-n≡0-Nat x       zero    rewrite addNat-idʳ x = subNat-refl x+n-n≡0-Nat zero    (suc _) = refl+n-n≡0-Nat (suc x) (suc y) = n-n≡0-Nat x (suc y)++n-n≡0-Integer : ∀ (x : Integer) → x + (negateInteger x) ≡ 0+n-n≡0-Integer (pos zero)    = refl+n-n≡0-Integer (pos (suc x)) = subNat-refl x+n-n≡0-Integer (negsuc x)    = subNat-refl x++mulInteger-zeroˡ : ∀ (x : Integer) → 0 * x ≡ 0+mulInteger-zeroˡ (pos _)    = refl+mulInteger-zeroˡ (negsuc _) = refl++mulInteger-zeroʳ : ∀ (x : Integer) → x * 0 ≡ 0+mulInteger-zeroʳ (pos n)    = cong pos (mulNat-zeroʳ n)+mulInteger-zeroʳ (negsuc n) rewrite mulNat-zeroʳ n = refl++addInteger-comm : ∀ (x y : Integer) → x + y ≡ y + x+addInteger-comm (pos x)    (pos y)    = cong pos (addNat-comm x y)+addInteger-comm (pos _)    (negsuc _) = refl+addInteger-comm (negsuc _) (pos _)    = refl+addInteger-comm (negsuc x) (negsuc y) = cong negsuc (cong suc (addNat-comm x y))++subNat|x-[y+z]≡x-y-z : ∀ (x y z : Nat) → subNat x (y + suc z) ≡ subNat x y + negsuc z+subNat|x-[y+z]≡x-y-z _       zero    _ = refl+subNat|x-[y+z]≡x-y-z zero    (suc y) z = cong negsuc (addNat-suc y z)+subNat|x-[y+z]≡x-y-z (suc x) (suc y) z = subNat|x-[y+z]≡x-y-z x y z++subNat|x-y+z≡[x+z]-y : ∀ (x y z : Nat) → subNat x y + pos (suc z) ≡ subNat (x + suc z) y+subNat|x-y+z≡[x+z]-y _       zero    _ = refl+subNat|x-y+z≡[x+z]-y zero    (suc _) _ = refl+subNat|x-y+z≡[x+z]-y (suc x) (suc y) z = subNat|x-y+z≡[x+z]-y x y z++subNat-cong-suc : ∀ (x y : Nat) → subNat (suc x) y ≡ pos 1 + subNat x y+subNat-cong-suc _       zero    = refl+subNat-cong-suc zero    (suc _) = refl+subNat-cong-suc (suc x) (suc y) = subNat-cong-suc x y++subNat|x+[y-z]≡[1+x]+[y-[1+z]] : ∀ (x y z : Nat) → pos x + subNat y z ≡ pos (suc x) + subNat y (suc z)+subNat|x+[y-z]≡[1+x]+[y-[1+z]] x zero    zero    = cong pos (addNat-idʳ x)+subNat|x+[y-z]≡[1+x]+[y-[1+z]] x (suc y) zero    = cong pos (addNat-suc x y)+subNat|x+[y-z]≡[1+x]+[y-[1+z]] _ zero    (suc _) = refl+subNat|x+[y-z]≡[1+x]+[y-[1+z]] x (suc y) (suc z) = subNat|x+[y-z]≡[1+x]+[y-[1+z]] x y z++subNat|x-y+[1+z]≡[1+x]+[z-y] : ∀ (x y z : Nat) → subNat x y + pos (suc z) ≡ pos (suc x) + subNat z y+subNat|x-y+[1+z]≡[1+x]+[z-y] x       zero    z    = cong pos (addNat-suc x z)+subNat|x-y+[1+z]≡[1+x]+[z-y] zero    (suc _) zero = refl+subNat|x-y+[1+z]≡[1+x]+[z-y] zero    (suc y) (suc z) = subNat-cong-suc z y+subNat|x-y+[1+z]≡[1+x]+[z-y] (suc x) (suc y) z       =+  subNat x y + pos (suc z)             ≡⟨ subNat|x-y+[1+z]≡[1+x]+[z-y] x y z ⟩+  pos (suc x)       + subNat z y       ≡⟨ subNat|x+[y-z]≡[1+x]+[y-[1+z]] (suc x) z y ⟩+  pos (suc (suc x)) + subNat z (suc y) ∎++subNat|[1+x+y]-z≡[1+x]+[y-z] : ∀ (x y z : Nat) → subNat (suc x + y) z ≡ pos (suc x) + subNat y z+subNat|[1+x+y]-z≡[1+x]+[y-z] _ _       zero    = refl+subNat|[1+x+y]-z≡[1+x]+[y-z] x zero    (suc z) = cong (λ eq → subNat eq z) (addNat-idʳ x)+subNat|[1+x+y]-z≡[1+x]+[y-z] x (suc y) (suc z) =+  subNat (x + suc y) z     ≡⟨ sym (subNat|x-y+z≡[x+z]-y x z y) ⟩+  subNat x z + pos (suc y) ≡⟨ subNat|x-y+[1+z]≡[1+x]+[z-y] x z y ⟩+  pos (suc x) + subNat y z ∎++subNat|x-y+[-[1+z]]≡x-z+[-[1+y]] : ∀ (x y z : Nat) → subNat x y + negsuc z ≡ subNat x z + negsuc y+subNat|x-y+[-[1+z]]≡x-z+[-[1+y]] x y z = begin+  subNat x y + negsuc z ≡⟨ sym (subNat|x-[y+z]≡x-y-z x y z) ⟩+  subNat x (y + suc z)  ≡⟨ cong (subNat x) (addNat-comm y (suc z)) ⟩+  subNat x (suc z + y)  ≡⟨ cong (subNat x) (sym (addNat-suc z y)) ⟩+  subNat x (z + suc y)  ≡⟨ subNat|x-[y+z]≡x-y-z x z y ⟩+  subNat x z + negsuc y ∎++subNat-cong-+ : ∀ (x y z : Nat) → subNat (x + y) (x + z) ≡ subNat y z+subNat-cong-+ x       y zero rewrite addNat-idʳ x = n-n≡0-Nat x y+subNat-cong-+ zero    _ (suc _) = refl+subNat-cong-+ (suc x) y (suc z) = subNat-cong-+ x y (suc z)++subNat-distrib-minus : ∀ (m n o : Nat) → subNat n o * pos m ≡ subNat (n * m) (o * m)+subNat-distrib-minus _       _       zero    = refl+subNat-distrib-minus zero    zero    (suc o) rewrite mulNat-zeroʳ o = refl+subNat-distrib-minus (suc _) zero    (suc _) = refl+subNat-distrib-minus zero    (suc n) (suc o) rewrite mulNat-zeroʳ o | mulInteger-zeroʳ (subNat n o) | mulNat-zeroʳ n = refl+subNat-distrib-minus (suc m) (suc n) (suc o) =+  subNat n o * (pos (suc m))                 ≡⟨ subNat-distrib-minus (suc m) n o ⟩+  subNat      (n * suc m)       (o * suc m)  ≡⟨ sym (subNat-cong-+ m (n * suc m) (o * suc m)) ⟩+  subNat (m + (n * suc m)) (m + (o * suc m)) ∎++subNat-mult-flip-negsuc : ∀ (m n o : Nat) → subNat o n * negsuc m ≡ subNat n o * pos (suc m)+subNat-mult-flip-negsuc _ zero    zero    = refl+subNat-mult-flip-negsuc _ zero    (suc _) = refl+subNat-mult-flip-negsuc _ (suc _) zero    = refl+subNat-mult-flip-negsuc m (suc n) (suc o) = subNat-mult-flip-negsuc m n o++subNat-distrib-minus-cong-+ : ∀ (m n o : Nat) → subNat o n * (pos (suc m)) ≡ subNat (m + (o * suc m)) (m + (n * suc m))+subNat-distrib-minus-cong-+ m n o = begin+  subNat o n * (pos (suc m))                 ≡⟨ subNat-distrib-minus (suc m) o n ⟩+  subNat (o * suc m) (n * suc m)             ≡⟨ sym (subNat-cong-+ m (o * suc m) (n * suc m)) ⟩+  subNat (m + (o * suc m)) (m + (n * suc m)) ∎+++addInteger-assoc : ∀ (x y z : Integer) → (x + y) + z ≡ x + (y + z)+addInteger-assoc (pos zero) j k rewrite addInteger-idˡ      j  | addInteger-idˡ (j + k) = refl+addInteger-assoc i (pos zero) k rewrite addInteger-idʳ  i      | addInteger-idˡ      k  = refl+addInteger-assoc i j (pos zero) rewrite addInteger-idʳ (i + j) | addInteger-idʳ  j      = refl+addInteger-assoc (negsuc m) (negsuc n) (pos (suc o)) =+  (negsuc m + negsuc n) + pos (suc o)       ≡⟨⟩+  negsuc (suc (m + n)) + pos (suc o)        ≡⟨⟩+  subNat o (suc m + n)                      ≡⟨ cong (subNat o) (addNat-comm (suc m) n) ⟩+  subNat o (n + suc m)                      ≡⟨ subNat|x-[y+z]≡x-y-z o n m ⟩+  subNat o n + negsuc m                     ≡⟨ addInteger-comm (subNat o n) (negsuc m) ⟩+  negsuc m + subNat o n                     ≡⟨⟩+  negsuc m + (negsuc n + pos (suc o))       ∎+addInteger-assoc (negsuc m) (pos (suc n)) (pos (suc o)) =+  (negsuc m + pos (suc n)) + pos (suc o)    ≡⟨⟩+  subNat n m + pos (suc o)                  ≡⟨ subNat|x-y+z≡[x+z]-y n m o ⟩+  subNat (n + suc o) m                      ≡⟨⟩+  negsuc m + pos (suc (n + suc o))          ≡⟨⟩+  negsuc m + (pos (suc n) + pos (suc o))    ∎+addInteger-assoc (pos (suc m)) (negsuc n) (negsuc o) =+  (pos (suc m) + negsuc n) + negsuc o       ≡⟨⟩+  subNat m n + negsuc o                     ≡⟨ sym $ subNat|x-[y+z]≡x-y-z m n o ⟩+  subNat m (n + suc o)                      ≡⟨ cong (subNat m) (addNat-suc n o) ⟩+  subNat m (suc (n + o))                    ≡⟨⟩+  pos (suc m) + (negsuc (suc (n + o)))      ≡⟨⟩+  pos (suc m) + (negsuc n + negsuc o)       ∎+addInteger-assoc (pos (suc m)) (negsuc n) (pos (suc o)) =+  (pos (suc m) + negsuc n) + pos (suc o)    ≡⟨⟩+  subNat m n + pos (suc o)                  ≡⟨ subNat|x-y+[1+z]≡[1+x]+[z-y] m n o ⟩+  pos (suc m) + subNat o n                  ≡⟨⟩+  pos (suc m) + (negsuc n + pos (suc o))    ∎+addInteger-assoc (pos (suc x)) (pos (suc y)) (negsuc z) = begin+  (pos (suc x) + pos (suc y)) + negsuc z    ≡⟨⟩+  pos (suc (x + (suc y))) + negsuc z        ≡⟨ cong (_+ negsuc z) (cong pos (cong suc (addNat-suc x y))) ⟩+  pos (suc (suc (x + y))) + negsuc z        ≡⟨⟩+  subNat (suc (x + y)) z                    ≡⟨⟩+  subNat (suc  x + y)  z                    ≡⟨ subNat|[1+x+y]-z≡[1+x]+[y-z] x y z ⟩+  pos (suc x) + subNat y z                  ≡⟨⟩+  pos (suc x) + (pos (suc y)   + negsuc z)  ∎+addInteger-assoc (negsuc m) (negsuc n) (negsuc o) = cong negsuc $ cong suc $+  suc ((m + n) + o)                         ≡⟨ cong suc (addNat-assoc m n o) ⟩+  suc (m + (n + o))                         ≡⟨ sym (addNat-suc m (n + o)) ⟩+  m + (suc (n + o))                         ∎+addInteger-assoc (negsuc m) (pos (suc n)) (negsuc o) =+  (negsuc m + pos (suc n)) + negsuc o       ≡⟨⟩+  subNat n m + negsuc o                     ≡⟨ subNat|x-y+[-[1+z]]≡x-z+[-[1+y]] n m o ⟩+  subNat n o + negsuc m                     ≡⟨ addInteger-comm (subNat n o) (negsuc m) ⟩+  negsuc m + subNat n o                     ≡⟨⟩+  negsuc m + (pos (suc n) - pos (suc o))    ∎+addInteger-assoc (pos (suc m)) (pos (suc n)) (pos (suc o)) = cong pos (addNat-assoc (suc m) (suc n) (suc o))++distribute-1ˡ : ∀ (x y : Nat) → x * (1 + y) ≡ x + (y * x)+distribute-1ˡ x y = begin+  x * (suc y) ≡⟨ mulNat-suc x y ⟩+  x + (x * y) ≡⟨ cong (x +_) (mulNat-comm x y) ⟩+  x + (y * x) ∎++mulInteger-comm : ∀ (x y : Integer) → x * y ≡ y * x+mulInteger-comm (pos x)    (pos y)    = cong pos (mulNat-comm x y)+mulInteger-comm (pos x)    (negsuc y) = cong negNat $       distribute-1ˡ x y+mulInteger-comm (negsuc x) (pos y)    = cong negNat $ sym $ distribute-1ˡ y x+mulInteger-comm (negsuc x) (negsuc y) = cong pos $ cong suc $+  y + (x * (suc y)) ≡⟨ cong (y +_) (distribute-1ˡ x y) ⟩+  y + (x + (y * x)) ≡⟨ cong (y +_) (cong (x +_) (mulNat-comm y x)) ⟩+  y + (x + (x * y)) ≡⟨ sym (addNat-assoc y x (x * y)) ⟩+  (y + x) + (x * y) ≡⟨ cong (_+ x * y) (addNat-comm y x) ⟩+  (x + y) + (x * y) ≡⟨ addNat-assoc x y (x * y) ⟩+  x + (y + (x * y)) ≡⟨ cong (x +_) (sym (distribute-1ˡ y x)) ⟩+  x + (y * (suc x)) ∎++distrib-lemma : ∀ (m n o : Nat) → suc (m + ((n + o) * suc m)) ≡ (n * suc m) + (suc (m + (o * suc m)))+distrib-lemma m n o =+  suc (m + ((n + o) * suc m))             ≡⟨ cong suc (cong (m +_) (mulNat-distributeʳ-addNat (suc m) n o)) ⟩+  suc (m + ((n * suc m)   + (o * suc m))) ≡⟨⟩+   suc m + ((n * suc m)   + (o * suc m))  ≡⟨ sym (addNat-assoc (suc m) (n * suc m) (o * suc m) ) ⟩+  (suc m +  (n * suc m))  + (o * suc m)   ≡⟨ cong (_+ o * suc m) (addNat-comm (suc m) (n * suc m)) ⟩+  ((n * suc m) +  suc  m) + (o * suc m)   ≡⟨ addNat-assoc (n * suc m) (suc m) (o * suc m) ⟩+   (n * suc m) + (suc (m  + (o * suc m))) ∎++distrib-lemma2 : ∀ (m n o : Nat) → m + ((n * suc m) + (suc m + (o * suc m))) ≡ suc ((m + (n * suc m)) + (m + (o * suc m)))+distrib-lemma2 m n o =+   m + (    (n * suc m) + (suc  m + (o * suc m))) ≡⟨⟩+   m + (    (n * suc m) +  suc (m + (o * suc m))) ≡⟨ sym (addNat-assoc m (n * suc m) (suc (m + (o * suc m)))) ⟩+  (m +      (n * suc m)) + suc (m + (o * suc m))  ≡⟨ addNat-suc (m + (n * suc m)) (m + (o * suc m)) ⟩+  suc ((m + (n * suc m)) +     (m + (o * suc m))) ∎++mulInteger-distributeʳ-addInteger : ∀ (x y z : Integer) → (y + z) * x ≡ (y * x) + (z * x)+mulInteger-distributeʳ-addInteger (pos zero) j k rewrite mulInteger-zeroʳ j | mulInteger-zeroʳ k | mulInteger-zeroʳ (j + k) = refl+mulInteger-distributeʳ-addInteger i (pos zero) k rewrite addInteger-idˡ k   | mulInteger-zeroˡ i | addInteger-idˡ   (k * i) = refl+mulInteger-distributeʳ-addInteger i j (pos zero) rewrite addInteger-idʳ j   | mulInteger-zeroˡ i | addInteger-idʳ   (j * i) = refl+mulInteger-distributeʳ-addInteger (negsuc m)    (negsuc n)    (pos (suc o)) = begin+  subNat o n * negsuc m                      ≡⟨ subNat-mult-flip-negsuc m n o ⟩+  subNat n o * pos (suc m)                   ≡⟨ subNat-distrib-minus-cong-+ m o n ⟩+  subNat (m + (n * suc m)) (m + (o * suc m)) ∎+mulInteger-distributeʳ-addInteger (negsuc m)    (pos (suc n)) (pos (suc o)) = cong negsuc $ begin+  m + ((n + suc o) * suc m)                       ≡⟨ cong (m +_) (mulNat-distributeʳ-addNat (suc m) n (suc o)) ⟩+  m + (     (n * suc m) + (suc m + (o * suc m)))  ≡⟨ distrib-lemma2 m n o ⟩+  suc ((m + (n * suc m)) +     (m + (o * suc m))) ∎ -- Y+mulInteger-distributeʳ-addInteger (pos (suc m)) (negsuc n)    (negsuc o)    = cong negsuc $ begin+  m + (suc (m + ((n + o) * suc m)))               ≡⟨⟩+  m + (suc m  + ((n + o) * suc m))                ≡⟨ cong (m +_) (distrib-lemma m n o) ⟩+  m + (     (n * suc m) + (suc m + (o * suc m)))  ≡⟨ distrib-lemma2 m n o ⟩+  suc ((m + (n * suc m)) + (m + (o * suc m)))     ∎ -- Y+mulInteger-distributeʳ-addInteger (pos (suc m)) (negsuc n)    (pos (suc o)) = subNat-distrib-minus-cong-+ m n o+mulInteger-distributeʳ-addInteger (pos (suc m)) (pos (suc n)) (negsuc o)    = subNat-distrib-minus-cong-+ m o n+mulInteger-distributeʳ-addInteger (negsuc m)    (negsuc n)    (negsuc o)    = cong pos $ cong suc $+  m + (suc (m + ((n + o) * suc m)))           ≡⟨⟩+  m + (suc m  + ((n + o) * suc m))            ≡⟨ cong (m +_) (distrib-lemma m n o) ⟩+  m + ((n * suc m) + (suc m  + (o * suc m)))  ≡⟨ sym (addNat-assoc m (n * suc m) (suc m + (o * suc m))) ⟩+  (m + (n * suc m)) + (suc (m + (o * suc m))) ∎ -- X+mulInteger-distributeʳ-addInteger (negsuc m)    (pos (suc n)) (negsuc o)    =+  subNat n o * negsuc m                      ≡⟨ subNat-mult-flip-negsuc m o n ⟩+  subNat o n * pos (suc m)                   ≡⟨ subNat-distrib-minus-cong-+ m n o ⟩+  subNat (m + (o * suc m)) (m + (n * suc m)) ∎+mulInteger-distributeʳ-addInteger (pos (suc m)) (pos (suc n)) (pos (suc o)) = cong pos $ cong suc $+  m + ((n + suc o) * suc m)                   ≡⟨ cong (m +_) (mulNat-distributeʳ-addNat (suc m) n (suc o)) ⟩+  m + ((n * suc m) + (suc m  + (o * suc m)))  ≡⟨ sym (addNat-assoc m (n * suc m) (suc m + (o * suc m))) ⟩+  (m + (n * suc m)) + (suc m  + (o * suc m))  ≡⟨⟩+  (m + (n * suc m)) + (suc (m + (o * suc m))) ∎ -- X++mulInteger-distributeˡ-addInteger : ∀ (x y z : Integer) → x * (y + z) ≡ (x * y) + (x * z)+mulInteger-distributeˡ-addInteger x y z+  -- This proof works the very same as addNat-distributeˡ-mulNat.+  rewrite (mulInteger-comm x (y + z)) -- makes or goal become: (y + z) * x ≡ (x * y) + (x * z)+  rewrite (mulInteger-comm x y)       -- makes or goal become: (y + z) * x ≡ (y * x) + (x * z)+  rewrite (mulInteger-comm x z)       -- makes or goal become: (y + z) * x ≡ (y * x) + (z * x)+  = mulInteger-distributeʳ-addInteger x y z++mulInteger-assoc-lemma-2 : ∀ (m n o : Nat) → (n + m * suc n) * suc o ≡ (n * suc o) + (m * suc (o + (n * suc o)))+mulInteger-assoc-lemma-2 m n o =            begin+  (n + (m * suc n)) * (suc o)               ≡⟨ mulNat-distributeʳ-addNat (suc o) n (m * suc n) ⟩+  (n * (suc o)) + ((m * suc n) * (suc o))   ≡⟨ cong (n * suc o +_) (mulNat-assoc m (suc n) (suc o)) ⟩+  (n * suc o) + (m * suc (o + (n * suc o))) ∎++mulInteger-assoc-lemma : ∀ (m n o : Nat)+  → o + ((n + m * suc n) * suc o) ≡ (o + (n * suc o)) + (m * suc (o + (n * suc o)))+mulInteger-assoc-lemma m n o =                      begin+    o + ((n + m * suc n) * suc o)                   ≡⟨ cong (o +_) (mulInteger-assoc-lemma-2 m n o) ⟩+    o + ((n * suc o) + (m * suc (o + (n * suc o)))) ≡⟨ sym (addNat-assoc o (n * suc o) (m * suc (o + (n * suc o)))) ⟩+    (o + (n * suc o)) + (m * suc (o + (n * suc o))) ∎++mulInteger-assoc : ∀ (x y z : Integer) → (x * y) * z ≡ x * (y * z)+mulInteger-assoc (pos zero) j k rewrite mulInteger-zeroˡ j | mulInteger-zeroˡ k | mulInteger-zeroˡ (j * k) = refl+mulInteger-assoc i (pos zero) k rewrite mulInteger-zeroʳ i | mulInteger-zeroˡ k | mulInteger-zeroʳ i       = refl+mulInteger-assoc i j (pos zero) rewrite mulInteger-zeroʳ j | mulInteger-zeroʳ i | mulInteger-zeroʳ (i * j) = refl+mulInteger-assoc (negsuc m)    (negsuc n)    (pos (suc o)) = cong pos (cong suc (mulInteger-assoc-lemma m n o))+mulInteger-assoc (negsuc m)    (pos (suc n)) (pos (suc o)) = cong negsuc        (mulInteger-assoc-lemma m n o)+mulInteger-assoc (pos (suc m)) (negsuc n)    (negsuc o)    = cong pos (cong suc (mulInteger-assoc-lemma m n o))+mulInteger-assoc (pos (suc m)) (negsuc n)    (pos (suc o)) = cong negsuc        (mulInteger-assoc-lemma m n o)+mulInteger-assoc (pos (suc m)) (pos (suc n)) (negsuc o)    = cong negsuc        (mulInteger-assoc-lemma m n o)+mulInteger-assoc (negsuc m)    (negsuc n)    (negsuc o)    = cong negsuc        (mulInteger-assoc-lemma m n o)+mulInteger-assoc (negsuc m)    (pos (suc n)) (negsuc o)    = cong pos (cong suc (mulInteger-assoc-lemma m n o))+mulInteger-assoc (pos (suc m)) (pos (suc n)) (pos (suc o)) = cong pos (cong suc (mulInteger-assoc-lemma m n o))++instance+  iLawfulNumInteger : IsLawfulNum Integer+  iLawfulNumInteger .IsLawfulNum.+-assoc = addInteger-assoc+  iLawfulNumInteger .IsLawfulNum.+-comm = addInteger-comm+  iLawfulNumInteger .IsLawfulNum.+-idˡ x = addInteger-idˡ x+  iLawfulNumInteger .IsLawfulNum.+-idʳ x = addInteger-idʳ x+  iLawfulNumInteger .IsLawfulNum.neg-inv x = n-n≡0-Integer x+  iLawfulNumInteger .IsLawfulNum.*-assoc = mulInteger-assoc +  iLawfulNumInteger .IsLawfulNum.*-idˡ x = mulInteger-idˡ x+  iLawfulNumInteger .IsLawfulNum.*-idʳ x = mulInteger-idʳ x+  iLawfulNumInteger .IsLawfulNum.distributeˡ = mulInteger-distributeˡ-addInteger+  iLawfulNumInteger .IsLawfulNum.distributeʳ = mulInteger-distributeʳ-addInteger
+ lib/base/Haskell/Law/Num/Nat.agda view
@@ -0,0 +1,103 @@+module Haskell.Law.Num.Nat where++open import Haskell.Prim+open import Haskell.Prim.Num++open import Haskell.Law.Equality+open import Haskell.Law.Num.Def++addNat-suc : ∀ m n → m + suc n ≡ suc (m + n)+addNat-suc zero    n = refl+addNat-suc (suc m) n = cong suc (addNat-suc m n)++addNat-idˡ : ∀ (x : Nat) → 0 + x ≡ x+addNat-idˡ _ = refl++addNat-idʳ : ∀ (x : Nat) → x + 0 ≡ x+addNat-idʳ zero    = refl+addNat-idʳ (suc x) = cong suc (addNat-idʳ x)++addNat-comm : ∀ (x y : Nat) → x + y ≡ y + x+addNat-comm zero    y = sym (addNat-idʳ y)+addNat-comm (suc x) y = begin+  suc (x + y) ≡⟨ cong suc (addNat-comm x y) ⟩+  suc (y + x) ≡⟨ sym (addNat-suc y x) ⟩+  y + suc x   ∎++addNat-assoc : ∀ (x y z : Nat) → (x + y) + z ≡ x + (y + z)+addNat-assoc zero    _ _ = refl+addNat-assoc (suc m) n o = cong suc (addNat-assoc m n o)++mulNat-suc : ∀ (m n : Nat) → m * suc n ≡ m + m * n+mulNat-suc zero    n = refl+mulNat-suc (suc m) n = begin+  suc m * suc n         ≡⟨⟩+  suc n + m * suc n     ≡⟨ cong (suc n +_) (mulNat-suc m n) ⟩+  suc n + (m + m * n)   ≡⟨⟩+  suc (n + (m + m * n)) ≡⟨ cong suc (sym (addNat-assoc n m (m * n))) ⟩+  suc (n + m + m * n)   ≡⟨ cong (λ x → suc (x + m * n)) (addNat-comm n m) ⟩+  suc (m + n + m * n)   ≡⟨ cong suc (addNat-assoc m n (m * n)) ⟩+  suc (m + (n + m * n)) ≡⟨⟩+  suc m + suc m * n     ∎++mulNat-idˡ : ∀ (x : Nat) → 1 * x ≡ x+mulNat-idˡ = addNat-idʳ++mulNat-idʳ : ∀ (x : Nat) → x * 1 ≡ x+mulNat-idʳ zero    = refl+mulNat-idʳ (suc x) = cong suc (mulNat-idʳ x)++mulNat-zeroˡ : ∀ (x : Nat) → 0 * x ≡ 0+mulNat-zeroˡ _ = refl++mulNat-zeroʳ : ∀ (x : Nat) → x * 0 ≡ 0+mulNat-zeroʳ zero    = refl+mulNat-zeroʳ (suc x) = mulNat-zeroʳ x++mulNat-comm : ∀ (x y : Nat) → x * y ≡ y * x+mulNat-comm zero y    = sym (mulNat-zeroʳ y)+mulNat-comm (suc x) y = begin+  suc x * y  ≡⟨⟩+  y + x * y  ≡⟨ cong (y +_) (mulNat-comm x y) ⟩+  y + y * x  ≡⟨ sym (mulNat-suc y x) ⟩+  y * suc x  ∎++mulNat-distributeʳ-addNat : ∀ (x y z : Nat) → (y + z) * x ≡ (y * x) + (z * x)+mulNat-distributeʳ-addNat _ zero    _ = refl+mulNat-distributeʳ-addNat x (suc y) z = begin+  (suc y + z) * x     ≡⟨⟩+  x + (y + z) * x     ≡⟨ cong (x +_) (mulNat-distributeʳ-addNat x y z) ⟩+  x + (y * x + z * x) ≡⟨ sym (addNat-assoc x (y * x) (z * x)) ⟩+  x + y * x + z * x   ≡⟨⟩+  suc y * x + z * x   ∎++mulNat-distributeˡ-addNat : ∀ (x y z : Nat) → x * (y + z) ≡ (x * y) + (x * z)+mulNat-distributeˡ-addNat x y z+  -- This proof transform left distribution to right distribution by using commutativity of *.+  --                                 the initial goal is:  x * (y + z) ≡ (x * y) + (x * z)+  rewrite (mulNat-comm x (y + z)) -- makes or goal become: (y + z) * x ≡ (x * y) + (x * z)+  rewrite (mulNat-comm x y)       -- makes or goal become: (y + z) * x ≡ (y * x) + (x * z)+  rewrite (mulNat-comm x z)       -- makes or goal become: (y + z) * x ≡ (y * x) + (z * x)+  = mulNat-distributeʳ-addNat x y z++mulNat-assoc : ∀ (x y z : Nat) → (x * y) * z ≡ x * (y * z)+mulNat-assoc zero    _ _ = refl+mulNat-assoc (suc x) y z = begin+  (suc x * y) * z     ≡⟨⟩+  (y + x * y) * z     ≡⟨ mulNat-distributeʳ-addNat z y (x * y) ⟩+  y * z + (x * y) * z ≡⟨ cong (y * z +_) (mulNat-assoc x y z) ⟩+  y * z + x * (y * z) ≡⟨⟩+  suc x * (y * z)     ∎++instance+  iLawfulNumNat : IsLawfulNum Nat+  iLawfulNumNat .IsLawfulNum.+-assoc      = addNat-assoc+  iLawfulNumNat .IsLawfulNum.+-comm       = addNat-comm+  iLawfulNumNat .IsLawfulNum.+-idˡ x      = addNat-idˡ x+  iLawfulNumNat .IsLawfulNum.+-idʳ x      = addNat-idʳ x+  iLawfulNumNat .IsLawfulNum.neg-inv zero = refl -- inline this proof because it has not much use anyway I guess?+  iLawfulNumNat .IsLawfulNum.*-assoc      = mulNat-assoc+  iLawfulNumNat .IsLawfulNum.*-idˡ x      = mulNat-idˡ x+  iLawfulNumNat .IsLawfulNum.*-idʳ x      = mulNat-idʳ x+  iLawfulNumNat .IsLawfulNum.distributeˡ  = mulNat-distributeˡ-addNat+  iLawfulNumNat .IsLawfulNum.distributeʳ  = mulNat-distributeʳ-addNat
+ lib/base/Haskell/Law/Num/Word.agda view
@@ -0,0 +1,106 @@+{-# OPTIONS --allow-unsolved-metas #-}+module Haskell.Law.Num.Word where++open import Haskell.Prim+open import Haskell.Prim.Num+open import Haskell.Prim.Word+open Haskell.Prim.Word.WordInternal++open import Haskell.Law.Equality+open import Haskell.Law.Function+open import Haskell.Law.Nat++open import Haskell.Law.Num.Def+open import Haskell.Law.Num.Nat++open Num iNumNat  renaming (_+_ to _+ⁿ_; _*_ to _*ⁿ_)+open Num iNumWord renaming (_+_ to _+ʷ_; _*_ to _*ʷ_)++postulate+  -- This is a reasonable axiom because there are more natural numbers than+  -- integer. More precisely, Words denote a finite subset of Integers.+  -- This means, there is am embedding of Words into Integers as stated by+  -- this axiom.+  n2w∘w2n≡id : ∀ (x : Word)           → n2w (w2n x) ≡ x++  -- Conversion of natural numbers to words is invertible as long as the+  -- natural is within word bounds.+  w2n∘n2w≡id : ∀ (x : Nat)  → x ≤ 2⁶⁴ → w2n (n2w x) ≡ x++  -- Definitions of word arithmetics are based on conversions to Nats.+  -- That conversion must be homomorphic w.r.t. to addition and multiplication+  -- to not break their properties.+  w2n-+-hom : Homomorphism₂ _+ʷ_ _+ⁿ_ w2n+  w2n-*-hom : Homomorphism₂ _*ʷ_ _*ⁿ_ w2n++  -- 2⁶⁴ is the upper bound of the ring that forms Words in Nats.+  max-int≡0 : n2w 2⁶⁴ ≡ 0++  -- Words are bounded. They can never be larger than 2⁶⁴.+  bounded : ∀ (x : Word) → w2n x ≤ 2⁶⁴++open MonoidEmbedding₂+++-wordsAsNats : MonoidEmbedding₂ addWord addNat w2n n2w 0 0+Embedding₂.hom   (embedding +-wordsAsNats) = w2n-+-hom+Embedding₂.embed (embedding +-wordsAsNats) = n2w∘w2n≡id+0-hom +-wordsAsNats = refl++*-wordsAsNats : MonoidEmbedding₂ mulWord mulNat w2n n2w 1 1+Embedding₂.hom   (embedding *-wordsAsNats) = w2n-*-hom+Embedding₂.embed (embedding *-wordsAsNats) = n2w∘w2n≡id+0-hom *-wordsAsNats = refl++addWord-idˡ : Identityˡ addWord 0+addWord-idˡ = map-idˡ addWord addNat w2n n2w 0 0 +-wordsAsNats addNat-idˡ++addWord-idʳ : Identityʳ addWord 0+addWord-idʳ = map-idʳ addWord addNat w2n n2w 0 0 +-wordsAsNats addNat-idʳ++addWord-comm : Commutative addWord+addWord-comm = map-comm addWord addNat w2n n2w (embedding +-wordsAsNats) addNat-comm++addWord-assoc : Associative addWord+addWord-assoc = map-assoc addWord addNat w2n n2w (embedding +-wordsAsNats) addNat-assoc ++mulWord-comm : Commutative mulWord+mulWord-comm = map-comm mulWord mulNat w2n n2w (embedding *-wordsAsNats) mulNat-comm++mulWord-assoc : Associative mulWord+mulWord-assoc = map-assoc mulWord mulNat w2n n2w (embedding *-wordsAsNats) mulNat-assoc++mulWord-idˡ : Identityˡ mulWord 1+mulWord-idˡ = map-idˡ mulWord mulNat w2n n2w 1 1 *-wordsAsNats mulNat-idˡ++mulWord-idʳ : Identityʳ mulWord 1+mulWord-idʳ = map-idʳ mulWord mulNat w2n n2w 1 1 *-wordsAsNats mulNat-idʳ++mulWord-distributeˡ-addWord : Distributiveˡ addWord mulWord+mulWord-distributeˡ-addWord = map-distributeˡ addWord addNat mulWord mulNat w2n n2w n2w∘w2n≡id w2n-+-hom w2n-*-hom mulNat-distributeˡ-addNat++mulWord-distributeʳ-addWord : Distributiveʳ addWord mulWord+mulWord-distributeʳ-addWord = map-distributeʳ addWord addNat mulWord mulNat w2n n2w n2w∘w2n≡id w2n-+-hom w2n-*-hom mulNat-distributeʳ-addNat++neg-inv-word : ∀ (x : Word) → addWord x (negateWord x) ≡ 0+neg-inv-word x =+  x + negateWord x                               ≡⟨⟩+  n2w (w2n x + w2n (negateWord x))               ≡⟨⟩+  n2w (w2n x + w2n (n2w (monusNat 2⁶⁴ (w2n x)))) ≡⟨ cong n2w (cong (w2n x +_) (w2n∘n2w≡id (monusNat 2⁶⁴ (w2n x)) (y-x≤y (w2n x) 2⁶⁴))) ⟩+  n2w (w2n x + monusNat 2⁶⁴ (w2n x))             ≡⟨ cong n2w (x+[y-x]≡y (w2n x) 2⁶⁴ (bounded x)) ⟩+  n2w 2⁶⁴                                        ≡⟨ max-int≡0 ⟩+  0                                              ∎++instance+  open IsLawfulNum++  iLawfulNumWord : IsLawfulNum Word+  +-assoc iLawfulNumWord = addWord-assoc+  +-comm iLawfulNumWord = addWord-comm+  +-idˡ iLawfulNumWord = λ x → addWord-idˡ x+  +-idʳ iLawfulNumWord = λ x → addWord-idʳ x+  neg-inv iLawfulNumWord = λ x → neg-inv-word x+  *-assoc iLawfulNumWord = mulWord-assoc+  *-idˡ iLawfulNumWord = λ x → mulWord-idˡ x+  *-idʳ iLawfulNumWord = λ x → mulWord-idʳ x+  distributeˡ iLawfulNumWord = mulWord-distributeˡ-addWord+  distributeʳ iLawfulNumWord = mulWord-distributeʳ-addWord
+ lib/base/Haskell/Law/Ord.agda view
@@ -0,0 +1,6 @@+module Haskell.Law.Ord where++open import Haskell.Law.Ord.Def      public+open import Haskell.Law.Ord.Bool     public+open import Haskell.Law.Ord.Maybe    public+open import Haskell.Law.Ord.Ordering public
+ lib/base/Haskell/Law/Ord/Bool.agda view
@@ -0,0 +1,68 @@+module Haskell.Law.Ord.Bool where++open import Haskell.Prim+open import Haskell.Prim.Ord++open import Haskell.Law.Eq+open import Haskell.Law.Equality+open import Haskell.Law.Ord.Def++instance+  iLawfulOrdBool : IsLawfulOrd Bool++  iLawfulOrdBool .comparability False False = refl+  iLawfulOrdBool .comparability False True  = refl+  iLawfulOrdBool .comparability True  False = refl+  iLawfulOrdBool .comparability True  True  = refl++  iLawfulOrdBool .transitivity False False False _ = refl+  iLawfulOrdBool .transitivity False False True  _ = refl+  iLawfulOrdBool .transitivity False True  True  _ = refl+  iLawfulOrdBool .transitivity True  True  True  _ = refl++  iLawfulOrdBool .reflexivity False = refl+  iLawfulOrdBool .reflexivity True  = refl++  iLawfulOrdBool .antisymmetry False False _ = refl+  iLawfulOrdBool .antisymmetry True  True  _ = refl++  iLawfulOrdBool .lte2gte False False = refl+  iLawfulOrdBool .lte2gte False True  = refl+  iLawfulOrdBool .lte2gte True  False = refl+  iLawfulOrdBool .lte2gte True  True  = refl++  iLawfulOrdBool .lt2LteNeq False False = refl+  iLawfulOrdBool .lt2LteNeq False True  = refl+  iLawfulOrdBool .lt2LteNeq True  False = refl+  iLawfulOrdBool .lt2LteNeq True  True  = refl++  iLawfulOrdBool .lt2gt False False = refl+  iLawfulOrdBool .lt2gt False True  = refl+  iLawfulOrdBool .lt2gt True  False = refl+  iLawfulOrdBool .lt2gt True  True  = refl++  iLawfulOrdBool .compareLt False False = refl+  iLawfulOrdBool .compareLt False True  = refl+  iLawfulOrdBool .compareLt True  False = refl+  iLawfulOrdBool .compareLt True  True  = refl++  iLawfulOrdBool .compareGt False False = refl+  iLawfulOrdBool .compareGt False True  = refl+  iLawfulOrdBool .compareGt True  False = refl+  iLawfulOrdBool .compareGt True  True  = refl++  iLawfulOrdBool .compareEq False False = refl+  iLawfulOrdBool .compareEq False True  = refl+  iLawfulOrdBool .compareEq True  False = refl+  iLawfulOrdBool .compareEq True  True  = refl++  iLawfulOrdBool .min2if False False = refl+  iLawfulOrdBool .min2if False True  = refl+  iLawfulOrdBool .min2if True  False = refl+  iLawfulOrdBool .min2if True  True  = refl++  iLawfulOrdBool .max2if False False = refl+  iLawfulOrdBool .max2if False True  = refl+  iLawfulOrdBool .max2if True  False = refl+  iLawfulOrdBool .max2if True  True  = refl+
+ lib/base/Haskell/Law/Ord/Def.agda view
@@ -0,0 +1,203 @@+module Haskell.Law.Ord.Def where++open import Haskell.Prim+open import Haskell.Prim.Ord+open import Haskell.Prim.Bool+open import Haskell.Prim.Int+open import Haskell.Prim.Word+open import Haskell.Prim.Integer+open import Haskell.Prim.Double+open import Haskell.Prim.Tuple+open import Haskell.Prim.Monoid+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Either++open import Haskell.Prim.Eq+open import Haskell.Law.Eq++open import Haskell.Law.Bool+open import Haskell.Law.Equality++record IsLawfulOrd (a : Type) ⦃ iOrd : Ord a ⦄ : Type₁ where+  field+    overlap ⦃ super ⦄ : IsLawfulEq a++    -- Comparability: x <= y || y <= x = True+    comparability : ∀ (x y : a) → (x <= y || y <= x) ≡ True++    -- Transitivity: if x <= y && y <= z = True, then x <= z = True+    transitivity :  ∀ ( x y z : a ) → ((x <= y) && (y <= z)) ≡ True → (x <= z) ≡ True++    -- Reflexivity: x <= x = True+    reflexivity : ∀ (x : a) → (x <= x) ≡ True++    -- Antisymmetry: if x <= y && y <= x = True, then x == y = True+    antisymmetry : ∀ (x y : a) → ((x <= y) && (y <= x)) ≡ True → (x == y) ≡ True++    -- x >= y = y <= x+    lte2gte : ∀ (x y : a) → (x <= y) ≡ (y >= x)++    -- x < y = x <= y && x /= y+    lt2LteNeq : ∀ (x y : a) → (x < y) ≡ (x <= y && x /= y)++    -- x > y = y < x+    lt2gt : ∀ (x y : a) → (x < y) ≡ (y > x)++    -- x < y = compare x y == LT+    compareLt : ∀ (x y : a) → (x < y) ≡ (compare x y == LT)++    -- x > y = compare x y == GT+    compareGt : ∀ (x y : a) → (x > y) ≡ (compare x y == GT)++    -- x == y = compare x y == EQ+    compareEq : ∀ (x y : a) → (x == y) ≡ (compare x y == EQ)++    -- min x y == if x <= y then x else y = True+    min2if : ∀ (x y : a) → ((min x y) == (if (x <= y) then x else y)) ≡ True++    -- max x y == if x >= y then x else y = True+    max2if : ∀ (x y : a) → ((max x y) == (if (x >= y) then x else y)) ≡ True++open IsLawfulOrd ⦃ ... ⦄ public++--------------------------------------------------+-- Some more helper laws++eq2nlt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x == y) ≡ True → (x < y) ≡ False+eq2nlt x y h+  rewrite compareEq x y+    | compareLt x y+    | equality (compare x y) EQ h+  = refl++eq2ngt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x == y) ≡ True → (x > y) ≡ False+eq2ngt x y h+  rewrite compareEq x y+    | compareGt x y+    | equality (compare x y) EQ h+  = refl++lte2LtEq : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x <= y) ≡ (x < y || x == y)+lte2LtEq x y +  rewrite lt2LteNeq x y+    | compareEq x y+  with (x <= y) in h₁ | (compare x y) in h₂+... | False | LT = refl+... | False | EQ = magic $ exFalso (reflexivity x) $ begin +    (x <= x)  ≡⟨ (cong (x <=_) (equality x y (begin +      (x == y)            ≡⟨ compareEq x y ⟩ +      (compare x y == EQ) ≡⟨ equality' (compare x y) EQ h₂ ⟩ +      True                ∎ ) ) ) ⟩+    (x <= y)  ≡⟨ h₁ ⟩ +    False ∎+... | False | GT = refl+... | True  | LT = refl+... | True  | EQ = refl+... | True  | GT = refl++gte2GtEq : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x >= y) ≡ (x > y || x == y)+gte2GtEq x y+  rewrite sym $ lte2gte y x+    | lte2LtEq y x+    | eqSymmetry y x+    | lt2gt y x+  = refl++gte2nlt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x >= y) ≡ not (x < y)+gte2nlt x y+  rewrite gte2GtEq x y+    | compareGt x y+    | compareEq x y+    | compareLt x y+  with compare x y+... | GT = refl +... | EQ = refl +... | LT = refl ++gte2nLT : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x >= y) ≡ (compare x y /= LT)+gte2nLT x y+  rewrite gte2nlt x y+    | compareLt x y+  = refl++lte2ngt : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x <= y) ≡ not (x > y)+lte2ngt x y+  rewrite lte2LtEq x y+    | compareLt x y+    | compareEq x y+    | compareGt x y+  with compare x y+... | GT = refl +... | EQ = refl +... | LT = refl ++lte2nGT : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x <= y) ≡ (compare x y /= GT)+lte2nGT x y+  rewrite lte2ngt x y+    | compareGt x y+  = refl++eq2lte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x == y) ≡ True → (x <= y) ≡ True+eq2lte x y h+  rewrite lte2ngt x y+    | eq2ngt x y h+  = refl++lt2lte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x < y) ≡ True → (x <= y) ≡ True+lt2lte x y h = &&-rightTrue' (x < y) (x <= y) (x /= y) (lt2LteNeq x y) h++eq2gte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x == y) ≡ True → (x >= y) ≡ True+eq2gte x y h+  rewrite gte2nlt x y+    | eq2nlt x y h+  = refl++gt2gte : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : a) → (x > y) ≡ True → (x >= y) ≡ True+gt2gte x y h+  rewrite sym (lt2gt y x)+    | sym (lt2lte y x h)+    | lte2gte y x+  = refl++--------------------------------------------------+-- Postulated instances++postulate instance+  iLawfulOrdNat : IsLawfulOrd Nat++  iLawfulOrdInteger : IsLawfulOrd Integer++  iLawfulOrdInt : IsLawfulOrd Int++  iLawfulOrdWord : IsLawfulOrd Word++  iLawfulOrdDouble : IsLawfulOrd Double++  iLawfulOrdChar : IsLawfulOrd Char++  iLawfulOrdUnit : IsLawfulOrd ⊤++  iLawfulOrdTuple₂ : ⦃ iOrdA : Ord a ⦄ ⦃ iOrdB : Ord b ⦄+                   → ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄+                   → IsLawfulOrd (a × b)++  iLawfulOrdTuple₃ : ⦃ iOrdA : Ord a ⦄ ⦃ iOrdB : Ord b ⦄ ⦃ iOrdC : Ord c ⦄+                   → ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄ → ⦃ IsLawfulOrd c ⦄+                   → IsLawfulOrd (a × b × c)++  iLawfulOrdList : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄ → IsLawfulOrd (List a)++  iLawfulOrdEither : ⦃ iOrdA : Ord a ⦄ → ⦃ iOrdB : Ord b ⦄ →  ⦃ IsLawfulOrd a ⦄ → ⦃ IsLawfulOrd b ⦄ → IsLawfulOrd (Either a b)
+ lib/base/Haskell/Law/Ord/Maybe.agda view
@@ -0,0 +1,150 @@+module Haskell.Law.Ord.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.Eq+open import Haskell.Prim.Maybe+open import Haskell.Prim.Ord++open import Haskell.Law.Bool+open import Haskell.Law.Eq+open import Haskell.Law.Equality hiding ( trustMe )+open import Haskell.Law.Maybe+open import Haskell.Law.Ord.Def++compMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x <= y || y <= x) ≡ True+compMaybe Nothing  Nothing  = refl+compMaybe Nothing  (Just _) = refl+compMaybe (Just _) Nothing  = refl+compMaybe (Just x) (Just y)+  rewrite sym (lte2nGT x y)+    | sym (lte2nGT y x)+  = comparability x y++transMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ ( x y z : Maybe a ) → ((x <= y) && (y <= z)) ≡ True → (x <= z) ≡ True+transMaybe Nothing  Nothing  Nothing  _ = refl+transMaybe Nothing  Nothing  (Just _) _ = refl+transMaybe Nothing  (Just _) (Just _) _ = refl+transMaybe (Just x) (Just y) Nothing  h+  = magic ((nequality (GT /= GT) True refl) (&&-rightTrue (compare x y /= GT) (GT /= GT) h))+transMaybe (Just x) (Just y) (Just z) h+  rewrite sym (compareGt x z)+    | sym (lte2nGT x y)+    | sym (lte2nGT y z)+    | sym (lte2ngt x z) -- not (x > z) → (x <= z)+  = transitivity x y z h++reflMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x : Maybe a) → (x <= x) ≡ True+reflMaybe Nothing = refl+reflMaybe (Just x)+  rewrite (equality (compare x x) EQ (trans (sym (compareEq x x)) (eqReflexivity x)))+  = refl++antisymmetryMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → ((x <= y) && (y <= x)) ≡ True → (x == y) ≡ True+antisymmetryMaybe Nothing  Nothing  _ = refl+antisymmetryMaybe (Just x) (Just y) h+  rewrite sym (lte2nGT x y)+    | sym (lte2nGT y x)+  = antisymmetry x y h++lte2gteMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x <= y) ≡ (y >= x)+lte2gteMaybe Nothing  Nothing  = refl+lte2gteMaybe Nothing  (Just _) = refl+lte2gteMaybe (Just _) Nothing  = refl+lte2gteMaybe (Just x) (Just y)+  rewrite sym (compareGt x y)+    | sym (lte2ngt x y)+    | lte2gte x y -- IH+    | gte2nlt y x+    | compareLt y x+  = refl++lt2LteNeqMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x < y) ≡ (x <= y && x /= y)+lt2LteNeqMaybe Nothing  Nothing  = refl+lt2LteNeqMaybe Nothing  (Just _) = refl+lt2LteNeqMaybe (Just _) Nothing  = refl+lt2LteNeqMaybe (Just x) (Just y)+  rewrite sym (compareLt x y)+    | lt2LteNeq x y -- IH+    | lte2ngt x y+    | compareGt x y+  = refl++lt2gtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x < y) ≡ (y > x)+lt2gtMaybe Nothing  Nothing  = refl+lt2gtMaybe Nothing  (Just _) = refl+lt2gtMaybe (Just _) Nothing  = refl+lt2gtMaybe (Just x) (Just y)+  rewrite sym (compareLt x y)+    | lt2gt x y -- IH+    | compareGt y x+  = refl++compareLtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x < y) ≡ (compare x y == LT)+compareLtMaybe Nothing  Nothing  = refl+compareLtMaybe Nothing  (Just _) = refl+compareLtMaybe (Just _) Nothing  = refl+compareLtMaybe (Just _) (Just _) = refl++compareGtMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x > y) ≡ (compare x y == GT)+compareGtMaybe Nothing  Nothing  = refl+compareGtMaybe Nothing  (Just _) = refl+compareGtMaybe (Just _) Nothing  = refl+compareGtMaybe (Just _) (Just _) = refl++compareEqMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ iLawfulOrdA : IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → (x == y) ≡ (compare x y == EQ)+compareEqMaybe Nothing  Nothing  = refl+compareEqMaybe Nothing  (Just y) = refl+compareEqMaybe (Just x) Nothing  = refl+compareEqMaybe (Just x) (Just y) = compareEq x y++min2ifMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → ((min x y) == (if (x <= y) then x else y)) ≡ True+min2ifMaybe Nothing  Nothing  = refl+min2ifMaybe Nothing  (Just _) = refl+min2ifMaybe (Just _) Nothing = refl+min2ifMaybe (Just x) (Just y)+  rewrite sym (ifFlip (compare x y == GT) (Just x) (Just y))+  = equality'+      (if (compare x y /= GT) then Just x else Just y)+      (if (compare x y /= GT) then Just x else Just y)+      refl++max2ifMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄+  → ∀ (x y : Maybe a) → ((max x y) == (if (x >= y) then x else y)) ≡ True+max2ifMaybe Nothing  Nothing  = refl+max2ifMaybe Nothing  (Just y) = eqReflexivity y+max2ifMaybe (Just x) Nothing  = eqReflexivity x+max2ifMaybe (Just x) (Just y)+  rewrite sym (ifFlip (compare x y == LT) (Just x) (Just y))+  = equality'+    (if (compare x y /= LT) then Just x else Just y)+    (if (compare x y /= LT) then Just x else Just y)+    refl++instance+  iLawfulOrdMaybe : ⦃ iOrdA : Ord a ⦄ → ⦃ IsLawfulOrd a ⦄ → IsLawfulOrd (Maybe a)+  iLawfulOrdMaybe = λ where+    .comparability → compMaybe+    .transitivity → transMaybe+    .reflexivity → reflMaybe+    .antisymmetry → antisymmetryMaybe+    .lte2gte → lte2gteMaybe+    .lt2LteNeq → lt2LteNeqMaybe+    .lt2gt → lt2gtMaybe+    .compareLt → compareLtMaybe+    .compareGt → compareGtMaybe+    .compareEq → compareEqMaybe+    .min2if → min2ifMaybe+    .max2if → max2ifMaybe+
+ lib/base/Haskell/Law/Ord/Ordering.agda view
@@ -0,0 +1,121 @@+module Haskell.Law.Ord.Ordering where++open import Haskell.Prim+open import Haskell.Prim.Ord++open import Haskell.Law.Eq+open import Haskell.Law.Equality+open import Haskell.Law.Ord.Def++instance+  iLawfulOrdOrdering : IsLawfulOrd Ordering++  iLawfulOrdOrdering .comparability LT LT = refl+  iLawfulOrdOrdering .comparability LT EQ = refl+  iLawfulOrdOrdering .comparability LT GT = refl+  iLawfulOrdOrdering .comparability EQ LT = refl+  iLawfulOrdOrdering .comparability EQ EQ = refl+  iLawfulOrdOrdering .comparability EQ GT = refl+  iLawfulOrdOrdering .comparability GT LT = refl+  iLawfulOrdOrdering .comparability GT EQ = refl+  iLawfulOrdOrdering .comparability GT GT = refl++  iLawfulOrdOrdering .transitivity LT LT LT _ = refl+  iLawfulOrdOrdering .transitivity LT LT EQ _ = refl+  iLawfulOrdOrdering .transitivity LT LT GT _ = refl+  iLawfulOrdOrdering .transitivity LT EQ EQ _ = refl+  iLawfulOrdOrdering .transitivity LT EQ GT _ = refl+  iLawfulOrdOrdering .transitivity LT GT GT _ = refl+  iLawfulOrdOrdering .transitivity EQ EQ EQ _ = refl+  iLawfulOrdOrdering .transitivity EQ EQ GT _ = refl+  iLawfulOrdOrdering .transitivity EQ GT GT _ = refl+  iLawfulOrdOrdering .transitivity GT GT GT _ = refl++  iLawfulOrdOrdering .reflexivity LT = refl+  iLawfulOrdOrdering .reflexivity EQ = refl+  iLawfulOrdOrdering .reflexivity GT = refl++  iLawfulOrdOrdering .antisymmetry LT LT _ = refl+  iLawfulOrdOrdering .antisymmetry EQ EQ _ = refl+  iLawfulOrdOrdering .antisymmetry GT GT _ = refl++  iLawfulOrdOrdering .lte2gte LT LT = refl+  iLawfulOrdOrdering .lte2gte LT EQ = refl+  iLawfulOrdOrdering .lte2gte LT GT = refl+  iLawfulOrdOrdering .lte2gte EQ LT = refl+  iLawfulOrdOrdering .lte2gte EQ EQ = refl+  iLawfulOrdOrdering .lte2gte EQ GT = refl+  iLawfulOrdOrdering .lte2gte GT LT = refl+  iLawfulOrdOrdering .lte2gte GT EQ = refl+  iLawfulOrdOrdering .lte2gte GT GT = refl++  iLawfulOrdOrdering .lt2LteNeq LT LT = refl+  iLawfulOrdOrdering .lt2LteNeq LT EQ = refl+  iLawfulOrdOrdering .lt2LteNeq LT GT = refl+  iLawfulOrdOrdering .lt2LteNeq EQ LT = refl+  iLawfulOrdOrdering .lt2LteNeq EQ EQ = refl+  iLawfulOrdOrdering .lt2LteNeq EQ GT = refl+  iLawfulOrdOrdering .lt2LteNeq GT LT = refl+  iLawfulOrdOrdering .lt2LteNeq GT EQ = refl+  iLawfulOrdOrdering .lt2LteNeq GT GT = refl++  iLawfulOrdOrdering .lt2gt LT LT = refl+  iLawfulOrdOrdering .lt2gt LT EQ = refl+  iLawfulOrdOrdering .lt2gt LT GT = refl+  iLawfulOrdOrdering .lt2gt EQ LT = refl+  iLawfulOrdOrdering .lt2gt EQ EQ = refl+  iLawfulOrdOrdering .lt2gt EQ GT = refl+  iLawfulOrdOrdering .lt2gt GT LT = refl+  iLawfulOrdOrdering .lt2gt GT EQ = refl+  iLawfulOrdOrdering .lt2gt GT GT = refl++  iLawfulOrdOrdering .compareLt LT LT = refl+  iLawfulOrdOrdering .compareLt LT EQ = refl+  iLawfulOrdOrdering .compareLt LT GT = refl+  iLawfulOrdOrdering .compareLt EQ LT = refl+  iLawfulOrdOrdering .compareLt EQ EQ = refl+  iLawfulOrdOrdering .compareLt EQ GT = refl+  iLawfulOrdOrdering .compareLt GT LT = refl+  iLawfulOrdOrdering .compareLt GT EQ = refl+  iLawfulOrdOrdering .compareLt GT GT = refl++  iLawfulOrdOrdering .compareGt LT LT = refl+  iLawfulOrdOrdering .compareGt LT EQ = refl+  iLawfulOrdOrdering .compareGt LT GT = refl+  iLawfulOrdOrdering .compareGt EQ LT = refl+  iLawfulOrdOrdering .compareGt EQ EQ = refl+  iLawfulOrdOrdering .compareGt EQ GT = refl+  iLawfulOrdOrdering .compareGt GT LT = refl+  iLawfulOrdOrdering .compareGt GT EQ = refl+  iLawfulOrdOrdering .compareGt GT GT = refl++  iLawfulOrdOrdering .compareEq LT LT = refl+  iLawfulOrdOrdering .compareEq LT EQ = refl+  iLawfulOrdOrdering .compareEq LT GT = refl+  iLawfulOrdOrdering .compareEq EQ LT = refl+  iLawfulOrdOrdering .compareEq EQ EQ = refl+  iLawfulOrdOrdering .compareEq EQ GT = refl+  iLawfulOrdOrdering .compareEq GT LT = refl+  iLawfulOrdOrdering .compareEq GT EQ = refl+  iLawfulOrdOrdering .compareEq GT GT = refl++  iLawfulOrdOrdering .min2if LT LT = refl+  iLawfulOrdOrdering .min2if LT EQ = refl+  iLawfulOrdOrdering .min2if LT GT = refl+  iLawfulOrdOrdering .min2if EQ LT = refl+  iLawfulOrdOrdering .min2if EQ EQ = refl+  iLawfulOrdOrdering .min2if EQ GT = refl+  iLawfulOrdOrdering .min2if GT LT = refl+  iLawfulOrdOrdering .min2if GT EQ = refl+  iLawfulOrdOrdering .min2if GT GT = refl++  iLawfulOrdOrdering .max2if LT LT = refl+  iLawfulOrdOrdering .max2if LT EQ = refl+  iLawfulOrdOrdering .max2if LT GT = refl+  iLawfulOrdOrdering .max2if EQ LT = refl+  iLawfulOrdOrdering .max2if EQ EQ = refl+  iLawfulOrdOrdering .max2if EQ GT = refl+  iLawfulOrdOrdering .max2if GT LT = refl+  iLawfulOrdOrdering .max2if GT EQ = refl+  iLawfulOrdOrdering .max2if GT GT = refl+
+ lib/base/Haskell/Law/Semigroup/Def.agda view
@@ -0,0 +1,27 @@+module Haskell.Law.Semigroup.Def where++open import Haskell.Prim+open import Haskell.Prim.Tuple++open import Haskell.Prim.Monoid++record IsLawfulSemigroup (a : Type) ⦃ iSemigroupA : Semigroup a ⦄ : Type₁ where+  field+    -- Associativity: x <> (y <> z) = (x <> y) <> z+    associativity : (x y z : a) → x <> (y <> z) ≡ (x <> y) <> z++open IsLawfulSemigroup ⦃ ... ⦄ public++postulate instance+  iLawfulSemigroupFun : ⦃ iSemB : Semigroup b ⦄ → ⦃ IsLawfulSemigroup b ⦄ → IsLawfulSemigroup (a → b)++  iLawfulSemigroupUnit : IsLawfulSemigroup ⊤++  iLawfulSemigroupTuple₂ : ⦃ iSemA : Semigroup a ⦄ ⦃ iSemB : Semigroup b ⦄+                         → ⦃ IsLawfulSemigroup a ⦄ → ⦃ IsLawfulSemigroup b ⦄+                         → IsLawfulSemigroup (a × b)++  iLawfulSemigroupTuple₃ : ⦃ iSemA : Semigroup a ⦄ ⦃ iSemB : Semigroup b ⦄ ⦃ iSemC : Semigroup c ⦄+                         → ⦃ IsLawfulSemigroup a ⦄ → ⦃ IsLawfulSemigroup b ⦄ → ⦃ IsLawfulSemigroup c ⦄+                         → IsLawfulSemigroup (a × b × c)+
+ lib/base/Haskell/Law/Semigroup/Either.agda view
@@ -0,0 +1,13 @@+module Haskell.Law.Semigroup.Either where++open import Haskell.Prim+open import Haskell.Prim.Either++open import Haskell.Prim.Monoid++open import Haskell.Law.Equality+open import Haskell.Law.Semigroup.Def++instance+  iLawfulSemigroupEither : IsLawfulSemigroup (Either a b)+  iLawfulSemigroupEither .associativity  = λ { (Left _) _ _ → refl; (Right _) _ _ → refl }
+ lib/base/Haskell/Law/Semigroup/List.agda view
@@ -0,0 +1,17 @@+module Haskell.Law.Semigroup.List where++open import Haskell.Prim+open import Haskell.Prim.List++open import Haskell.Prim.Monoid++open import Haskell.Law.Equality+open import Haskell.Law.List+open import Haskell.Law.Semigroup.Def++instance+  iLawfulSemigroupList : IsLawfulSemigroup (List a)+  iLawfulSemigroupList .associativity []       _  _  = refl+  iLawfulSemigroupList .associativity (x ∷ xs) ys zs+    rewrite sym (++-assoc xs ys zs)+    = refl
+ lib/base/Haskell/Law/Semigroup/Maybe.agda view
@@ -0,0 +1,18 @@+module Haskell.Law.Semigroup.Maybe where++open import Haskell.Prim+open import Haskell.Prim.Maybe++open import Haskell.Prim.Monoid++open import Haskell.Law.Equality+open import Haskell.Law.Semigroup.Def++instance+  iLawfulSemigroupMaybe : ⦃ iSemA : Semigroup a ⦄ → ⦃ IsLawfulSemigroup a ⦄ → IsLawfulSemigroup (Maybe a)+  iLawfulSemigroupMaybe .associativity Nothing  _        _        = refl+  iLawfulSemigroupMaybe .associativity (Just _) Nothing  _        = refl+  iLawfulSemigroupMaybe .associativity (Just _) (Just _) Nothing  = refl+  iLawfulSemigroupMaybe .associativity (Just x) (Just y) (Just z)+    rewrite associativity x y z+    = refl
+ lib/base/Haskell/Prelude.agda view
@@ -0,0 +1,140 @@+{-# OPTIONS --no-auto-inline #-}+module Haskell.Prelude where++open import Haskell.Prim+open Haskell.Prim public using+  ( Type;+    Bool; True; False; Char; Integer;+    List; []; _∷_; Nat; zero; suc; ⊤; tt;+    TypeError; ⊥; iNumberNat; lengthNat;+    IsTrue; IsFalse; NonEmpty;+    All; allNil; allCons;+    Any; anyHere; anyThere;+    id; _∘_; _$_; flip; const;+    if_then_else_; case_of_;+    Number; fromNat; Negative; fromNeg;+    IsString; fromString;+    _≡_; refl;+    a; b; c; d; e; f; m; s; t )++open import Haskell.Prim.Absurd      public+open import Haskell.Prim.Applicative public+open import Haskell.Prim.Bool        public+open import Haskell.Prim.Bounded     public+open import Haskell.Prim.Char        public+open import Haskell.Prim.Double      public+open import Haskell.Prim.Either      public+open import Haskell.Prim.Enum        public+open import Haskell.Prim.Eq          public+open import Haskell.Prim.Foldable    public+open import Haskell.Prim.Functor     public+open import Haskell.Prim.Int         public+open import Haskell.Prim.Integer     public+open import Haskell.Prim.IO          public+open import Haskell.Prim.List        public+open import Haskell.Prim.Maybe       public+open import Haskell.Prim.Monad       public+open import Haskell.Prim.Monoid      public+open import Haskell.Prim.Num         public+open import Haskell.Prim.Ord         public+open import Haskell.Prim.Show        public+open import Haskell.Prim.String      public+open import Haskell.Prim.Traversable public+open import Haskell.Prim.Tuple       public hiding (first; second; _***_)+open import Haskell.Prim.Word        public++-- Problematic features+--  - [Partial]:  Could pass implicit/instance arguments to prove totality.+--  - [Float]:    Or Float (Agda floats are Doubles)+--  - [Infinite]: Define colists and map to Haskell lists?++-- Missing from the Haskell Prelude:+--+--     Float        [Float]+--     Rational+--+--     Real(toRational),+--     Integral(quot, rem, div, mod, quotRem, divMod, toInteger),+--     Fractional((/), recip, fromRational),+--     Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,+--              asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),+--     RealFrac(properFraction, truncate, round, ceiling, floor),+--     RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,+--               encodeFloat, exponent, significand, scaleFloat, isNaN,+--               isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),+--+--     subtract, even, odd, gcd, lcm, (^), (^^),+--     fromIntegral, realToFrac,+--+--     foldr1, foldl1, maximum, minimum      [Partial]+--+--     until [Partial]+--+--     iterate, repeat, cycle          [Infinite]+--+--     ReadS, Read(readsPrec, readList),+--     reads, readParen, read, lex,+--+--     IO, putChar, putStr, putStrLn, print,+--     getChar, getLine, getContents, interact,+--     FilePath, readFile, writeFile, appendFile, readIO, readLn,+--     IOError, ioError, userError,+++--------------------------------------------------+-- Functions++infixr 0 _$!_++_$!_ : (a → b) → a → b+_$!_ = _$_++seq : a → b → b+seq = const id++asTypeOf : a → a → a+asTypeOf x _ = x++undefined : {@0 @(tactic absurd) i : ⊥} → a+undefined {i = ()}++error : {@0 @(tactic absurd) i : ⊥} → String → a+error {i = ()} err++errorWithoutStackTrace : {@0 @(tactic absurd) i : ⊥} → String → a+errorWithoutStackTrace {i = ()} err++-------------------------------------------------+-- More List functions+--   These uses Eq, Ord, or Foldable, so can't go in Prim.List without+--   turning those dependencies around.++reverse : List a → List a+reverse = foldl (flip _∷_) []++infixl 9 _!!_ _!!ᴺ_++_!!ᴺ_ : (xs : List a) (n : Nat) → @0 ⦃ IsTrue (n < lengthNat xs) ⦄ → a+(x ∷ xs) !!ᴺ zero  = x+(x ∷ xs) !!ᴺ suc n = xs !!ᴺ n++_!!_ : (xs : List a) (n : Int)+     → ⦃ @0 nn : IsNonNegativeInt n ⦄+     → ⦃ @0 _  : IsTrue (intToNat n {{nn}} < lengthNat xs) ⦄ → a+xs !! n = xs !!ᴺ intToNat n++lookup : ⦃ Eq a ⦄ → a → List (a × b) → Maybe b+lookup x []              = Nothing+lookup x ((x₁ , y) ∷ xs) = if x == x₁ then Just y else lookup x xs+++-------------------------------------------------+-- Unsafe functions++coerce : @0 a ≡ b → a → b+coerce refl x = x++IsJust : Maybe a → Type+IsJust Nothing  = ⊥+IsJust (Just _) = ⊤+
+ lib/base/Haskell/Prim.agda view
@@ -0,0 +1,130 @@+{-# OPTIONS --no-auto-inline #-}++-- Basic things needed by other primitive modules.+-- Note that this module exports types and functions that should not+-- be used directly in Haskell definitions, so you probably want to+-- import Haskell.Prelude instead.++module Haskell.Prim where++open import Agda.Primitive          public renaming (Set to Type)+open import Agda.Builtin.Bool       public renaming (true to True; false to False)+open import Agda.Builtin.Int        public renaming (Int to Integer)+open import Agda.Builtin.Nat        public renaming (_==_ to eqNat; _<_ to ltNat; _+_ to addNat; _-_ to monusNat; _*_ to mulNat)+open import Agda.Builtin.Char       public renaming (primCharToNat to c2n)+open import Agda.Builtin.Unit       public+open import Agda.Builtin.Equality   public+open import Agda.Builtin.FromString public+open import Agda.Builtin.FromNat    public+open import Agda.Builtin.FromNeg    public+open import Agda.Builtin.String     public renaming (String to AgdaString)+open import Agda.Builtin.Word       public renaming (primWord64ToNat to w2n; primWord64FromNat to n2w)+open import Agda.Builtin.Strict     public+open import Agda.Builtin.List       public++variable+  @0 ℓ : Level+  a b c d e : Type+  f m s t : Type → Type+++--------------------------------------------------+-- Functions++id : a → a+id x = x++infixr 9 _∘_+_∘_ : (b → c) → (a → b) → a → c+(f ∘ g) x = f (g x)++flip : (a → b → c) → b → a → c+flip f x y = f y x++const : a → b → a+const x _ = x++infixr 0 _$_+_$_ : (a → b) → a → b+f $ x = f x+++--------------------------------------------------+-- Language constructs++infix -1 case_of_+case_of_ : (a' : a) → ((a'' : a) → @0 {{ a' ≡ a'' }} → b) → b+case x of f = f x++infix -2 if_then_else_+if_then_else_ : {@0 a : Type ℓ} → (flg : Bool) → (@0 {{ flg ≡ True }} → a) → (@0 {{ flg ≡ False }} → a) → a+if False then x else y = y+if True  then x else y = x++-- for explicit type signatures (e. g. `4 :: Integer` is `the Int 4`)+the : (@0 a : Type ℓ) -> a -> a+the _ x = x++--------------------------------------------------+-- Agda strings++instance+  iIsStringAgdaString : IsString AgdaString+  iIsStringAgdaString .IsString.Constraint _ = ⊤+  iIsStringAgdaString .fromString s = s+++--------------------------------------------------+-- Numbers++instance+  iNumberNat : Number Nat+  iNumberNat .Number.Constraint _ = ⊤+  iNumberNat .fromNat n = n+++--------------------------------------------------+-- Lists++lengthNat : List a → Nat+lengthNat []       = 0+lengthNat (_ ∷ xs) = addNat 1 (lengthNat xs)+++--------------------------------------------------+-- Proof things++data ⊥ : Type where++magic : {A : Type} → ⊥ → A+magic ()++--principle of explosion+exFalso : {x : Bool} → (x ≡ True) → (x ≡ False) → ⊥+exFalso {False} () b +exFalso {True} a ()++-- Use to bundle up constraints+data All {a b} {A : Type a} (B : A → Type b) : List A → Type (a ⊔ b) where+  instance+    allNil  : All B []+    allCons : ∀ {x xs} ⦃ i : B x ⦄ ⦃ is : All B xs ⦄ → All B (x ∷ xs)++data Any {a b} {A : Type a} (B : A → Type b) : List A → Type (a ⊔ b) where+  instance+    anyHere  : ∀ {x xs} ⦃ i : B x ⦄ → Any B (x ∷ xs)+    anyThere : ∀ {x xs} ⦃ is : Any B xs ⦄ → Any B (x ∷ xs)++data IsTrue : Bool → Type where+  instance itsTrue : IsTrue True++data IsFalse : Bool → Type where+  instance itsFalse : IsFalse False++data NonEmpty {a : Type} : List a → Type where+  instance itsNonEmpty : ∀ {x xs} → NonEmpty (x ∷ xs)++data TypeError (err : AgdaString) : Type where++it : ∀ {@0 ℓ} {@0 a : Type ℓ} → ⦃ a ⦄ → a+it ⦃ x ⦄ = x
+ lib/base/Haskell/Prim/Absurd.agda view
@@ -0,0 +1,23 @@++module Haskell.Prim.Absurd where++open import Haskell.Prim++open import Agda.Builtin.Reflection renaming (bindTC to _>>=_; absurd to absurdP)++private++  pattern vArg x = arg (arg-info visible (modality relevant quantity-ω)) x++  refute : Nat → Term+  refute i = def (quote _$_) ( vArg (pat-lam (absurd-clause [] (vArg (absurdP 0) ∷ []) ∷ []) [])+                             ∷ vArg (var i []) ∷ [])++  tryRefute : Nat → Term → TC ⊤+  tryRefute 0       _    = typeError (strErr "No variable of empty type found in the context" ∷ [])+  tryRefute (suc n) hole = catchTC (unify hole (refute n)) (tryRefute n hole)++absurd : Term → TC ⊤+absurd hole = do+  Γ ← getContext+  tryRefute (lengthNat Γ) hole
+ lib/base/Haskell/Prim/Applicative.agda view
@@ -0,0 +1,92 @@+module Haskell.Prim.Applicative where++open import Haskell.Prim+open import Haskell.Prim.Either+open import Haskell.Prim.Foldable+open import Haskell.Prim.Functor+open import Haskell.Prim.IO+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Monoid+open import Haskell.Prim.Tuple+++--------------------------------------------------+-- Applicative++-- ** base+record Applicative (f : Type → Type) : Type₁ where+  infixl 4 _<*>_ _<*_ _*>_+  field+    pure  : a → f a+    _<*>_ : f (a → b) → f a → f b+    overlap ⦃ super ⦄ : Functor f+    _<*_ : f a → f b → f a+    _*>_ : f a → f b → f b+-- ** defaults+record DefaultApplicative (f : Type → Type) : Type₁ where+  constructor mk+  infixl 4 _<*>_ _<*_ _*>_+  field+    pure  : a → f a+    _<*>_ : f (a → b) → f a → f b+    overlap ⦃ super ⦄ : Functor f++  _<*_ : f a → f b → f a+  x <* y = const <$> x <*> y++  _*>_ : f a → f b → f b+  x *> y = const id <$> x <*> y+-- ** export+open Applicative ⦃...⦄ public+{-# COMPILE AGDA2HS Applicative existing-class #-}+-- ** instances+instance+  open DefaultApplicative++  iDefaultApplicativeList : DefaultApplicative List+  iDefaultApplicativeList .pure x = x ∷ []+  iDefaultApplicativeList ._<*>_ fs xs = concatMap (λ f → map f xs) fs++  iApplicativeList : Applicative List+  iApplicativeList = record {DefaultApplicative iDefaultApplicativeList}++  iDefaultApplicativeMaybe : DefaultApplicative Maybe+  iDefaultApplicativeMaybe .pure = Just+  iDefaultApplicativeMaybe ._<*>_ (Just f) (Just x) = Just (f x)+  iDefaultApplicativeMaybe ._<*>_ _        _        = Nothing++  iApplicativeMaybe : Applicative Maybe+  iApplicativeMaybe = record {DefaultApplicative iDefaultApplicativeMaybe}++  iDefaultApplicativeEither : DefaultApplicative (Either a)+  iDefaultApplicativeEither .pure = Right+  iDefaultApplicativeEither ._<*>_ (Right f) (Right x) = Right (f x)+  iDefaultApplicativeEither ._<*>_ (Left e)  _         = Left e+  iDefaultApplicativeEither ._<*>_ _         (Left e)  = Left e++  iApplicativeEither : Applicative (Either a)+  iApplicativeEither = record{DefaultApplicative iDefaultApplicativeEither}++  iDefaultApplicativeFun : DefaultApplicative (λ b → a → b)+  iDefaultApplicativeFun .pure        = const+  iDefaultApplicativeFun ._<*>_ f g x = f x (g x)++  iApplicativeFun : Applicative (λ b → a → b)+  iApplicativeFun = record{DefaultApplicative iDefaultApplicativeFun}++  iDefaultApplicativeTuple₂ : ⦃ Monoid a ⦄ → DefaultApplicative (a ×_)+  iDefaultApplicativeTuple₂ .pure x                = mempty , x+  iDefaultApplicativeTuple₂ ._<*>_ (a , f) (b , x) = a <> b , f x++  iApplicativeTuple₂ : ⦃ Monoid a ⦄ → Applicative (a ×_)+  iApplicativeTuple₂ = record{DefaultApplicative iDefaultApplicativeTuple₂}++  iDefaultApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultApplicative (a × b ×_)+  iDefaultApplicativeTuple₃ .pure x = mempty , mempty , x+  iDefaultApplicativeTuple₃ ._<*>_ (a , u , f) (b , v , x) = a <> b , u <> v , f x++  iApplicativeTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Applicative (a × b ×_)+  iApplicativeTuple₃ = record{DefaultApplicative iDefaultApplicativeTuple₃}++instance postulate iApplicativeIO : Applicative IO
+ lib/base/Haskell/Prim/Bool.agda view
@@ -0,0 +1,24 @@++module Haskell.Prim.Bool where++open import Haskell.Prim++--------------------------------------------------+-- Booleans++infixr 3 _&&_+_&&_ : Bool → Bool → Bool+False && _ = False+True  && x = x++infixr 2 _||_+_||_ : Bool → Bool → Bool+False || x = x+True  || _ = True++not : Bool → Bool+not False = True+not True  = False++otherwise : Bool+otherwise = True
+ lib/base/Haskell/Prim/Bounded.agda view
@@ -0,0 +1,94 @@++module Haskell.Prim.Bounded where++open import Haskell.Prim+open import Haskell.Prim.Eq+open import Haskell.Prim.Int+open import Haskell.Prim.Maybe+open import Haskell.Prim.Ord+open import Haskell.Prim.Tuple+open import Haskell.Prim.Word++--------------------------------------------------+-- Bounded++record BoundedBelow (a : Type) : Type where+  field+    minBound : a++record BoundedAbove (a : Type) : Type where+  field+    maxBound : a++record Bounded (a : Type) : Type where+  field+    overlap ⦃ below ⦄ : BoundedBelow a+    overlap ⦃ above ⦄ : BoundedAbove a++{-# COMPILE AGDA2HS Bounded existing-class #-}++open BoundedBelow ⦃...⦄ public+open BoundedAbove ⦃...⦄ public++instance+  iBounded : ⦃ BoundedBelow a ⦄ → ⦃ BoundedAbove a ⦄ → Bounded a+  iBounded .Bounded.below = it+  iBounded .Bounded.above = it++instance+  iBoundedBelowNat : BoundedBelow Nat+  iBoundedBelowNat .minBound = 0++  iBoundedBelowWord : BoundedBelow Word+  iBoundedBelowWord .minBound = 0+  iBoundedAboveWord : BoundedAbove Word+  iBoundedAboveWord .maxBound = 18446744073709551615++  iBoundedBelowInt : BoundedBelow Int+  iBoundedBelowInt .minBound = -9223372036854775808+  iBoundedAboveInt : BoundedAbove Int+  iBoundedAboveInt .maxBound = 9223372036854775807++  iBoundedBelowBool : BoundedBelow Bool+  iBoundedBelowBool .minBound = False+  iBoundedAboveBool : BoundedAbove Bool+  iBoundedAboveBool .maxBound = True++  iBoundedBelowChar : BoundedBelow Char+  iBoundedBelowChar .minBound = '\0'+  iBoundedAboveChar : BoundedAbove Char+  iBoundedAboveChar .maxBound = '\1114111'++  iBoundedBelowUnit : BoundedBelow ⊤+  iBoundedBelowUnit .minBound = tt++  iBoundedAboveUnit : BoundedAbove ⊤+  iBoundedAboveUnit .maxBound = tt++  iBoundedBelowTuple₂ : ⦃ BoundedBelow a ⦄ → ⦃ BoundedBelow b ⦄+                      → BoundedBelow (a × b)+  iBoundedBelowTuple₂ .minBound = minBound , minBound+  iBoundedAboveTuple₂ : ⦃ BoundedAbove a ⦄ → ⦃ BoundedAbove b ⦄+                      → BoundedAbove (a × b)+  iBoundedAboveTuple₂ .maxBound = maxBound , maxBound++  iBoundedBelowTuple₃ : ⦃ BoundedBelow a ⦄ → ⦃ BoundedBelow b ⦄ → ⦃ BoundedBelow c ⦄+                      → BoundedBelow (a × b × c)+  iBoundedBelowTuple₃ .minBound = minBound , minBound , minBound+  iBoundedAboveTuple₃ : ⦃ BoundedAbove a ⦄ → ⦃ BoundedAbove b ⦄ → ⦃ BoundedAbove c ⦄+                      → BoundedAbove (a × b × c)+  iBoundedAboveTuple₃ .maxBound = maxBound , maxBound , maxBound++  iBoundedBelowOrdering : BoundedBelow Ordering+  iBoundedBelowOrdering .minBound = LT+  iBoundedAboveOrdering : BoundedAbove Ordering+  iBoundedAboveOrdering .maxBound = GT++-- Sanity checks++private+  _ : addWord maxBound 1 ≡ minBound+  _ = refl++  _ : addInt maxBound 1 ≡ minBound+  _ = refl
+ lib/base/Haskell/Prim/Char.agda view
@@ -0,0 +1,9 @@+module Haskell.Prim.Char where++open import Haskell.Prim++import Agda.Builtin.Char +open Agda.Builtin.Char using (Char)+    +eqChar : Char → Char → Bool+eqChar a b = eqNat (c2n a) (c2n b)
+ lib/base/Haskell/Prim/Double.agda view
@@ -0,0 +1,15 @@++module Haskell.Prim.Double where++open import Agda.Builtin.Float public renaming (Float to Double)++open import Haskell.Prim++instance+  iNumberDouble : Number Double+  iNumberDouble .Number.Constraint _ = ⊤+  iNumberDouble .fromNat n = primNatToFloat n++  iNegativeDouble : Negative Double+  iNegativeDouble .Negative.Constraint _ = ⊤+  iNegativeDouble .fromNeg n = primFloatMinus 0.0 (fromNat n)
+ lib/base/Haskell/Prim/Either.agda view
@@ -0,0 +1,20 @@++module Haskell.Prim.Either where++open import Haskell.Prim+open import Haskell.Prim.Bool++--------------------------------------------------+-- Either++data Either (a b : Type) : Type where+  Left  : a → Either a b+  Right : b → Either a b++either : (a → c) → (b → c) → Either a b → c+either f g (Left  x) = f x+either f g (Right y) = g y++testBool : (b : Bool) → Either (IsFalse b) (IsTrue b)+testBool False = Left  itsFalse+testBool True  = Right itsTrue
+ lib/base/Haskell/Prim/Enum.agda view
@@ -0,0 +1,263 @@++module Haskell.Prim.Enum where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.Bounded+open import Haskell.Prim.Either+open import Haskell.Prim.Eq+open import Haskell.Prim.Functor+open import Haskell.Prim.Int+open import Haskell.Prim.Integer+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Num+open import Haskell.Prim.Ord+open import Haskell.Prim.Tuple+open import Haskell.Prim.Word+++--------------------------------------------------+-- Enum+--    Assumptions: unbounded enums have no constraints on their+--    operations and bounded enums should work on all values between+--    minBound and maxBound. Unbounded enums do not support enumFrom+--    and enumFromThen (since they return infinite lists).++@0 IfBoundedBelow : Maybe (BoundedBelow a) → (⦃ BoundedBelow a ⦄ → Type) → Type+IfBoundedBelow Nothing  k = ⊤+IfBoundedBelow (Just i) k = k ⦃ i ⦄++@0 IfBoundedAbove : Maybe (BoundedAbove a) → (⦃ BoundedAbove a ⦄ → Type) → Type+IfBoundedAbove Nothing  k = ⊤+IfBoundedAbove (Just i) k = k ⦃ i ⦄++record Enum (a : Type) : Type₁ where+  field+    BoundedBelowEnum : Maybe (BoundedBelow a)+    BoundedAboveEnum : Maybe (BoundedAbove a)+    fromEnum         : a → Int++  private+    @0 IsBoundedBelow : Type+    IsBoundedBelow = maybe ⊥ (λ _ → ⊤) BoundedBelowEnum++    @0 IsBoundedAbove : Type+    IsBoundedAbove = maybe ⊥ (λ _ → ⊤) BoundedAboveEnum++    @0 TrueIfLB : (⦃ BoundedBelow a ⦄ → Bool) → Type+    TrueIfLB C = IfBoundedBelow BoundedBelowEnum (IsTrue C)++    @0 TrueIfUB : (⦃ BoundedAbove a ⦄ → Bool) → Type+    TrueIfUB C = IfBoundedAbove BoundedAboveEnum (IsTrue C)++    @0 FalseIfLB : (⦃ BoundedBelow a ⦄ → Bool) → Type+    FalseIfLB C = IfBoundedBelow BoundedBelowEnum (IsFalse C)++    @0 FalseIfUB : (⦃ BoundedAbove a ⦄ → Bool) → Type+    FalseIfUB C = IfBoundedAbove BoundedAboveEnum (IsFalse C)++    minInt : ⦃ BoundedBelow a ⦄ → Int+    minInt ⦃ _ ⦄ = fromEnum minBound++    maxInt : ⦃ BoundedAbove a ⦄ → Int+    maxInt ⦃ _ ⦄ = fromEnum maxBound++  field+    toEnum : (n : Int) → @0 ⦃ TrueIfLB (minInt <= n) ⦄ → @0 ⦃ TrueIfUB (n <= maxInt) ⦄ → a+    succ   : (x : a) → @0 ⦃ FalseIfUB (fromEnum x == maxInt) ⦄ → a+    pred   : (x : a) → @0 ⦃ FalseIfLB (fromEnum x == minInt) ⦄ → a++    enumFrom       : @0 ⦃ IsBoundedAbove ⦄ → a → List a+    enumFromTo     : a → a → List a+    -- In the Prelude Enum instances `enumFromThenTo x x y` gives the+    -- infinite list of `x`s. The constraint is a little bit stronger than it needs to be,+    -- since it rules out different x and x₁ that maps to the same Int, but this saves us+    -- requiring an Eq instance for `a`, and it's not a terrible limitation to not be able to+    -- write [0, 2^64 .. 2^66].+    enumFromThenTo : (x x₁ : a) → @0 ⦃ IsFalse (fromEnum x == fromEnum x₁) ⦄ → a → List a+    enumFromThen   : @0 ⦃ IsBoundedBelow ⦄ → @0 ⦃ IsBoundedAbove ⦄ → (x x₁ : a) → @0 ⦃ IsFalse (fromEnum x == fromEnum x₁) ⦄ → List a++open Enum ⦃...⦄ public++{-# COMPILE AGDA2HS Enum existing-class #-}++private+  divNat : Nat → Nat → Nat+  divNat a 0       = 0+  divNat a (suc b) = div-helper 0 b a b++  diff : Integer → Integer → Maybe Nat+  diff a b =+    case a - b of λ where+      (pos n)    → Just n+      (negsuc _) → Nothing++  unsafeIntegerToNat : Integer → Nat+  unsafeIntegerToNat (pos n) = n+  unsafeIntegerToNat (negsuc _) = 0++  integerFromCount : Integer → Integer → Nat → List Integer+  integerFromCount a step 0       = []+  integerFromCount a step (suc n) = a ∷ integerFromCount (a + step) step n++  integerFromTo : Integer → Integer → List Integer+  integerFromTo a b = maybe [] (integerFromCount a 1 ∘ suc) (diff b a)++  integerFromThenTo : (a a₁ : Integer) → @0 ⦃ IsFalse (integerToInt a == integerToInt a₁) ⦄ → Integer → List Integer+  integerFromThenTo a a₁ b =+    case compare a a₁ of λ where+      LT → maybe [] (λ d → integerFromCount a (a₁ - a) (suc (divNat d (unsafeIntegerToNat (a₁ - a))))) (diff b a)+      EQ → [] -- impossible+      GT → maybe [] (λ d → integerFromCount a (a₁ - a) (suc (divNat d (unsafeIntegerToNat (a - a₁))))) (diff a b)++instance+  iEnumInteger : Enum Integer+  iEnumInteger .BoundedBelowEnum  = Nothing+  iEnumInteger .BoundedAboveEnum  = Nothing+  iEnumInteger .fromEnum          = integerToInt+  iEnumInteger .toEnum          n = intToInteger n+  iEnumInteger .succ              = _+ 1+  iEnumInteger .pred              = _- 1+  iEnumInteger .enumFromTo        = integerFromTo+  iEnumInteger .enumFromThenTo    = integerFromThenTo++private+  fromTo : (from : a → Integer) (to : Integer → a)+         → a → a → List a+  fromTo from to a b = map to (enumFromTo (from a) (from b))++  fromThenTo : (from : a → Integer) (to : Integer → a)+             → (x x₁ : a) → @0 ⦃ IsFalse (fromEnum (from x) == fromEnum (from x₁)) ⦄ → a → List a+  fromThenTo from to a a₁ b = map to (enumFromThenTo (from a) (from a₁) (from b))+++instance+  iEnumNat : Enum Nat+  iEnumNat .BoundedBelowEnum = Just it+  iEnumNat .BoundedAboveEnum = Nothing+  iEnumNat .fromEnum = integerToInt ∘ pos+  iEnumNat .toEnum n = unsafeIntegerToNat (intToInteger n)+  iEnumNat .succ n = suc n+  iEnumNat .pred (suc n) = n+  iEnumNat .enumFromTo = fromTo pos unsafeIntegerToNat+  iEnumNat .enumFromThenTo = fromThenTo pos unsafeIntegerToNat++  iEnumInt : Enum Int+  iEnumInt .BoundedBelowEnum      = Just it+  iEnumInt .BoundedAboveEnum      = Just it+  iEnumInt .fromEnum              = integerToInt ∘ intToInteger+  iEnumInt .toEnum         n      = integerToInt (intToInteger n)+  iEnumInt .succ           x      = integerToInt (intToInteger x + 1)+  iEnumInt .pred           x      = integerToInt (intToInteger x - 1)+  iEnumInt .enumFromTo     a b    = fromTo intToInteger integerToInt a b+  iEnumInt .enumFromThenTo a a₁ b = fromThenTo intToInteger integerToInt a a₁ b+  iEnumInt .enumFrom       a      = fromTo intToInteger integerToInt a maxBound+  iEnumInt .enumFromThen   a a₁   =+    if a < a₁ then fromThenTo intToInteger integerToInt a a₁ maxBound+              else fromThenTo intToInteger integerToInt a a₁ minBound++  iEnumWord : Enum Word+  iEnumWord .BoundedBelowEnum      = Just it+  iEnumWord .BoundedAboveEnum      = Just it+  iEnumWord .fromEnum              = integerToInt ∘ wordToInteger+  iEnumWord .toEnum         n      = integerToWord (intToInteger n)+  iEnumWord .succ           x      = integerToWord (wordToInteger x + 1)+  iEnumWord .pred           x      = integerToWord (wordToInteger x - 1)+  iEnumWord .enumFromTo     a b    = fromTo wordToInteger integerToWord a b+  iEnumWord .enumFromThenTo a a₁ b = fromThenTo wordToInteger integerToWord a a₁ b+  iEnumWord .enumFrom       a      = fromTo wordToInteger integerToWord a maxBound+  iEnumWord .enumFromThen   a a₁   =+    if a < a₁ then fromThenTo wordToInteger integerToWord a a₁ maxBound+              else fromThenTo wordToInteger integerToWord a a₁ minBound++private+  fromBool : Bool → Integer+  fromBool = if_then 1 else 0++  toBool : Integer → Bool+  toBool = _/= 0++instance+  iEnumBool : Enum Bool+  iEnumBool .BoundedBelowEnum      = Just it+  iEnumBool .BoundedAboveEnum      = Just it+  iEnumBool .fromEnum              = integerToInt ∘ fromBool+  iEnumBool .toEnum         n      = toBool (intToInteger n)+  iEnumBool .succ           x      = toBool (fromBool x + 1)+  iEnumBool .pred           x      = toBool (fromBool x - 1)+  iEnumBool .enumFromTo     a b    = fromTo fromBool toBool a b+  iEnumBool .enumFromThenTo a a₁ b = fromThenTo fromBool toBool a a₁ b+  iEnumBool .enumFrom       a      = fromTo fromBool toBool a maxBound+  iEnumBool .enumFromThen   a a₁   =+    if a < a₁ then fromThenTo fromBool toBool a a₁ maxBound+              else fromThenTo fromBool toBool a a₁ minBound++private+  fromOrdering : Ordering → Integer+  fromOrdering = λ where LT → 0; EQ → 1; GT → 2++  toOrdering : Integer → Ordering+  toOrdering = λ where (pos 0) → LT; (pos 1) → EQ; _ → GT++instance+  iEnumOrdering : Enum Ordering+  iEnumOrdering .BoundedBelowEnum      = Just it+  iEnumOrdering .BoundedAboveEnum      = Just it+  iEnumOrdering .fromEnum              = integerToInt ∘ fromOrdering+  iEnumOrdering .toEnum         n      = toOrdering (intToInteger n)+  iEnumOrdering .succ           x      = toOrdering (fromOrdering x + 1)+  iEnumOrdering .pred           x      = toOrdering (fromOrdering x - 1)+  iEnumOrdering .enumFromTo     a b    = fromTo fromOrdering toOrdering a b+  iEnumOrdering .enumFromThenTo a a₁ b = fromThenTo fromOrdering toOrdering a a₁ b+  iEnumOrdering .enumFrom       a      = fromTo fromOrdering toOrdering a maxBound+  iEnumOrdering .enumFromThen   a a₁   =+    if a < a₁ then fromThenTo fromOrdering toOrdering a a₁ maxBound+              else fromThenTo fromOrdering toOrdering a a₁ minBound++private+  fromUnit : ⊤ → Integer+  fromUnit _ = 0++  toUnit : Integer → ⊤+  toUnit _ = tt++instance+  iEnumUnit : Enum ⊤+  iEnumUnit .BoundedBelowEnum      = Just it+  iEnumUnit .BoundedAboveEnum      = Just it+  iEnumUnit .fromEnum              = integerToInt ∘ fromUnit+  iEnumUnit .toEnum         n      = toUnit (intToInteger n)+  iEnumUnit .succ           x      = toUnit (fromUnit x + 1)+  iEnumUnit .pred           x      = toUnit (fromUnit x - 1)+  iEnumUnit .enumFromTo     a b    = fromTo fromUnit toUnit a b+  iEnumUnit .enumFromThenTo a a₁ b = fromThenTo fromUnit toUnit a a₁ b+  iEnumUnit .enumFrom       a      = fromTo fromUnit toUnit a maxBound+  iEnumUnit .enumFromThen   a a₁   =+    if a < a₁ then fromThenTo fromUnit toUnit a a₁ maxBound+              else fromThenTo fromUnit toUnit a a₁ minBound++private+  fromChar : Char → Integer+  fromChar = pos ∘ c2n++  toChar : Integer → Char+  toChar = λ where (pos n) → primNatToChar n; _ → '_'++instance+  iEnumChar : Enum Char+  iEnumChar .BoundedBelowEnum      = Just it+  iEnumChar .BoundedAboveEnum      = Just it+  iEnumChar .fromEnum              = integerToInt ∘ fromChar+  iEnumChar .toEnum         n      = toChar (intToInteger n)+  iEnumChar .succ           x      = toChar (fromChar x + 1)+  iEnumChar .pred           x      = toChar (fromChar x - 1)+  iEnumChar .enumFromTo     a b    = fromTo fromChar toChar a b+  iEnumChar .enumFromThenTo a a₁ b = fromThenTo fromChar toChar a a₁ b+  iEnumChar .enumFrom       a      = fromTo fromChar toChar a maxBound+  iEnumChar .enumFromThen   a a₁   =+    if a < a₁ then fromThenTo fromChar toChar a a₁ maxBound+              else fromThenTo fromChar toChar a a₁ minBound++  -- Missing:+  --  Enum Double  (can't go via Integer)
+ lib/base/Haskell/Prim/Eq.agda view
@@ -0,0 +1,82 @@++module Haskell.Prim.Eq where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.Char+open import Haskell.Prim.Integer+open import Haskell.Prim.Int+open import Haskell.Prim.Word+open import Haskell.Prim.Double+open import Haskell.Prim.Tuple+open import Haskell.Prim.Maybe+open import Haskell.Prim.Either++--------------------------------------------------+-- Eq++record Eq (a : Type) : Type where+  infix 4 _==_+  field+    _==_ : a → a → Bool++open Eq ⦃...⦄ public++{-# COMPILE AGDA2HS Eq existing-class #-}++_/=_ : {{Eq a}} → a → a → Bool+x /= y = not (x == y)++infix 4 _/=_++instance+  iEqNat : Eq Nat+  iEqNat ._==_ = eqNat++  iEqInteger : Eq Integer+  iEqInteger ._==_ = eqInteger++  iEqInt : Eq Int+  iEqInt ._==_ = eqInt++  iEqWord : Eq Word+  iEqWord ._==_ = eqWord++  iEqDouble : Eq Double+  iEqDouble ._==_ = primFloatEquality++  iEqBool : Eq Bool+  iEqBool ._==_ False False = True+  iEqBool ._==_ True  True  = True+  iEqBool ._==_ _     _     = False++  iEqChar : Eq Char+  iEqChar ._==_ = eqChar++  iEqUnit : Eq ⊤+  iEqUnit ._==_ _ _ = True++  iEqTuple₂ : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (a × b)+  iEqTuple₂ ._==_ (x₁ , y₁) (x₂ , y₂) = x₁ == x₂ && y₁ == y₂++  iEqTuple₃ : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → ⦃ Eq c ⦄ → Eq (a × b × c)+  iEqTuple₃ ._==_ (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) = x₁ == x₂ && y₁ == y₂ && z₁ == z₂++  iEqList : ⦃ Eq a ⦄ → Eq (List a)+  iEqList {a} ._==_ = eqList+    where+      eqList : List a → List a → Bool+      eqList [] [] = True+      eqList (x ∷ xs) (y ∷ ys) = x == y && eqList xs ys+      eqList _ _ = False+++  iEqMaybe : ⦃ Eq a ⦄ → Eq (Maybe a)+  iEqMaybe ._==_ Nothing  Nothing  = True+  iEqMaybe ._==_ (Just x) (Just y) = x == y+  iEqMaybe ._==_ _        _        = False++  iEqEither : ⦃ Eq a ⦄ → ⦃ Eq b ⦄ → Eq (Either a b)+  iEqEither ._==_ (Left  x) (Left  y) = x == y+  iEqEither ._==_ (Right x) (Right y) = x == y+  iEqEither ._==_ _        _          = False
+ lib/base/Haskell/Prim/Foldable.agda view
@@ -0,0 +1,122 @@++module Haskell.Prim.Foldable where++open import Haskell.Prim+open import Haskell.Prim.Num hiding (abs)+open import Haskell.Prim.Eq+open import Haskell.Prim.List+open import Haskell.Prim.Int+open import Haskell.Prim.Bool+open import Haskell.Prim.Maybe+open import Haskell.Prim.Either+open import Haskell.Prim.Tuple+open import Haskell.Prim.Monoid++--------------------------------------------------+-- Foldable++-- ** base+record Foldable (t : Type → Type) : Type₁ where+  field+    foldMap : ⦃ Monoid b ⦄ → (a → b) → t a → b+    foldr : (a → b → b) → b → t a → b+    foldl : (b → a → b) → b → t a → b+    any : (a → Bool) → t a → Bool+    all : (a → Bool) → t a → Bool+    and : t Bool → Bool+    null : t a → Bool+    or : t Bool → Bool+    concat : t (List a) → List a+    concatMap : (a → List b) → t a → List b+    elem : ⦃ Eq a ⦄ → a → t a → Bool+    notElem : ⦃ Eq a ⦄ → a → t a → Bool+    toList : t a → List a+    sum : ⦃ iNum : Num a ⦄ → t a → a+    product : ⦃ iNum : Num a ⦄ → t a → a+    length : t a → Int+-- ** defaults+record DefaultFoldable (t : Type → Type) : Type₁ where+  module M = Foldable {t = t}+  field foldMap : ⦃ Monoid b ⦄ → (a → b) → t a → b++  foldr : (a → b → b) → b → t a → b+  foldr f z t = foldMap ⦃ MonoidEndo ⦄ f t z++  foldl : (b → a → b) → b → t a → b+  foldl f z t = foldMap ⦃ MonoidEndoᵒᵖ ⦄ (flip f) t z++  any : (a → Bool) → t a → Bool+  any = foldMap ⦃ MonoidDisj ⦄++  all : (a → Bool) → t a → Bool+  all = foldMap ⦃ MonoidConj ⦄++  and : t Bool → Bool+  and = all id++  or : t Bool → Bool+  or = any id++  null : t a → Bool+  null = all (const False)++  concat : t (List a) → List a+  concat = foldMap id++  concatMap : (a → List b) → t a → List b+  concatMap = foldMap++  elem : ⦃ Eq a ⦄ → a → t a → Bool+  elem x = foldMap ⦃ MonoidDisj ⦄ (x ==_)++  notElem : ⦃ Eq a ⦄ → a → t a → Bool+  notElem x t = not (elem x t)++  toList : t a → List a+  toList = foldr _∷_ []++  sum : ⦃ iNum : Num a ⦄ → t a → a+  sum = foldMap ⦃ MonoidSum ⦄ id++  product : ⦃ iNum : Num a ⦄ → t a → a+  product = foldMap ⦃ MonoidProduct ⦄ id++  length : t a → Int+  length = foldMap ⦃ MonoidSum ⦄ (const 1)+-- ** export+open Foldable ⦃...⦄ public+{-# COMPILE AGDA2HS Foldable existing-class #-}++-- ** instances+instance+  iDefaultFoldableList : DefaultFoldable List+  iDefaultFoldableList .DefaultFoldable.foldMap = foldMapList+    where+      foldMapList : ⦃ Monoid b ⦄ → (a → b) → List a → b+      foldMapList f []       = mempty+      foldMapList f (x ∷ xs) = f x <> foldMapList f xs++  iFoldableList : Foldable List+  iFoldableList = record {DefaultFoldable iDefaultFoldableList}++  iDefaultFoldableMaybe : DefaultFoldable Maybe+  iDefaultFoldableMaybe .DefaultFoldable.foldMap = λ where+    _ Nothing  → mempty+    f (Just x) → f x++  iFoldableMaybe : Foldable Maybe+  iFoldableMaybe = record {DefaultFoldable iDefaultFoldableMaybe}++  iDefaultFoldableEither : DefaultFoldable (Either a)+  iDefaultFoldableEither .DefaultFoldable.foldMap = λ where+    _ (Left _)  → mempty+    f (Right x) → f x++  iFoldableEither : Foldable (Either a)+  iFoldableEither = record {DefaultFoldable iDefaultFoldableEither}++  iDefaultFoldablePair : DefaultFoldable (a ×_)+  iDefaultFoldablePair .DefaultFoldable.foldMap = λ f (_ , x) → f x++  iFoldablePair : Foldable (a ×_)+  iFoldablePair = record {DefaultFoldable iDefaultFoldablePair}
+ lib/base/Haskell/Prim/Functor.agda view
@@ -0,0 +1,89 @@++module Haskell.Prim.Functor where++open import Haskell.Prim+open import Haskell.Prim.Either+open import Haskell.Prim.IO+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Tuple++--------------------------------------------------+-- Functor++-- ** base+record Functor (f : Type → Type) : Type₁ where+  infixl 4 _<$_+  field+    fmap : (a → b) → f a → f b+    _<$_ : (@0 {{ b }} → a) → f b → f a+-- ** defaults+record DefaultFunctor (f : Type → Type) : Type₁ where+  field fmap : (a → b) → f a → f b++  infixl 4 _<$_++  _<$_ : (@0 {{ b }} → a) → f b → f a+  x <$ m = fmap (λ b → x {{b}}) m++-- ** export+open Functor ⦃...⦄ public+{-# COMPILE AGDA2HS Functor existing-class #-}++_<$>_ : {{Functor f}} → (a → b) → f a → f b+_<$>_ = fmap++_<&>_ : {{Functor f}} → f a → (a → b) → f b+m <&> f = fmap f m++_$>_ : {{Functor f}} → f a → (@0 {{ a }} → b) → f b+m $> x = x <$ m++void : {{Functor f}} → f a → f ⊤+void = tt <$_++infixl 1 _<&>_+infixl 4 _<$>_ _$>_++instance+  iDefaultFunctorList : DefaultFunctor List+  iDefaultFunctorList .DefaultFunctor.fmap = map++  iFunctorList : Functor List+  iFunctorList = record{DefaultFunctor iDefaultFunctorList}++  iDefaultFunctorMaybe : DefaultFunctor Maybe+  iDefaultFunctorMaybe .DefaultFunctor.fmap = λ where+    f Nothing  → Nothing+    f (Just x) → Just (f x)++  iFunctorMaybe : Functor Maybe+  iFunctorMaybe = record{DefaultFunctor iDefaultFunctorMaybe}++  iDefaultFunctorEither : DefaultFunctor (Either a)+  iDefaultFunctorEither .DefaultFunctor.fmap = λ where+    f (Left  x) → Left x+    f (Right y) → Right (f y)++  iFunctorEither : Functor (Either a)+  iFunctorEither = record{DefaultFunctor iDefaultFunctorEither}++  iDefaultFunctorFun : DefaultFunctor (λ b → a → b)+  iDefaultFunctorFun .DefaultFunctor.fmap = _∘_++  iFunctorFun : Functor (λ b → a → b)+  iFunctorFun = record{DefaultFunctor iDefaultFunctorFun}++  iDefaultFunctorTuple₂ : DefaultFunctor (a ×_)+  iDefaultFunctorTuple₂ .DefaultFunctor.fmap = λ f (x , y) → x , f y++  iFunctorTuple₂ : Functor (a ×_)+  iFunctorTuple₂ = record{DefaultFunctor iDefaultFunctorTuple₂}++  iDefaultFunctorTuple₃ : DefaultFunctor (a × b ×_)+  iDefaultFunctorTuple₃ .DefaultFunctor.fmap = λ where f (x , y , z) → x , y , f z++  iFunctorTuple₃ : Functor (a × b ×_)+  iFunctorTuple₃ = record{DefaultFunctor iDefaultFunctorTuple₃}++instance postulate iFunctorIO : Functor IO
+ lib/base/Haskell/Prim/IO.agda view
@@ -0,0 +1,27 @@+module Haskell.Prim.IO where++open import Haskell.Prim+open import Haskell.Prim.Show+open import Haskell.Prim.String++postulate IO : ∀{a} → Type a → Type a++FilePath = String++postulate+  -- Input functions+  interact       : (String → String) → IO ⊤+  getContents    : IO String+  getLine        : IO String+  getChar        : IO Char++  -- Output functions+  print          : ⦃ Show a ⦄ → a → IO ⊤+  putChar        : Char → IO ⊤+  putStr         : String → IO ⊤+  putStrLn       : String → IO ⊤++  -- Files+  readFile       : FilePath → IO String+  writeFile      : FilePath → String → IO ⊤+  appendFile     : FilePath → String → IO ⊤
+ lib/base/Haskell/Prim/Int.agda view
@@ -0,0 +1,110 @@+{-# OPTIONS --no-auto-inline #-}++-- Agda doesn't have an Int type (only Word64). With some work we+-- can represent signed ints using Word64.++module Haskell.Prim.Int where++open import Haskell.Prim+open import Haskell.Prim.Word+open import Haskell.Prim.Integer+open import Haskell.Prim.Bool+++--------------------------------------------------+-- Definition++data Int : Type where+  int64 : Word64 → Int++intToWord : Int → Word64+intToWord (int64 a) = a++unsafeIntToNat : Int → Nat+unsafeIntToNat a = w2n (intToWord a)+++--------------------------------------------------+-- Literals++private+  2⁶⁴ : Nat+  2⁶⁴ = 18446744073709551616++  2⁶³ : Nat+  2⁶³ = 9223372036854775808++  maxInt : Nat+  maxInt = monusNat 2⁶³ 1++instance+  iNumberInt : Number Int+  iNumberInt .Number.Constraint n = IsTrue (ltNat n 2⁶³)+  iNumberInt .fromNat n = int64 (n2w n)++  iNegativeInt : Negative Int+  iNegativeInt .Negative.Constraint n = IsTrue (ltNat n (addNat 1 2⁶³))+  iNegativeInt .fromNeg n = int64 (n2w (monusNat 2⁶⁴ n))+++--------------------------------------------------+-- Arithmetic++isNegativeInt : Int → Bool+isNegativeInt (int64 w) = ltNat maxInt (w2n w)++eqInt : Int → Int → Bool+eqInt (int64 a) (int64 b) = eqNat (w2n a) (w2n b)++negateInt : Int → Int+negateInt (int64 a) = int64 (n2w (monusNat 2⁶⁴ (w2n a)))++intToInteger : Int → Integer+intToInteger a = if isNegativeInt a then negsuc (monusNat (unsafeIntToNat (negateInt a)) 1)+                                    else pos (unsafeIntToNat a)++integerToInt : Integer → Int+integerToInt (pos    n) = int64 (n2w n)+integerToInt (negsuc n) = negateInt (int64 (n2w (suc n)))++private+  ltPosInt : Int → Int → Bool+  ltPosInt (int64 a) (int64 b) = ltWord a b++ltInt : Int → Int → Bool+ltInt a b with isNegativeInt a | isNegativeInt b+... | True  | False = True+... | False | True  = False+... | True  | True  = ltPosInt (negateInt b) (negateInt a)+... | False | False = ltPosInt a b++addInt : Int → Int → Int+addInt (int64 a) (int64 b) = int64 (addWord a b)++subInt : Int → Int → Int+subInt a b = addInt a (negateInt b)++mulInt : Int → Int → Int+mulInt (int64 a) (int64 b) = int64 (mulWord a b)++absInt : Int → Int+absInt a = if isNegativeInt a then negateInt a else a++signInt : Int → Int+signInt a = if      isNegativeInt a then -1+            else if eqInt a 0       then 0 else 1++showInt : Int → List Char+showInt a = showInteger (intToInteger a)+++--------------------------------------------------+-- Constraints++@0 IsNonNegativeInt : Int → Type+IsNonNegativeInt a@(int64 _) =+  if isNegativeInt a then TypeError (primStringAppend (primStringFromList (showInt a)) " is negative")+                     else ⊤++intToNat : (a : Int) → @0 ⦃ IsNonNegativeInt a ⦄ → Nat+intToNat a = unsafeIntToNat a
+ lib/base/Haskell/Prim/Integer.agda view
@@ -0,0 +1,106 @@++module Haskell.Prim.Integer where++open import Haskell.Prim+open import Haskell.Prim.Bool++{-|+This module contains functions that should not be used+within code that is supposed to be translated to Haskell.+Nevertheless, these functions must be accessible for+proofs (within the standard library).+Hence, these functions are not flagged as private but+instead are collected in a dedicated module that is not+opened by default.+-}+module Internal where+  negNat : Nat → Integer+  negNat 0       = pos 0+  negNat (suc n) = negsuc n++  subNat : Nat → Nat → Integer+  subNat n       zero    = pos n+  subNat zero    (suc m) = negsuc m+  subNat (suc n) (suc m) = subNat n m+open Internal++--------------------------------------------------+-- Literals+++instance+  iNumberInteger : Number Integer+  iNumberInteger .Number.Constraint _ = ⊤+  iNumberInteger .fromNat n = pos n++  iNegativeInteger : Negative Integer+  iNegativeInteger .Negative.Constraint _ = ⊤+  iNegativeInteger .fromNeg n = negNat n+++--------------------------------------------------+-- Arithmetic++negateInteger : Integer → Integer+negateInteger (pos 0)       = pos 0+negateInteger (pos (suc n)) = negsuc n+negateInteger (negsuc n)    = pos (suc n)++addInteger : Integer → Integer → Integer+addInteger (pos    n) (pos    m) = pos (addNat n m)+addInteger (pos    n) (negsuc m) = subNat n (suc m)+addInteger (negsuc n) (pos    m) = subNat m (suc n)+addInteger (negsuc n) (negsuc m) = negsuc (suc (addNat n m))++subInteger : Integer → Integer → Integer+subInteger n m = addInteger n (negateInteger m)++mulInteger : Integer → Integer → Integer+mulInteger (pos    n) (pos    m) = pos (mulNat n m)+mulInteger (pos    n) (negsuc m) = negNat (mulNat n (suc m))+mulInteger (negsuc n) (pos    m) = negNat (mulNat (suc n) m)+mulInteger (negsuc n) (negsuc m) = pos (mulNat (suc n) (suc m))++absInteger : Integer → Integer+absInteger (pos    n) = pos n+absInteger (negsuc n) = pos (suc n)++signInteger : Integer → Integer+signInteger (pos 0)       = 0+signInteger (pos (suc _)) = 1+signInteger (negsuc _)    = -1+++--------------------------------------------------+-- Comparisons++eqInteger : Integer → Integer → Bool+eqInteger (pos n)    (pos m)    = eqNat n m+eqInteger (negsuc n) (negsuc m) = eqNat n m+eqInteger _          _          = False++ltInteger : Integer → Integer → Bool+ltInteger (pos    n) (pos    m) = ltNat n m+ltInteger (pos    n) (negsuc _) = False+ltInteger (negsuc n) (pos    _) = True+ltInteger (negsuc n) (negsuc m) = ltNat m n+++--------------------------------------------------+-- Show++showInteger : Integer → List Char+showInteger n = primStringToList (primShowInteger n)+++--------------------------------------------------+-- Constraints++isNegativeInteger : Integer → Bool+isNegativeInteger (pos _)    = False+isNegativeInteger (negsuc _) = True++@0 IsNonNegativeInteger : Integer → Type+IsNonNegativeInteger (pos _)      = ⊤+IsNonNegativeInteger n@(negsuc _) =+  TypeError (primStringAppend (primShowInteger n) (" is negative"))
+ lib/base/Haskell/Prim/List.agda view
@@ -0,0 +1,128 @@++module Haskell.Prim.List where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.Tuple+open import Haskell.Prim.Int+++--------------------------------------------------+-- List++map : (a → b) → List a → List b+map f []       = []+map f (x ∷ xs) = f x ∷ map f xs++infixr 5 _++_+_++_ : ∀ {@0 ℓ} {@0 a : Type ℓ} → List a → List a → List a+[]       ++ ys = ys+(x ∷ xs) ++ ys = x ∷ xs ++ ys++filter : (a → Bool) → List a → List a+filter p []       = []+filter p (x ∷ xs) = if p x then x ∷ filter p xs else filter p xs++scanl : (b → a → b) → b → List a → List b+scanl f z []       = z ∷ []+scanl f z (x ∷ xs) = z ∷ scanl f (f z x) xs++scanr : (a → b → b) → b → List a → List b+scanr f z [] = z ∷ []+scanr f z (x ∷ xs) =+  case scanr f z xs of λ where+    []         → [] -- impossible+    qs@(q ∷ _) → f x q ∷ qs++scanl1 : (a → a → a) → List a → List a+scanl1 f []       = []+scanl1 f (x ∷ xs) = scanl f x xs++scanr1 : (a → a → a) → List a → List a+scanr1 f []       = []+scanr1 f (x ∷ []) = x ∷ []+scanr1 f (x ∷ xs) =+  case scanr1 f xs of λ where+    []         → [] -- impossible+    qs@(q ∷ _) → f x q ∷ qs++takeWhile : (a → Bool) → List a → List a+takeWhile p [] = []+takeWhile p (x ∷ xs) = if p x then x ∷ takeWhile p xs else []++dropWhile : (a → Bool) → List a → List a+dropWhile p [] = []+dropWhile p (x ∷ xs) = if p x then dropWhile p xs else x ∷ xs++span : (a → Bool) → List a → List a × List a+span p [] = [] , []+span p (x ∷ xs) = if p x then first (x ∷_) (span p xs)+                         else ([] , x ∷ xs)++break : (a → Bool) → List a → List a × List a+break p = span (not ∘ p)++zipWith : (a → b → c) → List a → List b → List c+zipWith f []       _        = []+zipWith f _        []       = []+zipWith f (x ∷ xs) (y ∷ ys) = f x y ∷ zipWith f xs ys++zip : List a → List b → List (a × b)+zip = zipWith _,_++zipWith3 : (a → b → c → d) → List a → List b → List c → List d+zipWith3 f []       _        _        = []+zipWith3 f _        []       _        = []+zipWith3 f _        _        []       = []+zipWith3 f (x ∷ xs) (y ∷ ys) (z ∷ zs) = f x y z ∷ zipWith3 f xs ys zs++zip3 : List a → List b → List c → List (a × b × c)+zip3 = zipWith3 _,_,_++unzip : List (a × b) → List a × List b+unzip []              = [] , []+unzip ((x , y) ∷ xys) = (x ∷_) *** (y ∷_) $ unzip xys++unzip3 : List (a × b × c) → List a × List b × List c+unzip3 []                   = [] , [] , []+unzip3 ((x , y , z) ∷ xyzs) =+  case unzip3 xyzs of λ where+    (xs , ys , zs) → x ∷ xs , y ∷ ys , z ∷ zs++takeNat : Nat → List a → List a+takeNat n       [] = []+takeNat zero    xs = []+takeNat (suc n) (x ∷ xs) = x ∷ takeNat n xs++take : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a+take n xs = takeNat (intToNat n) xs++dropNat : Nat → List a → List a+dropNat n       [] = []+dropNat zero    xs = xs+dropNat (suc n) (_ ∷ xs) = dropNat n xs++drop : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a+drop n xs = dropNat (intToNat n) xs++splitAtNat : (n : Nat) → List a → List a × List a+splitAtNat _       []       = [] , []+splitAtNat 0       xs       = [] , xs+splitAtNat (suc n) (x ∷ xs) = first (x ∷_) (splitAtNat n xs)++splitAt : (n : Int) → @0 ⦃ IsNonNegativeInt n ⦄ → List a → List a × List a+splitAt n xs = splitAtNat (intToNat n) xs++head : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a+head (x ∷ _) = x++tail : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a+tail (_ ∷ xs) = xs++last : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → a+last (x ∷ [])         = x+last (_ ∷ xs@(_ ∷ _)) = last xs++init : (xs : List a) → @0 ⦃ NonEmpty xs ⦄ → List a+init (x ∷ [])         = []+init (x ∷ xs@(_ ∷ _)) = x ∷ init xs
+ lib/base/Haskell/Prim/Maybe.agda view
@@ -0,0 +1,14 @@+module Haskell.Prim.Maybe where++open import Haskell.Prim++--------------------------------------------------+-- Maybe++data Maybe {@0 ℓ} (a : Type ℓ) : Type ℓ where+  Nothing : Maybe a+  Just    : a -> Maybe a++maybe : ∀ {@0 ℓ₁ ℓ₂} {@0 a : Type ℓ₁} {@0 b : Type ℓ₂} → b → (a → b) → Maybe a → b+maybe n j Nothing  = n+maybe n j (Just x) = j x
+ lib/base/Haskell/Prim/Monad.agda view
@@ -0,0 +1,137 @@++module Haskell.Prim.Monad where++open import Haskell.Prim+open import Haskell.Prim.Applicative+open import Haskell.Prim.Either+open import Haskell.Prim.Foldable+open import Haskell.Prim.Functor+open import Haskell.Prim.IO+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Monoid+open import Haskell.Prim.String+open import Haskell.Prim.Tuple++-------------------------------------------------------------------------------+-- Monad++module Do where++  -- ** base+  record Monad (m : Type → Type) : Type₁ where+    field+      _>>=_ : m a → (a → m b) → m b+      overlap ⦃ super ⦄ : Applicative m+      return : a → m a+      _>>_ : m a → (@0 {{ a }} → m b) → m b+  -- ** defaults+  record DefaultMonad (m : Type → Type) : Type₁ where+    field+      _>>=_ : m a → (a → m b) → m b+      overlap ⦃ super ⦄ : Applicative m+    return : a → m a+    return = pure++    _>>_ : m a → (@0 {{ a }} → m b) → m b+    m >> m₁ = m >>= λ x → m₁ {{x}}++  -- ** export+  open Monad ⦃...⦄ public+  {-# COMPILE AGDA2HS Monad existing-class #-}++-- Use `Dont._>>=_` and `Dont._>>_` if you do not want agda2hs to use+-- do-notation.+module Dont where++  open Do using (Monad)++  _>>=_ : ⦃ Monad m ⦄ → m a → (a → m b) → m b+  _>>=_ = Do._>>=_++  _>>_ : ⦃ Monad m ⦄ → m a → (@0 {{ a }} → m b) → m b+  _>>_ = Do._>>_++open Do public++_=<<_ : {{Monad m}} → (a → m b) → m a → m b+_=<<_ = flip _>>=_++mapM₋ : ⦃ Monad m ⦄ → ⦃ Foldable t ⦄ → (a → m b) → t a → m ⊤+mapM₋ f = foldr (λ x k → f x >> k) (pure tt)++sequence₋ : ⦃ Monad m ⦄ → ⦃ Foldable t ⦄ → t (m a) → m ⊤+sequence₋ = foldr (λ mx my → mx >> my) (pure tt)++-- ** instances+instance+  iDefaultMonadList : DefaultMonad List+  iDefaultMonadList .DefaultMonad._>>=_ = flip concatMap++  iMonadList : Monad List+  iMonadList = record {DefaultMonad iDefaultMonadList}++  iDefaultMonadMaybe : DefaultMonad Maybe+  iDefaultMonadMaybe .DefaultMonad._>>=_ = flip (maybe Nothing)++  iMonadMaybe : Monad Maybe+  iMonadMaybe = record {DefaultMonad iDefaultMonadMaybe}++  iDefaultMonadEither : DefaultMonad (Either a)+  iDefaultMonadEither .DefaultMonad._>>=_ = flip (either Left)++  iMonadEither : Monad (Either a)+  iMonadEither = record {DefaultMonad iDefaultMonadEither}++  iDefaultMonadFun : DefaultMonad (λ b → a → b)+  iDefaultMonadFun .DefaultMonad._>>=_ = λ f k r → k (f r) r++  iMonadFun : Monad (λ b → a → b)+  iMonadFun = record {DefaultMonad iDefaultMonadFun}++  iDefaultMonadTuple₂ : ⦃ Monoid a ⦄ → DefaultMonad (a ×_)+  iDefaultMonadTuple₂ .DefaultMonad._>>=_ = λ (a , x) k → first (a <>_) (k x)++  iMonadTuple₂ : ⦃ Monoid a ⦄ → Monad (a ×_)+  iMonadTuple₂ = record {DefaultMonad iDefaultMonadTuple₂}++  iDefaultMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultMonad (a × b ×_)+  iDefaultMonadTuple₃ .DefaultMonad._>>=_ = λ where+    (a , b , x) k → case k x of λ where+      (a₁ , b₁ , y) → a <> a₁ , b <> b₁ , y++  iMonadTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monad (a × b ×_)+  iMonadTuple₃ = record {DefaultMonad iDefaultMonadTuple₃}++-- For 'Monad IO', we only postulate the '_>>=_' operation,+-- and construct the instance via 'DefaultMonad' as usual.+-- This is necessary to ensure that the existing 'Applicative IO'+-- instance is picked for the 'super' instance field.+postulate+  bindIO : IO a → (a → IO b) → IO b++instance  +  iDefaultMonadIO : DefaultMonad IO+  iDefaultMonadIO .DefaultMonad._>>=_ = bindIO++  iMonadIO : Monad IO+  iMonadIO = record {DefaultMonad iDefaultMonadIO}++-------------------------------------------------------------------------------+-- MonadFail class++record MonadFail (m : Type → Type) : Type₁ where+  field+    fail : String → m a+    overlap ⦃ super ⦄ : Monad m++open MonadFail ⦃...⦄ public++{-# COMPILE AGDA2HS MonadFail existing-class #-}++instance+  MonadFailList : MonadFail List+  MonadFailList .fail _ = []++  MonadFailMaybe : MonadFail Maybe+  MonadFailMaybe .fail _ = Nothing
+ lib/base/Haskell/Prim/Monoid.agda view
@@ -0,0 +1,130 @@++module Haskell.Prim.Monoid where++open import Haskell.Prim+open import Haskell.Prim.Bool+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Either+open import Haskell.Prim.Tuple++--------------------------------------------------+-- Semigroup++record Semigroup (a : Type) : Type where+  infixr 6 _<>_+  field _<>_ : a → a → a+open Semigroup ⦃...⦄ public+{-# COMPILE AGDA2HS Semigroup existing-class #-}++instance+  iSemigroupList : Semigroup (List a)+  iSemigroupList ._<>_ = _++_++  iSemigroupMaybe : ⦃ Semigroup a ⦄ → Semigroup (Maybe a)+  iSemigroupMaybe ._<>_          Nothing m = m+  iSemigroupMaybe ._<>_ m        Nothing   = m+  iSemigroupMaybe ._<>_ (Just x) (Just y)  = Just (x <> y)++  iSemigroupEither : Semigroup (Either a b)+  iSemigroupEither ._<>_ (Left _) e = e+  iSemigroupEither ._<>_ e        _ = e++  iSemigroupFun : ⦃ Semigroup b ⦄ → Semigroup (a → b)+  iSemigroupFun ._<>_ f g x = f x <> g x++  iSemigroupUnit : Semigroup ⊤+  iSemigroupUnit ._<>_ _ _ = tt+++  iSemigroupTuple₂ : ⦃ Semigroup a ⦄ → ⦃ Semigroup b ⦄ → Semigroup (a × b)+  iSemigroupTuple₂ ._<>_ (x₁ , y₁) (x₂ , y₂) = x₁ <> x₂ , y₁ <> y₂++  iSemigroupTuple₃ : ⦃ Semigroup a ⦄ → ⦃ Semigroup b ⦄ → ⦃ Semigroup c ⦄ → Semigroup (a × b × c)+  iSemigroupTuple₃ ._<>_ (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) = x₁ <> x₂ , y₁ <> y₂ , z₁ <> z₂+++--------------------------------------------------+-- Monoid++-- ** base+record Monoid (a : Type) : Type where+  field+    mempty : a+    overlap ⦃ super ⦄ : Semigroup a+    mappend : a → a → a+    mconcat : List a → a+-- ** defaults+record DefaultMonoid (a : Type) : Type where+  field+    mempty : a+    overlap ⦃ super ⦄ : Semigroup a++  mappend : a → a → a+  mappend = _<>_++  mconcat : List a → a+  mconcat []       = mempty+  mconcat (x ∷ xs) = x <> mconcat xs+-- ** export+open Monoid ⦃...⦄ public+{-# COMPILE AGDA2HS Monoid existing-class #-}+-- ** instances+instance+  iDefaultMonoidList : DefaultMonoid (List a)+  iDefaultMonoidList .DefaultMonoid.mempty = []++  iMonoidList : Monoid (List a)+  iMonoidList = record{DefaultMonoid iDefaultMonoidList}++  iDefaultMonoidMaybe : ⦃ Semigroup a ⦄ → DefaultMonoid (Maybe a)+  iDefaultMonoidMaybe .DefaultMonoid.mempty = Nothing++  iMonoidMaybe : ⦃ Semigroup a ⦄ → Monoid (Maybe a)+  iMonoidMaybe = record{DefaultMonoid iDefaultMonoidMaybe}++  iDefaultMonoidFun : ⦃ Monoid b ⦄ → DefaultMonoid (a → b)+  iDefaultMonoidFun .DefaultMonoid.mempty = λ _ → mempty++  iMonoidFun : ⦃ Monoid b ⦄ → Monoid (a → b)+  iMonoidFun = record{DefaultMonoid iDefaultMonoidFun}++  iDefaultMonoidUnit : DefaultMonoid ⊤+  iDefaultMonoidUnit .DefaultMonoid.mempty = tt++  iMonoidUnit : Monoid ⊤+  iMonoidUnit = record{DefaultMonoid iDefaultMonoidUnit}++  iDefaultMonoidTuple₂ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → DefaultMonoid (a × b)+  iDefaultMonoidTuple₂ .DefaultMonoid.mempty = (mempty , mempty)++  iMonoidTuple₂ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → Monoid (a × b)+  iMonoidTuple₂ = record{DefaultMonoid iDefaultMonoidTuple₂}++  iDefaultMonoidTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → ⦃ Monoid c ⦄ → DefaultMonoid (a × b × c)+  iDefaultMonoidTuple₃ .DefaultMonoid.mempty = (mempty , mempty , mempty)++  iMonoidTuple₃ : ⦃ Monoid a ⦄ → ⦃ Monoid b ⦄ → ⦃ Monoid c ⦄ →  Monoid (a × b × c)+  iMonoidTuple₃ = record{DefaultMonoid iDefaultMonoidTuple₃}++open DefaultMonoid++MonoidEndo : Monoid (a → a)+MonoidEndo = record {DefaultMonoid (λ where+      .mempty → id+      .super ._<>_ → _∘_)}++MonoidEndoᵒᵖ : Monoid (a → a)+MonoidEndoᵒᵖ = record {DefaultMonoid (λ where+  .mempty      → id+  .super ._<>_ → flip _∘_) }++MonoidConj : Monoid Bool+MonoidConj = record {DefaultMonoid (λ where+  .mempty      → True+  .super ._<>_ → _&&_)}++MonoidDisj : Monoid Bool+MonoidDisj = record {DefaultMonoid (λ where+  .mempty      → False+  .super ._<>_ → _||_)}
+ lib/base/Haskell/Prim/Num.agda view
@@ -0,0 +1,120 @@+{-# OPTIONS --no-auto-inline #-}++module Haskell.Prim.Num where++open import Haskell.Prim+open import Haskell.Prim.Word+open import Haskell.Prim.Int+open import Haskell.Prim.Integer+open import Haskell.Prim.Double+open import Haskell.Prim.Eq+open import Haskell.Prim.Ord+open import Haskell.Prim.Monoid++--------------------------------------------------+-- Num++record Num (a : Type) : Type₁ where+  infixl 6 _+_ _-_+  infixl 7 _*_+  field+    @0 MinusOK       : a → a → Type+    @0 NegateOK      : a → Type+    @0 FromIntegerOK : Integer → Type+    _+_           : a → a → a+    _-_           : (x y : a) → @0 ⦃ MinusOK x y ⦄ → a+    _*_           : a → a → a+    negate        : (x : a) → @0 ⦃ NegateOK x ⦄ → a+    abs           : a → a+    signum        : a → a+    fromInteger   : (n : Integer) → @0 ⦃ FromIntegerOK n ⦄ → a+    overlap ⦃ number ⦄  : Number a+    overlap ⦃ numZero ⦄ : number .Number.Constraint 0+    overlap ⦃ numOne ⦄  : number .Number.Constraint 1++open Num ⦃...⦄ public hiding (FromIntegerOK; number)++{-# COMPILE AGDA2HS Num existing-class #-}++instance+  iNumNat : Num Nat+  iNumNat .MinusOK n m      = IsFalse (ltNat n m)+  iNumNat .NegateOK 0       = ⊤+  iNumNat .NegateOK (suc _) = ⊥+  iNumNat .Num.FromIntegerOK (negsuc _) = ⊥+  iNumNat .Num.FromIntegerOK (pos _) = ⊤+  iNumNat ._+_ n m = addNat n m+  iNumNat ._-_ n m = monusNat n m+  iNumNat ._*_ n m = mulNat n m+  iNumNat .negate n = n+  iNumNat .abs    n = n+  iNumNat .signum 0       = 0+  iNumNat .signum (suc n) = 1+  iNumNat .fromInteger (pos n) = n+  iNumNat .fromInteger (negsuc _) ⦃ () ⦄++  iNumInt : Num Int+  iNumInt .MinusOK _ _         = ⊤+  iNumInt .NegateOK _          = ⊤+  iNumInt .Num.FromIntegerOK _ = ⊤+  iNumInt ._+_ x y             = addInt x y+  iNumInt ._-_ x y             = subInt x y+  iNumInt ._*_ x y             = mulInt x y+  iNumInt .negate x            = negateInt x+  iNumInt .abs x               = absInt x+  iNumInt .signum x            = signInt x+  iNumInt .fromInteger n       = integerToInt n++  iNumInteger : Num Integer+  iNumInteger .MinusOK _ _ = ⊤+  iNumInteger .NegateOK _          = ⊤+  iNumInteger .Num.FromIntegerOK _ = ⊤+  iNumInteger ._+_ x y             = addInteger x y+  iNumInteger ._-_ x y             = subInteger x y+  iNumInteger ._*_ x y             = mulInteger x y+  iNumInteger .negate x            = negateInteger x+  iNumInteger .abs x               = absInteger x+  iNumInteger .signum x            = signInteger x+  iNumInteger .fromInteger n       = n++  iNumWord : Num Word+  iNumWord .MinusOK _ _         = ⊤+  iNumWord .NegateOK _          = ⊤+  iNumWord .Num.FromIntegerOK _ = ⊤+  iNumWord ._+_ x y             = addWord x y+  iNumWord ._-_ x y             = subWord x y+  iNumWord ._*_ x y             = mulWord x y+  iNumWord .negate x            = negateWord x+  iNumWord .abs x               = x+  iNumWord .signum x            = if x == 0 then 0 else 1+  iNumWord .fromInteger n       = integerToWord n++  iNumDouble : Num Double+  iNumDouble .MinusOK _ _         = ⊤+  iNumDouble .NegateOK _          = ⊤+  iNumDouble .Num.FromIntegerOK _ = ⊤+  iNumDouble ._+_ x y             = primFloatPlus x y+  iNumDouble ._-_ x y             = primFloatMinus x y+  iNumDouble ._*_ x y             = primFloatTimes x y+  iNumDouble .negate x            = primFloatMinus 0.0 x+  iNumDouble .abs x               = if x < 0.0 then primFloatMinus 0.0 x else x+  iNumDouble .signum x            = case compare x 0.0 of λ where+                                      LT → -1.0+                                      EQ → x+                                      GT → 1.0+  iNumDouble .fromInteger (pos    n) = fromNat n+  iNumDouble .fromInteger (negsuc n) = fromNeg (suc n)++open DefaultMonoid++MonoidSum : ⦃ iNum : Num a ⦄ → Monoid a+MonoidSum = record {DefaultMonoid (λ where+  .mempty      → 0+  .super ._<>_ → _+_+ )}++MonoidProduct : ⦃ iNum : Num a ⦄ → Monoid a+MonoidProduct = record {DefaultMonoid (λ where+  .mempty      → 1+  .super ._<>_ → _*_+ )}
+ lib/base/Haskell/Prim/Ord.agda view
@@ -0,0 +1,234 @@++module Haskell.Prim.Ord where++open import Haskell.Prim+open import Haskell.Prim.Eq+open import Haskell.Prim.Bool+open import Haskell.Prim.Int+open import Haskell.Prim.Word+open import Haskell.Prim.Integer+open import Haskell.Prim.Double+open import Haskell.Prim.Tuple+open import Haskell.Prim.Monoid+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Either++--------------------------------------------------+-- Ordering++data Ordering : Type where+  LT EQ GT : Ordering++instance+  iEqOrdering : Eq Ordering+  iEqOrdering ._==_ LT LT = True+  iEqOrdering ._==_ EQ EQ = True+  iEqOrdering ._==_ GT GT = True+  iEqOrdering ._==_ _  _  = False++  iSemigroupOrdering : Semigroup Ordering+  iSemigroupOrdering ._<>_ LT _ = LT+  iSemigroupOrdering ._<>_ EQ o = o+  iSemigroupOrdering ._<>_ GT _ = GT++  iMonoidOrdering : Monoid Ordering+  iMonoidOrdering = record {DefaultMonoid (record {mempty = EQ})}++--------------------------------------------------+-- Ord++record Ord (a : Type) : Type where+  field+    compare : a → a → Ordering+    _<_  : a → a → Bool+    _>_  : a → a → Bool+    _>=_ : a → a → Bool+    _<=_ : a → a → Bool+    max  : a → a → a+    min  : a → a → a+    overlap ⦃ super ⦄ : Eq a++  infix 4 _<_ _>_ _<=_ _>=_++record OrdFromCompare (a : Type) : Type where+  field+    compare : a → a → Ordering+    overlap ⦃ super ⦄ : Eq a++  _<_  : a → a → Bool+  x < y = compare x y == LT++  _>_  : a → a → Bool+  x > y = compare x y == GT++  _>=_ : a → a → Bool+  x >= y = compare x y /= LT++  _<=_ : a → a → Bool+  x <= y = compare x y /= GT++  max  : a → a → a+  max x y = if compare x y == LT then y else x++  min  : a → a → a+  min x y = if compare x y == GT then y else x++record OrdFromLessThan (a : Type) : Type where+  field+    _<_ : a → a → Bool+    overlap ⦃ super ⦄ : Eq a++  compare : a → a → Ordering+  compare x y = if x < y then LT else if x == y then EQ else GT++  _>_  : a → a → Bool+  x > y = y < x++  _>=_ : a → a → Bool+  x >= y = y < x || x == y++  _<=_ : a → a → Bool+  x <= y = x < y || x == y++  max  : a → a → a+  max x y = if x < y then y else x++  min  : a → a → a+  min x y = if y < x then y else x+++open Ord ⦃...⦄ public++{-# COMPILE AGDA2HS Ord existing-class #-}++private+  compareFromLt : ⦃ Eq a ⦄ → (a → a → Bool) → a → a → Ordering+  compareFromLt _<_ x y = if x < y then LT else if x == y then EQ else GT++private+  maxNat : Nat → Nat → Nat+  maxNat zero    y       = y+  maxNat (suc x) zero    = suc x+  maxNat (suc x) (suc y) = suc (maxNat x y)++  minNat : Nat → Nat → Nat+  minNat zero    y       = zero+  minNat (suc x) zero    = zero+  minNat (suc x) (suc y) = suc (minNat x y)++instance+  iOrdFromLessThanNat : OrdFromLessThan Nat+  iOrdFromLessThanNat .OrdFromLessThan._<_ = ltNat++  iOrdNat : Ord Nat+  iOrdNat = record+    { OrdFromLessThan iOrdFromLessThanNat+    ; max = maxNat+    ; min = minNat+    }++  iOrdFromLessThanInteger : OrdFromLessThan Integer+  iOrdFromLessThanInteger .OrdFromLessThan._<_ = ltInteger++  iOrdInteger : Ord Integer+  iOrdInteger = record {OrdFromLessThan iOrdFromLessThanInteger}++  iOrdFromLessThanInt : OrdFromLessThan Int+  iOrdFromLessThanInt .OrdFromLessThan._<_ = ltInt++  iOrdInt : Ord Int+  iOrdInt = record {OrdFromLessThan iOrdFromLessThanInt}++  iOrdFromLessThanWord : OrdFromLessThan Word+  iOrdFromLessThanWord .OrdFromLessThan._<_ = ltWord++  iOrdWord : Ord Word+  iOrdWord = record {OrdFromLessThan iOrdFromLessThanWord}++  iOrdFromLessThanDouble : OrdFromLessThan Double+  iOrdFromLessThanDouble .OrdFromLessThan._<_ = primFloatLess++  iOrdDouble : Ord Double+  iOrdDouble = record {OrdFromLessThan iOrdFromLessThanDouble}++  iOrdFromLessThanChar : OrdFromLessThan Char+  iOrdFromLessThanChar .OrdFromLessThan._<_ x y = c2n x < c2n y++  iOrdChar : Ord Char+  iOrdChar = record {OrdFromLessThan iOrdFromLessThanChar}++  iOrdFromCompareBool : OrdFromCompare Bool+  iOrdFromCompareBool .OrdFromCompare.compare = λ where+    False True  → LT+    True  False → GT+    _     _     → EQ++  iOrdBool : Ord Bool+  iOrdBool = record {OrdFromCompare iOrdFromCompareBool}++  iOrdFromCompareUnit : OrdFromCompare ⊤+  iOrdFromCompareUnit .OrdFromCompare.compare = λ _ _ → EQ++  iOrdUnit : Ord ⊤+  iOrdUnit = record {OrdFromCompare iOrdFromCompareUnit}++  iOrdFromCompareTuple₂ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → OrdFromCompare (a × b)+  iOrdFromCompareTuple₂ .OrdFromCompare.compare = λ where+    (x₁ , y₁) (x₂ , y₂) → compare x₁ x₂ <> compare y₁ y₂++  iOrdTuple₂ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → Ord (a × b)+  iOrdTuple₂ = record {OrdFromCompare iOrdFromCompareTuple₂}++  iOrdFromCompareTuple₃ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → ⦃ Ord c ⦄ → OrdFromCompare (a × b × c)+  iOrdFromCompareTuple₃ .OrdFromCompare.compare = λ where+    (x₁ , y₁ , z₁) (x₂ , y₂ , z₂) → compare x₁ x₂ <> compare y₁ y₂ <> compare z₁ z₂++  iOrdTuple₃ : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → ⦃ Ord c ⦄ → Ord (a × b × c)+  iOrdTuple₃ = record {OrdFromCompare iOrdFromCompareTuple₃}++compareList : ⦃ Ord a ⦄ → List a → List a → Ordering+compareList []       []       = EQ+compareList []       (_ ∷ _)  = LT+compareList (_ ∷ _)  []       = GT+compareList (x ∷ xs) (y ∷ ys) = compare x y <> compareList xs ys++instance+  iOrdFromCompareList : ⦃ Ord a ⦄ → OrdFromCompare (List a)+  iOrdFromCompareList .OrdFromCompare.compare = compareList++  iOrdList : ⦃ Ord a ⦄ → Ord (List a)+  iOrdList = record {OrdFromCompare iOrdFromCompareList}++  iOrdFromCompareMaybe : ⦃ Ord a ⦄ → OrdFromCompare (Maybe a)+  iOrdFromCompareMaybe .OrdFromCompare.compare = λ where+    Nothing  Nothing  → EQ+    Nothing  (Just _) → LT+    (Just _) Nothing  → GT+    (Just x) (Just y) → compare x y++  iOrdMaybe : ⦃ Ord a ⦄ → Ord (Maybe a)+  iOrdMaybe = record {OrdFromCompare iOrdFromCompareMaybe}++  iOrdFromCompareEither : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → OrdFromCompare (Either a b)+  iOrdFromCompareEither .OrdFromCompare.compare = λ where+    (Left  x) (Left  y) → compare x y+    (Left  _) (Right _) → LT+    (Right _) (Left  _) → GT+    (Right x) (Right y) → compare x y++  iOrdEither : ⦃ Ord a ⦄ → ⦃ Ord b ⦄ → Ord (Either a b)+  iOrdEither = record {OrdFromCompare iOrdFromCompareEither}++  iOrdFromCompareOrdering : OrdFromCompare Ordering+  iOrdFromCompareOrdering .OrdFromCompare.compare = λ where+    LT LT → EQ+    LT _  → LT+    _  LT → GT+    EQ EQ → EQ+    EQ GT → LT+    GT EQ → GT+    GT GT → EQ++  iOrdOrdering : Ord Ordering+  iOrdOrdering = record {OrdFromCompare iOrdFromCompareOrdering}
+ lib/base/Haskell/Prim/Show.agda view
@@ -0,0 +1,159 @@++module Haskell.Prim.Show where++open import Haskell.Prim+open import Haskell.Prim.String+open import Haskell.Prim.List+open import Haskell.Prim.Word+open import Haskell.Prim.Double+open import Haskell.Prim.Maybe+open import Haskell.Prim.Eq+open import Haskell.Prim.Tuple+open import Haskell.Prim.Ord+open import Haskell.Prim.Either+open import Haskell.Prim.Integer+open import Haskell.Prim.Bool+open import Haskell.Prim.Int+open import Haskell.Prim.Foldable+++--------------------------------------------------+-- Show++ShowS : Type+ShowS = String → String++showChar : Char → ShowS+showChar = _∷_++showString : String → ShowS+showString = _++_++showParen : Bool → ShowS → ShowS+showParen False s = s+showParen True  s = showString "(" ∘ s ∘ showString ")"++defaultShowList : (a → ShowS) → List a → ShowS+defaultShowList shows = λ where+  []       → showString "[]"+  (x ∷ xs) → showString "["+           ∘ foldl (λ s x → s ∘ showString "," ∘ shows x) (shows x) xs+           ∘ showString "]"++-- ** base+record Show (a : Type) : Type where+  field+    showsPrec : Int → a → ShowS+    showList  : List a → ShowS+    show      : a → String+-- ** export+record Show₁ (a : Type) : Type where+  field showsPrec : Int → a → ShowS++  show : a → String+  show x = showsPrec 0 x ""++  showList : List a → ShowS+  showList = defaultShowList (showsPrec 0)+record Show₂ (a : Type) : Type where+  field show : a → String++  showsPrec : Int → a → ShowS+  showsPrec _ x s = show x ++ s++  showList : List a → ShowS+  showList = defaultShowList (showsPrec 0)+-- ** export+open Show ⦃...⦄ public++shows : ⦃ Show a ⦄ → a → ShowS+shows = showsPrec 0++{-# COMPILE AGDA2HS Show existing-class #-}++-- ** instances+instance+  iShow₂Nat : Show₂ Nat+  iShow₂Nat .Show₂.show = primStringToList ∘ primShowNat++  iShowNat : Show Nat+  iShowNat = record {Show₂ iShow₂Nat}++  iShow₂Integer : Show₂ Integer+  iShow₂Integer .Show₂.show = showInteger++  iShowInteger : Show Integer+  iShowInteger = record {Show₂ iShow₂Integer}++  iShow₂Int : Show₂ Int+  iShow₂Int .Show₂.show = showInt++  iShowInt : Show Int+  iShowInt = record{Show₂ iShow₂Int}++  iShow₂Word : Show₂ Word+  iShow₂Word .Show₂.show = showWord++  iShowWord : Show Word+  iShowWord = record{Show₂ iShow₂Word}++  iShow₂Double : Show₂ Double+  iShow₂Double .Show₂.show = primStringToList ∘ primShowFloat++  iShowDouble : Show Double+  iShowDouble = record{Show₂ iShow₂Double}++  iShow₂Bool : Show₂ Bool+  iShow₂Bool .Show₂.show = λ where False → "False"; True → "True"++  iShowBool : Show Bool+  iShowBool = record{Show₂ iShow₂Bool}++  iShow₁Char : Show₁ Char+  iShow₁Char .Show₁.showsPrec _ = showString ∘ primStringToList ∘ primShowChar++  iShowChar : Show Char+  iShowChar = record{Show₁ iShow₁Char}++  iShow₁List : ⦃ Show a ⦄ → Show₁ (List a)+  iShow₁List .Show₁.showsPrec _ = showList++  iShowList : ⦃ Show a ⦄ → Show (List a)+  iShowList = record{Show₁ iShow₁List}++private+  showApp₁ : ⦃ Show a ⦄ → Int → String → a → ShowS+  showApp₁ p tag x = showParen (p > 10) $+    showString tag ∘ showString " " ∘ showsPrec 11 x++instance+  iShow₁Maybe : ⦃ Show a ⦄ → Show₁ (Maybe a)+  iShow₁Maybe .Show₁.showsPrec = λ where+    p Nothing  → showString "Nothing"+    p (Just x) → showApp₁ p "Just" x++  iShowMaybe : ⦃ Show a ⦄ → Show (Maybe a)+  iShowMaybe = record{Show₁ iShow₁Maybe}++  iShow₁Either : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show₁ (Either a b)+  iShow₁Either .Show₁.showsPrec = λ where+    p (Left  x) → showApp₁ p "Left"  x+    p (Right y) → showApp₁ p "Right" y++  iShowEither : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show (Either a b)+  iShowEither = record{Show₁ iShow₁Either}++instance+  iShow₁Tuple₂ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show₁ (a × b)+  iShow₁Tuple₂ .Show₁.showsPrec = λ _ → λ where+    (x , y) → showString "(" ∘ shows x ∘ showString ", " ∘ shows y ∘ showString ")"++  iShowTuple₂ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → Show (a × b)+  iShowTuple₂ = record{Show₁ iShow₁Tuple₂}++  iShow₁Tuple₃ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → ⦃ Show c ⦄ → Show₁ (a × b × c)+  iShow₁Tuple₃ .Show₁.showsPrec = λ _ → λ where+    (x , y , z) → showString "(" ∘ shows x ∘ showString ", " ∘ shows y ∘ showString ", " ∘ shows z ∘ showString ")"++  iShowTuple₃ : ⦃ Show a ⦄ → ⦃ Show b ⦄ → ⦃ Show c ⦄ → Show (a × b × c)+  iShowTuple₃ = record{Show₁ iShow₁Tuple₃}
+ lib/base/Haskell/Prim/Strict.agda view
@@ -0,0 +1,12 @@++module Haskell.Prim.Strict where++open import Haskell.Prim++record Strict (a : Type ℓ) : Type ℓ where+  constructor !_+  field+    force : a+open Strict public++{-# COMPILE AGDA2HS Strict unboxed-strict #-}
+ lib/base/Haskell/Prim/String.agda view
@@ -0,0 +1,52 @@++module Haskell.Prim.String where++open import Haskell.Prim+open import Haskell.Prim.List+open import Haskell.Prim.Foldable++--------------------------------------------------+-- String+-- This is _not_ the builtin String type of Agda+-- which is defined by postulates.+-- `fromString` can be used to convert back+-- to builtin Agda strings.++String = List Char++instance+  iIsStringString : IsString String+  iIsStringString .IsString.Constraint _ = ⊤+  iIsStringString .fromString s = primStringToList s++private+  cons : Char → List String → List String+  cons c []       = (c ∷ []) ∷ []+  cons c (s ∷ ss) = (c ∷ s) ∷ ss++lines : String → List String+lines []         = []+lines ('\n' ∷ s) = [] ∷ lines s+lines (c    ∷ s) = cons c (lines s)++private+ mutual+  space : String → List String+  space [] = []+  space (c ∷ s) = if primIsSpace c then space s else cons c (word s)++  word  : String → List String+  word []      = []+  word (c ∷ s) = if primIsSpace c then [] ∷ space s else cons c (word s)++words : String → List String+words [] = []+words s@(c ∷ s₁) = if primIsSpace c then space s₁ else word s++unlines : List String → String+unlines = concatMap (_++ "\n")++unwords : List String → String+unwords [] = ""+unwords (w ∷ []) = w+unwords (w ∷ ws) = w ++ ' ' ∷ unwords ws
+ lib/base/Haskell/Prim/Thunk.agda view
@@ -0,0 +1,15 @@+{-# OPTIONS --sized-types #-}++module Haskell.Prim.Thunk where++open import Agda.Builtin.Size public++open import Haskell.Prim++record Thunk {ℓ} (a : @0 Size → Type ℓ) (@0 i : Size) : Type ℓ where+  constructor delay+  coinductive+  field force : {@0 j : Size< i} → a j+open Thunk public++{-# COMPILE AGDA2HS Thunk unboxed #-}
+ lib/base/Haskell/Prim/Traversable.agda view
@@ -0,0 +1,78 @@+++module Haskell.Prim.Traversable where++open import Haskell.Prim+open import Haskell.Prim.Applicative+open import Haskell.Prim.Functor+open import Haskell.Prim.Foldable+open import Haskell.Prim.Monad+open import Haskell.Prim.List+open import Haskell.Prim.Maybe+open import Haskell.Prim.Either+open import Haskell.Prim.Tuple++--------------------------------------------------+-- Traversable++-- ** base+record Traversable (t : Type → Type) : Type₁ where+  field+    traverse : ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b)+    overlap ⦃ functor ⦄ : Functor t+    overlap ⦃ foldable ⦄ : Foldable t++    sequenceA : ⦃ Applicative f ⦄ → t (f a) → f (t a)+    mapM : ⦃ Monad m ⦄ → (a → m b) → t a → m (t b)+    sequence : ⦃ Monad m ⦄ → t (m a) → m (t a)+-- ** defaults+record DefaultTraversable (t : Type → Type) : Type₁ where+  field+    traverse : ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b)+    overlap ⦃ functor ⦄ : Functor t+    overlap ⦃ foldable ⦄ : Foldable t++  sequenceA : ⦃ Applicative f ⦄ → t (f a) → f (t a)+  sequenceA = traverse id++  mapM : ⦃ Monad m ⦄ → (a → m b) → t a → m (t b)+  mapM = traverse++  sequence : ⦃ Monad m ⦄ → t (m a) → m (t a)+  sequence = sequenceA+-- ** export+open Traversable ⦃...⦄ public+{-# COMPILE AGDA2HS Traversable existing-class #-}+-- ** instances+private+  mkTraversable : DefaultTraversable t → Traversable t+  mkTraversable x = record {DefaultTraversable x}++  infix 0 traverse=_+  traverse=_ : ⦃ Functor t ⦄ → ⦃ Foldable t ⦄+            → (∀ {f a b} → ⦃ Applicative f ⦄ → (a → f b) → t a → f (t b))+            → Traversable t+  traverse= x = record {DefaultTraversable (record {traverse = x})}+instance+  open DefaultTraversable++  iTraversableList : Traversable List+  iTraversableList = traverse= traverseList+    where+      traverseList : ⦃ Applicative f ⦄ → (a → f b) → List a → f (List b)+      traverseList f []       = pure []+      traverseList f (x ∷ xs) = ⦇ f x ∷ traverseList f xs ⦈++  iTraversableMaybe : Traversable Maybe+  iTraversableMaybe = traverse= λ where+    f Nothing  → pure Nothing+    f (Just x) → Just <$> f x++  iTraversableEither : Traversable (Either a)+  iTraversableEither = traverse= λ where+    f (Left  x) → pure (Left x)+    f (Right y) → Right <$> f y++  iTraversablePair : Traversable (a ×_)+  iTraversablePair = traverse= λ+    f (x , y) → (x ,_) <$> f y
+ lib/base/Haskell/Prim/Tuple.agda view
@@ -0,0 +1,45 @@++module Haskell.Prim.Tuple where++open import Haskell.Prim++--------------------------------------------------+-- Tuples++infix 3 _×_ _×_×_++infix -1 _,_ _,_,_++record _×_ (a b : Type) : Type where+  constructor _,_+  field+    fst : a+    snd : b+open _×_ public++{-# COMPILE AGDA2HS _×_ tuple #-}++record _×_×_ (a b c : Type) : Type where+  no-eta-equality; pattern+  constructor _,_,_+  field+    fst3 : a+    snd3 : b+    thd3 : c++{-# COMPILE AGDA2HS _×_×_ tuple #-}++uncurry : (a → b → c) → a × b → c+uncurry f (x , y) = f x y++curry : (a × b → c) → a → b → c+curry f x y = f (x , y)++first : (a → b) → a × c → b × c+first f (x , y) = f x , y++second : (a → b) → c × a → c × b+second f (x , y) = x , f y++_***_ : (a → b) → (c → d) → a × c → b × d+(f *** g) (x , y) = f x , g y
+ lib/base/Haskell/Prim/Word.agda view
@@ -0,0 +1,54 @@++module Haskell.Prim.Word where++open import Haskell.Prim+open import Haskell.Prim.Integer++import Agda.Builtin.Word renaming (Word64 to Word)+open Agda.Builtin.Word public using (Word)+++--------------------------------------------------+-- Literals++module WordInternal where+  2⁶⁴ : Nat+  2⁶⁴ = 18446744073709551616+open WordInternal++instance+  iNumberWord : Number Word+  iNumberWord .Number.Constraint n = IsTrue (ltNat n 2⁶⁴)+  iNumberWord .fromNat n = n2w n+++--------------------------------------------------+-- Arithmetic++negateWord : Word → Word+negateWord a = n2w (monusNat 2⁶⁴ (w2n a))++addWord : Word → Word → Word+addWord a b = n2w (addNat (w2n a) (w2n b))++subWord : Word → Word → Word+subWord a b = addWord a (negateWord b)++mulWord : Word → Word → Word+mulWord a b = n2w (mulNat (w2n a) (w2n b))++eqWord : Word → Word → Bool+eqWord a b = eqNat (w2n a) (w2n b)++ltWord : Word → Word → Bool+ltWord a b = ltNat (w2n a) (w2n b)++showWord : Word → List Char+showWord a = primStringToList (primShowNat (w2n a))++integerToWord : Integer → Word+integerToWord (pos n)    = n2w n+integerToWord (negsuc n) = negateWord (n2w (suc n))++wordToInteger : Word → Integer+wordToInteger n = pos (w2n n)
+ lib/base/base.agda-lib view
@@ -0,0 +1,8 @@+-- This library+-- * mirrors the Haskell `base` package+-- * is intertwined with `agda2hs`++name: agda2hs-base+depend:+include: .+flags: -W noUnsupportedIndexedMatch --erasure --no-projection-like
src/Agda2Hs/AgdaUtils.hs view
@@ -26,6 +26,7 @@ import Agda.TypeChecking.Reduce ( reduceDefCopy )  import Agda.Utils.Either ( isRight )+import Agda.Utils.GetOpt ( OptDescr(..) , ArgDescr(..) ) import Agda.Utils.List ( initMaybe ) import qualified Agda.Utils.List1 as List1 import Agda.Utils.Monad ( ifM )@@ -143,3 +144,19 @@ endsInSort t = do   TelV tel b <- telView t   addContext tel $ ifIsSort b (\_ -> return True) (return False)++-- Heavily butchered version of the private function informationOptions in+-- Agda.Interaction.Options.Base, just for the purpose of checking if the+-- user has requested any information so we can disable the backend.+infoFlags :: [OptDescr ()]+infoFlags =+    [ Option ['V']  ["version"] (NoArg ()) ""+    , Option []     ["numeric-version"] (NoArg ()) ""+    , Option ['?']  ["help"] (OptArg (const ()) "HELP_TOPIC") ""+    , Option []     ["emacs-mode"] (ReqArg (const ()) "EMACS_MODE_COMMAND") ""+    , Option []     ["print-agda-dir"] (NoArg ()) ""+    , Option []     ["print-agda-app-dir"] (NoArg ()) ""+    , Option []     ["print-agda-data-dir"] (NoArg ()) ""+    , Option []     ["print-options"] (NoArg ()) ""+    , Option []     ["setup"] (NoArg ()) ""+    ]
src/Agda2Hs/Compile.hs view
@@ -1,7 +1,9 @@ module Agda2Hs.Compile where +import Prelude hiding (null)+ import Control.Monad.Trans.RWS.CPS ( evalRWST )-import Control.Monad.State ( gets )+import Control.Monad.State ( gets, liftIO ) import Control.Arrow ((>>>)) import Data.Functor import Data.List ( isPrefixOf, group, sort )@@ -10,6 +12,7 @@  import Agda.Compiler.Backend import Agda.Compiler.Common ( curIF )+import Agda.Utils.FileName ( isNewerThan ) import Agda.Syntax.TopLevelModuleName ( TopLevelModuleName ) import Agda.Syntax.Common.Pretty ( prettyShow ) import Agda.TypeChecking.Pretty@@ -17,21 +20,19 @@ import Agda.Utils.Impossible import Agda.Utils.List import Agda.Utils.Null-import Agda.Utils.Monad ( whenM, anyM, when )--import qualified Language.Haskell.Exts.Extension as Hs+import Agda.Utils.Monad ( whenM, anyM, when, unless )  import Agda2Hs.Compile.ClassInstance ( compileInstance ) import Agda2Hs.Compile.Data ( compileData ) import Agda2Hs.Compile.Function ( compileFun, checkTransparentPragma, checkInlinePragma )+import Agda2Hs.Compile.Name ( hsTopLevelModuleName ) import Agda2Hs.Compile.Postulate ( compilePostulate ) import Agda2Hs.Compile.Record ( compileRecord, checkUnboxPragma ) import Agda2Hs.Compile.Types-import Agda2Hs.Compile.Utils ( setCurrentRangeQ, tellExtension, primModules, isClassName )+import Agda2Hs.Compile.Utils import Agda2Hs.Pragma-import qualified Language.Haskell.Exts.Syntax as Hs-import qualified Language.Haskell.Exts.Pretty as Hs +import qualified Agda2Hs.Language.Haskell as Hs  initCompileEnv :: TopLevelModuleName -> SpecialRules -> CompileEnv initCompileEnv tlm rewrites = CompileEnv@@ -53,13 +54,22 @@ runC tlm rewrites c = evalRWST c (initCompileEnv tlm rewrites) initCompileState  moduleSetup :: Options -> IsMain -> TopLevelModuleName -> Maybe FilePath -> TCM (Recompile ModuleEnv ModuleRes)-moduleSetup _ _ m _ = do+moduleSetup opts _ m mifile = do   -- we never compile primitive modules   if any (`isPrefixOf` prettyShow m) primModules then pure $ Skip ()   else do-    reportSDoc "agda2hs.compile" 3 $ text "Compiling module: " <+> prettyTCM m-    setScope . iInsideScope =<< curIF-    return $ Recompile m+    -- check whether the file needs to be recompiled+    uptodate <- case mifile of+      Nothing -> pure False+      Just ifile -> let ofile = moduleFileName opts m in+        liftIO =<< isNewerThan <$> ofile <*> pure ifile+    if uptodate then do+      reportSDoc "agda2hs.compile" 3 $ text "Module " <+> prettyTCM m <+> text " is already up-to-date"+      return $ Skip ()+    else do+      reportSDoc "agda2hs.compile" 3 $ text "Compiling module: " <+> prettyTCM m+      setScope . iInsideScope =<< curIF+      return $ Recompile m  -- Main compile function ------------------------@@ -86,7 +96,7 @@       reportSDoc "agda2hs.compile" 45 $ text "Pragma:" <+> text (show p)       reportSDoc "agda2hs.compile" 45 $ text "Compiling definition:" <+> pretty (theDef def) -      isInstance <- anyM (defInstance def) $ isClassName . instanceClass+      isInstance <- anyM (isClassName . instanceClass) $ defInstance def        reportSDoc "agda2hs.compile" 15  $ text "Is instance?" <+> prettyTCM isInstance @@ -109,17 +119,18 @@         (DefaultPragma _     , Function{}) -> compileFun True def         (DefaultPragma ds    , Record{}  ) -> pure <$> compileRecord (ToRecord False ds) def -        _ -> genericDocError =<<  text "Don't know how to compile" <+> prettyTCM (defName def)+        _ -> agda2hsErrorM $ text "Don't know how to compile" <+> prettyTCM (defName def)      postCompile :: C ()     postCompile = whenM (gets $ lcaseUsed >>> (> 0)) $ tellExtension Hs.LambdaCase  verifyOutput ::   Options -> ModuleEnv -> IsMain -> TopLevelModuleName-  -> [(CompiledDef, CompileOutput)] -> TCM Bool+  -> [(CompiledDef, CompileOutput)] -> TCM () verifyOutput _ _ _ m ls = do   reportSDoc "agda2hs.compile" 5 $ text "Checking generated output before rendering: " <+> prettyTCM m   ensureUniqueConstructors+  ensureNoOutputFromHsModules   where     ensureUniqueConstructors = do       let allCons = do@@ -133,5 +144,19 @@               Hs.RecDecl _ n _ -> n           duplicateCons = filter ((> 1) . length) . group . sort  $ allCons       when (length duplicateCons > 0) $-        genericDocError =<< vcat (map (\x -> text $ "Cannot generate multiple constructors with the same identifier: " <> Hs.prettyPrint (headWithDefault __IMPOSSIBLE__ x)) duplicateCons)-      return (length duplicateCons == 0)+        agda2hsErrorM $ vcat (map (\x -> text $ "Cannot generate multiple constructors with the same identifier: " <> Hs.prettyPrint (headWithDefault __IMPOSSIBLE__ x)) duplicateCons)++    ensureNoOutputFromHsModules = unless (null $ concat $ map fst ls) $ do+      let hsModName = hsTopLevelModuleName m+      case hsModuleKind hsModName of+        HsModule -> do+          reportSDoc "agda2hs.compile" 10 $ text "Haskell module" <+> prettyTCM m <+> text "has non-null output."+          agda2hsErrorM $ hsep+            (  pwords "The `Haskell.` namespace are reserved for binding existing Haskell modules, so the module"+            ++ [text "`" <> prettyTCM m <> text "`"]+            ++ pwords "should not contain any"+            ++ [text "`{-# COMPILE AGDA2HS ... #-}`"]+            ++ pwords "pragmas that produce Haskell code."+            )+        PrimModule -> __IMPOSSIBLE__+        AgdaModule -> return ()
src/Agda2Hs/Compile/ClassInstance.hs view
@@ -8,9 +8,6 @@ import Data.Maybe ( isNothing, mapMaybe ) import qualified Data.HashMap.Strict as HMap -import qualified Language.Haskell.Exts as Hs-import Language.Haskell.Exts.Extension as Hs- import Agda.Compiler.Backend import Agda.Compiler.Common ( curDefs, sortDefs ) @@ -30,17 +27,20 @@ import Agda.TypeChecking.Telescope ( mustBePi, piApplyM )  import Agda.Utils.Lens+import Agda.Utils.List ( headWithDefault ) import Agda.Utils.Monad ( ifNotM ) import Agda.Utils.Impossible ( __IMPOSSIBLE__ )  import Agda2Hs.AgdaUtils import Agda2Hs.Compile.Function import Agda2Hs.Compile.Name+import Agda2Hs.Compile.Term import Agda2Hs.Compile.Type import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils-import Agda2Hs.HsUtils +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( hsName, pp, replaceName, unQual )  enableCopatterns :: C a -> C a enableCopatterns = local $ \e -> e { copatternsEnabled = True }@@ -65,7 +65,7 @@  compileInstance (ToDerivation strategy) def@Defn{..} =   setCurrentRangeQ defName $ do-    reportSDoc "agda2hs.compile.instance" 13 $ +    reportSDoc "agda2hs.compile.instance" 13 $       text "compiling instance" <+> prettyTCM defName <+> text "to standalone deriving"     tellExtension Hs.StandaloneDeriving     enableStrategy strategy@@ -74,7 +74,7 @@  compileInstance ToDefinition def@Defn{..} =   enableCopatterns $ setCurrentRangeQ defName $ do-    reportSDoc "agda2hs.compile.instance" 13 $ +    reportSDoc "agda2hs.compile.instance" 13 $       text "compiling instance" <+> prettyTCM defName <+> text "to instance definition"     ir <- compileInstRule [] (unEl defType)     withFunctionLocals defName $ do@@ -95,7 +95,7 @@           text "compileInstance compiled clauses: " :           map (nest 2 . text . pp) ds         when (length (nub rs) > 1) $-          genericDocError =<< fsep (pwords "More than one minimal record used.")+          agda2hsErrorM $ fsep (pwords "More than one minimal record used.")         return $ Hs.InstDecl () Nothing ir (Just ds)     where Function{..} = theDef @@ -139,7 +139,7 @@  etaExpandClause :: Clause -> C [Clause] etaExpandClause cl@Clause{clauseBody = Nothing} =-  genericError "Instance definition with absurd pattern!"+  agda2hsError "Instance definition with absurd pattern!" etaExpandClause cl@Clause{namedClausePats = ps, clauseBody = Just t} = do   case t of     Con c _ _ -> do@@ -148,7 +148,7 @@                       clauseBody      = Just $ t `applyE` [Proj ProjSystem $ unArg f] }                 | f <- fields ]       return cls-    _ -> genericDocError =<< fsep (pwords $+    _ -> agda2hsErrorM $ fsep (pwords $       "Type class instances must be defined using copatterns (or top-level" ++       " records) and cannot be defined using helper functions.") @@ -181,7 +181,7 @@   -- reached record projection   | ProjP _ q <- namedArg p = do -    -- we put back the remaining patterns in the original clause +    -- we put back the remaining patterns in the original clause     let c' = c {namedClausePats = ps}      -- We want the actual field name, not the instance-opened projection.@@ -198,9 +198,9 @@     -- retrieve the type of the projection     Just (unEl -> Pi a b) <- getDefType q ty     -- We don't really have the information available to reconstruct the instance-    -- head. However, all dependencies on the instance head are in erased positions, +    -- head. However, all dependencies on the instance head are in erased positions,     -- so we can just use a dummy term instead-    let instanceHead = __DUMMY_TERM__ +    let instanceHead = __DUMMY_TERM__         ty' = b `absApp` instanceHead      reportSDoc "agda2hs.compile.instance" 15 $@@ -222,9 +222,9 @@     if       -- Instance field: check canonicity.       | isInstance arg -> do-          unless (null ps) $ genericDocError =<< text "not allowed: explicitly giving superclass"+          unless (null ps) $ agda2hsError "not allowed: explicitly giving superclass"           body <- case clauseBody c' of-            Nothing -> genericDocError =<< text "not allowed: absurd clause for superclass"+            Nothing -> agda2hsError "not allowed: absurd clause for superclass"             Just b  -> return b           addContext (clauseTel c) $ do             liftTCM $ setModuleCheckpoint curModule@@ -245,8 +245,14 @@           text $ "raw name: " ++ prettyShow (Def n [])         d@Defn{..} <- getConstInfo n         let mod = if isExtendedLambdaName defName then curModule else qnameModule defName-        (fc, rs) <- withCurrentModule mod $ -          concatUnzip <$> mapM (compileInstanceClause mod defType) (funClauses theDef)+        let isMatchingProj [] = False+            isMatchingProj (p:ps) | ProjP _ g <- namedArg p = g .~ q+            isMatchingProj (p:ps) = isMatchingProj ps+        (fc, rs) <- withCurrentModule mod+            $ fmap concatUnzip+            . mapM (compileInstanceClause mod defType)+            . filter (isMatchingProj . namedClausePats)+            $ funClauses theDef         let hd = hsName $ prettyShow $ nameConcrete $ qnameName defName         let fc' = {- dropPatterns 1 $ -} replaceName hd uf fc         reportSDoc "agda2hs.compile.instance" 6 $ vcat $@@ -258,7 +264,7 @@        -- same (minimal) dictionary as the primitive fields.       | Clause {namedClausePats = [], clauseBody = Just (Def n es)} <- c'       , n .~ q -> do-        let err = genericDocError =<< text "illegal instance declaration: instances using default methods should use a named definition or an anonymous `λ where`."+        let err = agda2hsError $ "illegal instance declaration: instances using default methods should use a named definition or an anonymous `λ where`."             filterArgs :: Type -> [Term] -> C [Term]             filterArgs ty [] = return []             filterArgs ty (v:vs) = do@@ -309,7 +315,7 @@     df : _ -> return $ getArgInfo df     []     -> badness   where-    badness = genericDocError =<< text "Not a record field:" <+> prettyTCM f+    badness = agda2hsErrorM $ text "Not a record field:" <+> prettyTCM f   findDefinitions :: (QName -> Definition -> C Bool) -> ModuleName -> C [Definition]@@ -327,17 +333,17 @@   rname  <- liftTCM $ resolveName cqname   case rname of     DefinedName _ aname _ -> return $ anameName aname-    _ -> genericDocError =<< text ("Couldn't find " ++ s)+    _ -> agda2hsStringError $ "Couldn't find " ++ s   lookupDefaultImplementations :: QName -> [Hs.Name ()] -> C [Definition] lookupDefaultImplementations recName fields = do   let modName = qnameToMName recName-      isField f _ = (`elem` fields) . unQual <$> compileQName f+      isField f _ = (`elem` fields) <$> compileName (qnameName f)   findDefinitions isField modName  classMemberNames :: Definition -> C [Hs.Name ()] classMemberNames def =   case theDef def of     Record{recFields = fs} -> fmap unQual <$> traverse compileQName (map unDom fs)-    _ -> genericDocError =<< text "Not a record:" <+> prettyTCM (defName def)+    _ -> agda2hsErrorM $ text "Not a record:" <+> prettyTCM (defName def)
src/Agda2Hs/Compile/Data.hs view
@@ -1,7 +1,5 @@ module Agda2Hs.Compile.Data where -import qualified Language.Haskell.Exts.Syntax as Hs- import Control.Monad ( when ) import Agda.Compiler.Backend import Agda.Syntax.Common@@ -18,8 +16,10 @@ import Agda2Hs.Compile.Type ( compileDomType, compileTeleBinds ) import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils-import Agda2Hs.HsUtils +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( hsName )+ checkNewtype :: Hs.Name () -> [Hs.QualConDecl ()] -> C () checkNewtype name cs = do   checkSingleElement name cs "Newtype must have exactly one constructor in definition"@@ -51,9 +51,9 @@     allIndicesErased t = reduce (unEl t) >>= \case       Pi dom t -> compileDomType (absName t) dom >>= \case         DomDropped      -> allIndicesErased (unAbs t)-        DomType{}       -> genericDocError =<< text "Not supported: indexed datatypes"-        DomConstraint{} -> genericDocError =<< text "Not supported: constraints in types"-        DomForall{}     -> genericDocError =<< text "Not supported: indexed datatypes"+        DomType{}       -> agda2hsError "Not supported: indexed datatypes"+        DomConstraint{} -> agda2hsError "Not supported: constraints in types"+        DomForall{}     -> agda2hsError "Not supported: indexed datatypes"       _ -> return ()  compileConstructor :: [Arg Term] -> QName -> C (Hs.QualConDecl ())@@ -74,6 +74,6 @@   DomType s hsA     -> do     ty <- addTyBang s hsA     (ty :) <$> underAbstraction a tel compileConstructorArgs-  DomConstraint hsA -> genericDocError =<< text "Not supported: constructors with class constraints"+  DomConstraint hsA -> agda2hsError "Not supported: constructors with class constraints"   DomDropped        -> underAbstraction a tel compileConstructorArgs   DomForall{}       -> __IMPOSSIBLE__
src/Agda2Hs/Compile/Function.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} module Agda2Hs.Compile.Function where  import Control.Arrow ( (***) )@@ -10,8 +9,6 @@ import Data.Maybe ( fromMaybe, isJust ) import qualified Data.Text as Text -import qualified Language.Haskell.Exts as Hs- import Agda.Compiler.Backend import Agda.Compiler.Common @@ -46,8 +43,10 @@ import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils import Agda2Hs.Compile.Var ( compileDBVar )-import Agda2Hs.HsUtils +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils+  ( Strictness, hsName, pApp, patToExp, constrainType, qualifyType )  -- | Compilation rules for specific constructors in patterns. isSpecialCon :: QName -> Maybe (Type -> NAPs -> C (Hs.Pat ()))@@ -65,7 +64,7 @@       ]      itsBad :: Type -> NAPs -> C (Hs.Pat ())-    itsBad _ _ = genericDocError =<< "constructor `" <> prettyTCM qn <> "` not supported in patterns"+    itsBad _ _ = agda2hsErrorM $ "constructor `" <> prettyTCM qn <> "` not supported in patterns"  -- | Translate Int.pos pattern. posIntPat :: Type -> NAPs -> C (Hs.Pat ())@@ -92,7 +91,7 @@     | prettyShow (conName ch) == "Agda.Builtin.Nat.Nat.zero" -> return 0     | prettyShow (conName ch) == "Agda.Builtin.Nat.Nat.suc"     , [p] <- ps -> (1+) <$> compileLitNatPat (namedArg p)-  p -> genericDocError =<< "not a literal natural number pattern:" <?> prettyTCM p+  p -> agda2hsErrorM $ "not a literal natural number pattern:" <?> prettyTCM p   compileFun, compileFun'@@ -111,7 +110,7 @@   reportSDoc "agda2hs.compile" 6 $ "Compiling function: " <+> prettyTCM defName    whenM ((withSig &&) <$> inRecordMod defName) $-    genericDocError =<< text "not supported by agda2hs: functions inside a record module"+    agda2hsError "not supported: functions inside a record module"    ifM (endsInSort defType)     -- if the function type ends in Sort, it's a type alias!@@ -155,8 +154,8 @@       cs  <- map (addPats paramPats) <$>         mapMaybeM (compileClause m (Just defName) x typ) clauses -      when (null cs) $ genericDocError-        =<< text "Functions defined with absurd patterns exclusively are not supported."+      when (null cs) $ agda2hsErrorM $+            text "Functions defined with absurd patterns exclusively are not supported."         <+> text "Use function `error` from the Haskell.Prelude instead."        return $ sig ++ [Hs.FunBind () cs]@@ -260,7 +259,7 @@ compilePats ty ((namedArg -> ProjP po pn):ps) = do   reportSDoc "agda2hs.compile" 10 $ "compiling copattern: " <+> text (prettyShow pn)   unlessM (asks copatternsEnabled `or2M` (isJust <$> isUnboxProjection pn)) $-    genericDocError =<< "not supported in Haskell: copatterns"+    agda2hsError "not supported in Haskell: copatterns"    ty     <- fromMaybe __IMPOSSIBLE__ <$> getDefType pn ty   (a, b) <- mustBePi ty@@ -279,7 +278,7 @@     DOTerm     -> do       checkNoAsPatterns pat       (:) <$> compilePat (unDom a) pat <*> rest-  where checkForced  = when (isForcedPat pat) $ genericDocError =<< "not supported by agda2hs: forced (dot) patterns in non-erased positions"+  where checkForced  = when (isForcedPat pat) $ agda2hsError "not supported: forced (dot) patterns in non-erased positions"   compilePat :: Type -> DeBruijnPattern -> C (Hs.Pat ())@@ -309,7 +308,7 @@   -- nothing else is supported-compilePat _ p = genericDocError =<< "bad pattern:" <?> prettyTCM p+compilePat _ p = agda2hsErrorM $ "bad pattern:" <?> prettyTCM p   compileErasedConP :: Type -> Strictness -> NAPs -> C (Hs.Pat ())@@ -320,7 +319,7 @@ compileLitPat :: Literal -> C (Hs.Pat ()) compileLitPat = \case   LitChar c -> return $ Hs.charP c-  l -> genericDocError =<< "bad literal pattern:" <?> prettyTCM l+  l -> agda2hsErrorM $ "bad literal pattern:" <?> prettyTCM l  compileTupleConP :: Type -> Hs.Boxed -> NAPs -> C (Hs.Pat ()) compileTupleConP ty b ps = do@@ -389,7 +388,7 @@     checkTransparentTypeDef (Hs.DHApp _ _ (Hs.UnkindedVar _ x)) (Hs.TyVar _ y) | x == y = return ()     checkTransparentTypeDef _ _ = errNotTransparent -    errNotTransparent = genericDocError =<<+    errNotTransparent = agda2hsErrorM $       "Cannot make function" <+> prettyTCM (defName def) <+> "transparent." <+>       "A transparent function must have exactly one non-erased argument and return it unchanged." @@ -400,11 +399,11 @@   let Function{funClauses = cs} = theDef def   case filter (isJust . clauseBody) cs of     [c] ->-      unlessM (allowedPats (namedClausePats c)) $ genericDocError =<<+      unlessM (allowedPats (namedClausePats c)) $ agda2hsErrorM $         "Cannot make function" <+> prettyTCM (defName def) <+> "inlinable." <+>         "Inline functions can only use variable patterns or transparent record constructor patterns."     _ ->-      genericDocError =<<+      agda2hsErrorM $         "Cannot make function" <+> prettyTCM f <+> "inlinable." <+>         "An inline function must have exactly one clause." @@ -418,4 +417,4 @@         allowedPat _ = pure False          allowedPats :: NAPs -> C Bool-        allowedPats pats = allM pats (allowedPat . dget . dget)+        allowedPats pats = allM (allowedPat . dget . dget) pats
src/Agda2Hs/Compile/Function.hs-boot view
@@ -1,6 +1,6 @@ module Agda2Hs.Compile.Function where -import qualified Language.Haskell.Exts.Syntax as Hs ( Match, Name )+import qualified Agda2Hs.Language.Haskell as Hs ( Match, Name ) import Agda.Syntax.Internal ( Clause, ModuleName, QName, Type ) import Agda2Hs.Compile.Types ( C )
src/Agda2Hs/Compile/Imports.hs view
@@ -2,12 +2,14 @@  import Data.Char ( isUpper ) import Data.List ( isPrefixOf )+import qualified Data.List as L import Data.Map ( Map ) import qualified Data.Map as Map import Data.Set ( Set ) import qualified Data.Set as Set -import qualified Language.Haskell.Exts as Hs+import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( validVarId, validConId, pp )  import Agda.Compiler.Backend import Agda.TypeChecking.Pretty ( text )@@ -17,18 +19,18 @@ import Agda2Hs.Compile.Name import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils-import Agda2Hs.HsUtils-import qualified Data.List as L  type ImportSpecMap = Map NamespacedName (Set NamespacedName) type ImportDeclMap = Map (Hs.ModuleName (), Qualifier) ImportSpecMap  compileImports :: String -> Imports -> TCM [Hs.ImportDecl ()] compileImports top is0 = do-  let is = filter (not . (top `isPrefixOf`) . Hs.prettyPrint . importModule) is0+  let is = filter ((top /=) . Hs.prettyPrint . importModule) is0   checkClashingImports is   let imps = Map.toList $ groupModules is-  return $ map (uncurry $ uncurry makeImportDecl) imps+  reportSLn "agda2hs.import" 10 $ "All imported modules: " ++ show (map (pp . fst . fst) imps)+  let decls = map (uncurry $ uncurry makeImportDecl) imps+  return decls   where     mergeChildren :: ImportSpecMap -> ImportSpecMap -> ImportSpecMap     mergeChildren = Map.unionWith Set.union@@ -38,18 +40,20 @@     makeSingle (Just p) q = Map.singleton p $ Set.singleton q      groupModules :: [Import] -> ImportDeclMap-    groupModules = foldr-      (\(Import mod as p q ns) -> Map.insertWith mergeChildren (mod,as)-                                                                (makeSingle (parentNN p) (NamespacedName ns q)))-      Map.empty-        where-          parentNN :: Maybe (Hs.Name ()) -> Maybe NamespacedName-          parentNN (Just name@(Hs.Symbol _ _)) = Just $ NamespacedName (Hs.TypeNamespace ()) name-                                                                        -- ^ for parents, if they are operators, we assume they are type operators-                                                                        -- but actually, this will get lost anyway because of the structure of ImportSpec-                                                                        -- the point is that there should not be two tuples with the same name and diffenrent namespaces-          parentNN (Just name)                 = Just $ NamespacedName (Hs.NoNamespace ())   name-          parentNN Nothing                     = Nothing+    groupModules = flip foldr Map.empty $ \case+        (Import mod as p q ns) ->+          Map.insertWith mergeChildren (mod,as)+                         (makeSingle (parentNN p) (NamespacedName ns q))+        (ImportInstances mod) ->+          Map.insertWith mergeChildren (mod,Unqualified) Map.empty+      where+        parentNN :: Maybe (Hs.Name ()) -> Maybe NamespacedName+        parentNN (Just name@(Hs.Symbol _ _)) = Just $ NamespacedName (Hs.TypeNamespace ()) name+                                                                      -- ^ for parents, if they are operators, we assume they are type operators+                                                                      -- but actually, this will get lost anyway because of the structure of ImportSpec+                                                                      -- the point is that there should not be two tuples with the same name and diffenrent namespaces+        parentNN (Just name)                 = Just $ NamespacedName (Hs.NoNamespace ())   name+        parentNN Nothing                     = Nothing      -- TODO: avoid having to do this by having a CName instead of a     -- Name in the Import datatype@@ -77,15 +81,17 @@     checkClashingImports [] = return ()     checkClashingImports (Import mod as p q _ : is) =       case filter isClashing is of-        (i : _) -> genericDocError =<< text (mkErrorMsg i)+        (i : _) -> agda2hsStringError $ mkErrorMsg i         []      -> checkClashingImports is      where         isClashing (Import _ as' p' q' _) = (as' == as) && (p' /= p) && (q' == q)+        isClashing ImportInstances{} = False         mkErrorMsg (Import _ _ p' q' _) =              "Clashing import: " ++ pp q ++ " (both from "           ++ prettyShow (pp <$> p) ++ " and "           ++ prettyShow (pp <$> p') ++ ")"         -- TODO: no range information as we only have Haskell names at this point+    checkClashingImports (ImportInstances mod : is) = checkClashingImports is   -- | Generate a prelude import considering prelude config options (hiding, implicit, etc).
src/Agda2Hs/Compile/Name.hs view
@@ -8,12 +8,10 @@  import Data.Functor ( (<&>) ) import Data.Bifunctor ( bimap )-import Data.List ( intercalate, isPrefixOf )-import Data.Text ( unpack )+import Data.List ( intercalate, isPrefixOf, stripPrefix )+import qualified Data.Text as Text import qualified Data.Map.Strict as Map -import qualified Language.Haskell.Exts as Hs- import Agda.Compiler.Backend hiding ( topLevelModuleName ) import Agda.Compiler.Common ( topLevelModuleName ) @@ -31,17 +29,20 @@ import Agda.TypeChecking.Datatypes ( isDataOrRecordType ) import Agda.TypeChecking.Pretty import Agda.TypeChecking.Records ( isRecordConstructor )+import Agda.TypeChecking.Warnings ( warning )  import qualified Agda.Utils.List1 as List1 import Agda.Utils.Maybe ( isJust, isNothing, whenJust, fromMaybe, caseMaybeM )-import Agda.Utils.Monad ( whenM )+import Agda.Utils.Monad ( orM, whenM )  import Agda2Hs.AgdaUtils import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils-import Agda2Hs.HsUtils +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( hsName, hsModuleName, pp ) + isSpecialCon :: QName -> Maybe (Hs.QName ()) isSpecialCon = prettyShow >>> \case     "Agda.Builtin.List.List"     -> special Hs.ListCon@@ -64,7 +65,6 @@ defaultSpecialRules :: SpecialRules defaultSpecialRules = Map.fromList   [ "Agda.Builtin.Nat.Nat"          `to` "Natural"      `importing` Just "Numeric.Natural"-  , "Haskell.Control.Monad.guard"   `to` "guard"        `importing` Just "Control.Monad"   , "Haskell.Prelude.coerce"        `to` "unsafeCoerce" `importing` Just "Unsafe.Coerce"   , "Agda.Builtin.Int.Int"          `to` "Integer"      `importing` Nothing   , "Agda.Builtin.Word.Word64"      `to` "Word"         `importing` Nothing@@ -98,28 +98,50 @@       " to special constructor: " ++ Hs.prettyPrint c     return c   | otherwise = do-    f <- isRecordConstructor f >>= return . \case+    f <- isRecordConstructor f <&> \case       Just (r, def) | not (_recNamedCon def) -> r -- use record name for unnamed constructors       _                                      -> f     hf0 <- compileName (qnameName f)-    (hf, mimpBuiltin) <- fromMaybe (hf0, Nothing) <$> isSpecialName f+    special <- isSpecialName f+    let (hf, mimpBuiltin) = fromMaybe (hf0, Nothing) special+     parent <- parentName f     par <- traverse (compileName . qnameName) parent     let mod0 = qnameModule $ fromMaybe f parent-    mod <- compileModuleName mod0-    currMod <- hsTopLevelModuleName <$> asks currModule+    (mkind, mod) <- compileModuleName mod0++    existsInHaskell <- orM+      [ pure $ isJust special+      , pure $ mkind == PrimModule+      , pure $ mkind == HsModule+      , hasCompilePragma f+      , isClassFunction f+      , isWhereFunction f+      , maybe (pure False) hasCompilePragma parent+      ]++    unless existsInHaskell $ do+      reportSDoc "agda2hs.name" 20 $ text "DOES NOT EXIST IN HASKELL"+      typeError $ CustomBackendError "agda2hs" $ P.text $+        "Symbol " ++ Hs.prettyPrint hf ++ " is missing a COMPILE pragma or rewrite rule"++    currMod <- asks $ hsTopLevelModuleName . currModule     let skipModule = mod == currMod                   || isJust mimpBuiltin                   || prettyShow mod0 `elem` primMonadModules-    qual <- if | skipModule -> return Unqualified-               | otherwise  -> getQualifier (fromMaybe f parent) mod+    qual <- if skipModule then return Unqualified+              else getQualifier (fromMaybe f parent) mod     -- we only calculate this when dealing with type operators; usually that's where 'type' prefixes are needed in imports-    namespace <- (case hf of+    namespace <- case hf of           Hs.Symbol _ _ -> getNamespace f-          Hs.Ident  _ _ -> return (Hs.NoNamespace ()))+          Hs.Ident  _ _ -> return (Hs.NoNamespace ())     let-      (mod', mimp) = mkImport mod qual par hf namespace-      qf = qualify mod' hf qual+      -- We generate import statements for everything except+      -- unqualified prim modules (Prelude)+      mimp = if mkind == PrimModule && not (isQualified qual)+             then Nothing+             else Just (Import mod qual par hf namespace)+      qf = qualify mod hf qual      -- add (possibly qualified) import     whenM (asks writeImports) $@@ -138,7 +160,7 @@     return qf   where     parentName :: QName -> C (Maybe QName)-    parentName q = (theDef <$> getConstInfo q) >>= return . \case+    parentName q = (theDef <$> getConstInfo q) <&> \case       Constructor {conData = dt} -> Just dt       Function {funProjection = proj}         | Right (Projection {projProper = Just{}, projFromType = rt}) <- proj@@ -170,39 +192,44 @@     -- _getSort is not for that; e. g. a data has the same sort as its constructor.     getNamespace :: QName -> C (Hs.Namespace ())     getNamespace qName = do-      definition <- getConstInfo qName-      case isSort $ unEl $ getResultType $ defType definition of-        Just _         -> (reportSDoc "agda2hs.name" 25 $ text $ (prettyShow $ nameCanonical $ qnameName f)-                                              ++ " is a type operator; will add \"type\" prefix before it") >>-                          return (Hs.TypeNamespace ())-        _              -> return (Hs.NoNamespace ())+      qType <- unEl . getResultType . defType <$> getConstInfo qName+      if isJust $ isSort qType then do+        let fname = nameCanonical $ qnameName f+        reportSDoc "agda2hs.name" 25 $ pretty fname <+>+          " is a type operator; will add \"type\" prefix before it"+        return $ Hs.TypeNamespace ()+      else return $ Hs.NoNamespace ()      -- Gets the type of the result of the function (the type after the last "->").     getResultType :: Type -> Type-    getResultType typ = case (unEl typ) of+    getResultType typ = case unEl typ of       (Pi _ absType) -> getResultType $ unAbs absType       _              -> typ -    mkImport mod qual par hf maybeIsType-      -- make sure the Prelude is properly qualified-      | any (`isPrefixOf` pp mod) primModules-      = if isQualified qual then-          let mod' = hsModuleName "Prelude"-          in (mod', Just (Import mod' qual Nothing hf maybeIsType))-        else (mod, Nothing)-      | otherwise-      = (mod, Just (Import mod qual par hf maybeIsType))+isWhereFunction :: QName -> C Bool+isWhereFunction f = do+  whereMods <- asks whereModules+  return $ any (qnameModule f `isLeChildModuleOf`) whereMods  hsTopLevelModuleName :: TopLevelModuleName -> Hs.ModuleName ()-hsTopLevelModuleName = hsModuleName . intercalate "." . map unpack+hsTopLevelModuleName = hsModuleName . Text.unpack . Text.intercalate "."                      . List1.toList . moduleNameParts  -- | Given a module name (assumed to be a toplevel module), -- compute the associated Haskell module name.-compileModuleName :: ModuleName -> C (Hs.ModuleName ())+compileModuleName :: ModuleName -> C (HsModuleKind, Hs.ModuleName ()) compileModuleName m = do   tlm <- liftTCM $ hsTopLevelModuleName <$> getTopLevelModuleForModuleName m   reportSDoc "agda2hs.name" 25 $-    text "Top-level module name for" <+> prettyTCM m <+>-    text "is" <+> text (pp tlm)-  return tlm+    "Top-level module name for" <+> prettyTCM m <+> "is" <+> text (pp tlm)+  case hsModuleKind tlm of+    PrimModule -> return (PrimModule, Hs.ModuleName () "Prelude")+    HsModule   -> return (HsModule, dropHaskellPrefix tlm)+    AgdaModule -> return (AgdaModule, tlm)++importInstance :: QName -> C ()+importInstance f = do+  (kind, mod) <- compileModuleName $ qnameModule f+  unless (kind == PrimModule) $ do+    reportSLn "agda2hs.import" 20 $ "Importing instances from " ++ pp mod+    tellImport $ ImportInstances mod
src/Agda2Hs/Compile/Postulate.hs view
@@ -1,7 +1,5 @@ module Agda2Hs.Compile.Postulate where -import qualified Language.Haskell.Exts.Syntax as Hs- import Agda.Compiler.Backend  import Agda.Syntax.Internal@@ -10,7 +8,9 @@ import Agda2Hs.Compile.Type ( compileType ) import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils-import Agda2Hs.HsUtils++import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( hsName, pp, hsError )   compilePostulate :: Definition -> C [Hs.Decl ()] compilePostulate def = do
src/Agda2Hs/Compile/Record.hs view
@@ -8,15 +8,13 @@ import Data.Map ( Map ) import qualified Data.Map as Map -import qualified Language.Haskell.Exts as Hs- import Agda.Compiler.Backend -import Agda.Syntax.Common ( Arg(unArg), defaultArg )+import Agda.Syntax.Common ( Arg(unArg), defaultArg, HasEta'(..) ) import Agda.Syntax.Internal import Agda.Syntax.Common.Pretty ( prettyShow ) -import Agda.TypeChecking.Pretty ( ($$), (<+>), text, vcat, prettyTCM )+import Agda.TypeChecking.Pretty ( ($$), (<+>), text, vcat, prettyTCM, pretty, prettyList_ ) import Agda.TypeChecking.Substitute ( TelV(TelV), Apply(apply) ) import Agda.TypeChecking.Telescope @@ -29,8 +27,10 @@ import Agda2Hs.Compile.Type ( compileDomType, compileTeleBinds, compileDom, DomOutput(..) ) import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils-import Agda2Hs.HsUtils +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( hsName, definedName, pp, isQuantifiedAsst )+ -- | Primitive fields and default implementations type MinRecord = ([Hs.Name ()], Map (Hs.Name ()) (Hs.Decl ())) @@ -38,7 +38,10 @@ withMinRecord m = local $ \ e -> e { minRecordName = Just (qnameToMName m) }  compileMinRecord :: [Hs.Name ()] -> QName -> C MinRecord-compileMinRecord fieldNames m = do+compileMinRecord fieldNames m = withMinRecord m $ do+  reportSDoc "agda2hs.record.min" 20 $+    text "Compiling minimal record" <+> pretty m <+>+    text "with field names" <+> prettyList_ (map (text . pp) fieldNames)   rdef <- getConstInfo m   definedFields <- classMemberNames rdef   let Record{recPars = npars, recTel = tel} = theDef rdef@@ -48,9 +51,12 @@   -- We can't simply compileFun here for two reasons:   -- * it has an explicit dictionary argument   -- * it's using the fields and definitions from the minimal record and not the parent record-  compiled <- withMinRecord m $ addContext (defaultDom rtype) $ compileLocal $+  compiled <- addContext (defaultDom rtype) $ compileLocal $     fmap concat $ traverse (compileFun False) defaults   let declMap = Map.fromList [ (definedName c, def) | def@(Hs.FunBind _ (c : _)) <- compiled ]+  reportSDoc "agda2hs.record.min" 20 $+    text "Done compiling minimal record" <+> pretty m <+>+    text "defined fields: " <+> prettyList_ (map (text . pp) definedFields)   return (definedFields, declMap)  @@ -80,9 +86,9 @@   -- 2. assert that all default implementations are the same (for a certain field)   let getUnique f (x :| xs)         | all (x ==) xs = return x-        | otherwise     = genericDocError =<< do+        | otherwise     = agda2hsErrorM $ do           text ("Conflicting default implementations for " ++ pp f ++ ":") $$-            vcat [ text "-" <+> multilineText (pp d) | d <- nub (x : xs) ]+            vcat [ "-" <+> multilineText (pp d) | d <- nub (x : xs) ]   decls <- Map.traverseWithKey getUnique          $ Map.unionsWith (<>) $ (map . fmap) (:| []) defaults @@ -100,15 +106,19 @@     let fieldTel = snd $ splitTelescopeAt recPars recTel     case target of       ToClass ms -> do+        when (length binds > 1) $ tellExtension Hs.MultiParamTypeClasses         (classConstraints, classDecls) <- compileRecFields classDecl recFields fieldTel         let context = case classConstraints of               []     -> Nothing-              [asst] -> Just (Hs.CxSingle () asst)+              [asst] | not (isQuantifiedAsst asst) -> Just (Hs.CxSingle () asst)               assts  -> Just (Hs.CxTuple () assts)         defaultDecls <- compileMinRecords def ms         return $ Hs.ClassDecl () context hd [] (Just (classDecls ++ map (Hs.ClsDecl ()) defaultDecls))       ToRecord newtyp ds -> do         checkValidConName cName+        when (theEtaEquality recEtaEquality' == YesEta) $ agda2hsErrorM $+          "Agda records compiled to Haskell should have eta-equality disabled." <+>+          "Add no-eta-equality to the definition of" <+> (text (pp rName) <> ".")         (constraints, fieldDecls) <- compileRecFields fieldDecl recFields fieldTel         when newtyp $ checkNewtypeCon cName fieldDecls         let target = if newtyp then Hs.NewType () else Hs.DataType ()@@ -123,10 +133,10 @@     -- record module has been opened.     checkFieldInScope f = isInScopeUnqualified f >>= \case       True  -> return ()-      False -> setCurrentRangeQ f $ genericError $-        "Record projections (`" ++ prettyShow (qnameName f) ++-        "` in this case) must be brought into scope when compiling to Haskell record types. " ++-        "Add `open " ++ Hs.prettyPrint rName ++ " public` after the record declaration to fix this."+      False -> setCurrentRangeQ f $ agda2hsErrorM $+        ("Record projections (`" <> prettyTCM (qnameName f) <>"` in this case)") <+>+        "must be brought into scope when compiling to Haskell record types." <+>+        "Add `open" <+> text (Hs.prettyPrint rName) <+> "public` after the record declaration to fix this."      Record{..} = theDef def @@ -141,7 +151,7 @@     compileRecFields decl ns tel = case (ns, tel) of       (_   , EmptyTel          ) -> return ([], [])       (n:ns, ExtendTel dom tel') -> do-        hsDom <- compileDomType (absName tel') dom+        hsDom <- withNestedType $ compileDomType (absName tel') dom         (hsAssts, hsFields) <- underAbstraction dom tel' $ compileRecFields decl ns         case hsDom of           DomType s hsA -> do@@ -150,8 +160,10 @@             checkValidFunName fieldName             return (hsAssts, decl fieldName fieldType : hsFields)           DomConstraint hsA -> case target of-            ToClass{} -> return (hsA : hsAssts , hsFields)-            ToRecord{} -> genericError $+            ToClass{} -> do+              when (isQuantifiedAsst hsA) $ tellExtension Hs.QuantifiedConstraints+              return (hsA : hsAssts , hsFields)+            ToRecord{} -> agda2hsError $               "Not supported: record/class with constraint fields"           DomDropped -> return (hsAssts , hsFields)           DomForall{} -> __IMPOSSIBLE__@@ -176,24 +188,24 @@    -- recRecursive can be used again after agda 2.6.4.2 is released   -- see agda/agda#7042-  unless (all null recMutual) $ genericDocError-    =<< text "Unboxed record" <+> prettyTCM (defName def)-    <+> text "cannot be recursive"+  unless (all null recMutual) $ agda2hsErrorM $+        "Unboxed record" <+> prettyTCM (defName def)+    <+> "cannot be recursive"    TelV tel _ <- telViewUpTo recPars (defType def)   addContext tel $ do     pars <- getContextArgs     let fieldTel = recTel `apply` pars     fields <- nonErasedFields fieldTel-    unless (length fields == 1) $ genericDocError-      =<< text "Unboxed record" <+> prettyTCM (defName def)-      <+> text "should have exactly one non-erased field"+    unless (length fields == 1) $ agda2hsErrorM $+          "Unboxed record" <+> prettyTCM (defName def)+      <+> "should have exactly one non-erased field"    where     nonErasedFields :: Telescope -> C [String]     nonErasedFields EmptyTel = return []     nonErasedFields (ExtendTel a tel) = compileDom a >>= \case       DODropped  -> underAbstraction a tel nonErasedFields-      DOType -> genericDocError =<< text "Type field in unboxed record not supported"-      DOInstance -> genericDocError =<< text "Instance field in unboxed record not supported"+      DOType -> agda2hsError "Type field in unboxed record not supported"+      DOInstance -> agda2hsError "Instance field in unboxed record not supported"       DOTerm -> (absName tel:) <$> underAbstraction a tel nonErasedFields
src/Agda2Hs/Compile/Term.hs view
@@ -1,7 +1,8 @@ module Agda2Hs.Compile.Term where  import Control.Arrow ( (>>>), (&&&), second )-import Control.Monad ( unless, zipWithM )+import Control.Monad ( zipWithM )+import Control.Monad.Except import Control.Monad.Reader  import Data.Foldable ( toList )@@ -11,19 +12,22 @@ import qualified Data.Text as Text ( unpack ) import qualified Data.Set as Set ( singleton ) -import qualified Language.Haskell.Exts as Hs- import Agda.Syntax.Common.Pretty ( prettyShow ) import qualified Agda.Syntax.Common.Pretty as P import Agda.Syntax.Common import Agda.Syntax.Literal import Agda.Syntax.Internal +import Agda.TypeChecking.CheckInternal ( infer )+import Agda.TypeChecking.Constraints ( noConstraints )+import Agda.TypeChecking.Conversion ( equalTerm )+import Agda.TypeChecking.InstanceArguments ( findInstance )+import Agda.TypeChecking.MetaVars ( newInstanceMeta ) import Agda.TypeChecking.Monad import Agda.TypeChecking.Pretty import Agda.TypeChecking.Records ( shouldBeProjectible, isRecordType, recordFieldNames ) import Agda.TypeChecking.Datatypes ( getConType )-import Agda.TypeChecking.Reduce ( unfoldDefinitionStep, instantiate )+import Agda.TypeChecking.Reduce ( unfoldDefinitionStep, instantiate, reduce ) import Agda.TypeChecking.Substitute import Agda.TypeChecking.Telescope ( telView, mustBePi, piApplyM, flattenTel ) import Agda.TypeChecking.ProjectionLike ( reduceProjectionLike )@@ -35,14 +39,17 @@ import Agda.Utils.Size  import Agda2Hs.AgdaUtils-import Agda2Hs.Compile.Name ( compileQName )+import Agda2Hs.Compile.Name ( compileQName, importInstance )  import Agda2Hs.Compile.Type ( compileType, compileDom, DomOutput(..), compileTelSize ) import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils import Agda2Hs.Compile.Var ( compileDBVar )-import Agda2Hs.HsUtils +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils+  ( hsName, pp, eApp, hsLambda, hsUnqualName, hsVar )+ import {-# SOURCE #-} Agda2Hs.Compile.Function ( compileClause' ) import qualified Data.List as L @@ -101,7 +108,7 @@   -- fully applied   b : t : f : es' -> return $ Hs.If () b t f `eApp` es'   -- partially applied-  _               -> genericError "if_then_else_ must be fully applied"+  _               -> agda2hsError "if_then_else_ must be fully applied"   -- | Compile @case_of_@ to Haskell @\case@ expression.@@ -114,7 +121,7 @@     let lam [] = id         lam qs = Hs.Lambda () qs     in return $ eApp (Hs.Case () e [Hs.Alt () p (Hs.UnGuardedRhs () $ lam ps b) Nothing]) es'-  _ -> genericError "case_of_ must be fully applied to a lambda term"+  _ -> agda2hsError "case_of_ must be fully applied to a lambda term"   -- | Compile @the@ to an explicitly-annotated Haskell expression.@@ -123,14 +130,14 @@     annot    <- compileType typ     exp:args <- compileArgs ty args     pure (Hs.ExpTypeSig () exp annot `eApp` args)-expTypeSig _ _ = genericError "`the` must be fully applied"+expTypeSig _ _ = agda2hsError "`the` must be fully applied"  primWord64FromNat :: DefCompileRule primWord64FromNat ty args = compileArgs ty args >>= \case   -- literal   n@Hs.Lit{} : _ -> return n   -- anything else-  _ -> genericError "primWord64FromNat must be applied to a literal"+  _ -> agda2hsError "primWord64FromNat must be applied to a literal"   compileVar :: Int -> Type -> [Term] -> C (Hs.Exp ())@@ -224,7 +231,7 @@ compileTupleProjection f b wty w ty args = do   -- TODO: avoid redoing all of this work each time   -- by storing the fields of each tuple type somewhere-  when (b == Hs.Unboxed) $ genericError "projecting from unboxed tuples is not allowed"+  when (b == Hs.Unboxed) $ agda2hsError "projecting from unboxed tuples is not allowed"   reportSDoc "agda2hs.term.proj" 12 $ text "compiling tuple projection"   (r, pars, def) <- lift $ fromMaybe __IMPOSSIBLE__ <$> isRecordType wty   let fields = map unDom $ _recFields def@@ -233,8 +240,8 @@     [f1,f2] | f == f1 -> return $ hsName "fst"             | f == f2 -> return $ hsName "snd"             | otherwise -> __IMPOSSIBLE__-    fs' -> genericDocError =<<-      text ("cannot project from tuple with " ++ show (size fs') ++ " fields")+    fs' -> agda2hsStringError $+      "cannot project from tuple with " ++ show (size fs') ++ " fields"   cw <- compileTerm wty w   cargs <- compileArgs ty args   return $ eApp (Hs.Var () $ Hs.UnQual () fname) (cw:cargs)@@ -247,8 +254,8 @@     compileTupleField f ty = compileDom ty >>= \case       DODropped -> return Nothing       DOTerm -> return (Just f)-      DOType -> genericDocError =<< text "illegal type field in tuple record:" <+> prettyTCM f-      DOInstance -> genericDocError =<< text "illegal instance field in tuple record:" <+> prettyTCM f+      DOType -> agda2hsErrorM $ "illegal type field in tuple record:" <+> prettyTCM f+      DOInstance -> agda2hsErrorM $ "illegal instance field in tuple record:" <+> prettyTCM f   -- | Compile a projection(-like) definition@@ -382,7 +389,7 @@ int64Term :: ConCompileRule int64Term ty args = compileArgs ty args >>= \case   n@Hs.Lit{} : _ -> return n-  _ -> genericError "int64 must be applied to a literal"+  _ -> agda2hsError "int64 must be applied to a literal"  -- | @compileErasedApp@ compiles the application of unboxed constructors -- and transparent functions.@@ -451,8 +458,8 @@    v <- instantiate v -  let bad s t = genericDocError =<< vcat-        [ text "agda2hs: cannot compile" <+> text (s ++ ":")+  let bad s t = agda2hsErrorM $ vcat+        [ text "cannot compile" <+> text (s ++ ":")         , nest 2 $ prettyTCM t         ] @@ -503,8 +510,8 @@   -- usable domain, user-written lambda is preserved   else if getOrigin argi == UserWritten then do -    when (patternInTeleName `isPrefixOf` absName abs) $ genericDocError =<<-      text "Record pattern translation not supported. Use a pattern matching lambda instead."+    when (patternInTeleName `isPrefixOf` absName abs) $ agda2hsError $+      "Record pattern translation not supported. Use a pattern matching lambda instead."      reportSDoc "agda2hs.compile" 17 $ text "compiling regular lambda" @@ -568,7 +575,7 @@             $ unfoldDefinitionStep (Def f [] `applys` args) f (Apply . defaultArg <$> args)       case r of         YesReduction _ t -> pure t-        _ -> genericDocError =<< text "Could not reduce inline function" <+> prettyTCM f+        _ -> agda2hsErrorM $ text "Could not reduce inline function" <+> prettyTCM f      etaExpand (p:ps) ty args = do       (dom, cod) <- mustBePi ty@@ -604,7 +611,7 @@  clauseToAlt :: Hs.Match () -> C (Hs.Alt ()) clauseToAlt (Hs.Match _ _ [p] rhs wh) = pure $ Hs.Alt () p rhs wh-clauseToAlt (Hs.Match _ _ ps _ _)     = genericError "Pattern matching lambdas must take a single argument"+clauseToAlt (Hs.Match _ _ ps _ _)     = agda2hsError "Pattern matching lambdas must take a single argument" clauseToAlt Hs.InfixMatch{}           = __IMPOSSIBLE__  compileLiteral :: Literal -> C (Hs.Exp ())@@ -614,4 +621,43 @@ compileLiteral (LitChar c)   = return $ Hs.charE c compileLiteral (LitString t) = return $ Hs.Lit () $ Hs.String () s s   where s = Text.unpack t-compileLiteral l             = genericDocError =<< text "bad term:" <?> prettyTCM (Lit l)+compileLiteral l             = agda2hsErrorM $ text "bad term:" <?> prettyTCM (Lit l)+++checkInstance :: Term -> C ()+checkInstance u = do+  reportSDoc "agda2hs.checkInstance" 12 $ text "checkInstance" <+> prettyTCM u+  reduce u >>= \case+    Var x es -> do+      unlessM (isInstance <$> domOfBV x) illegalInstance+      checkInstanceElims es+    Def f es -> do+      unlessM (isJust . defInstance <$> getConstInfo f) illegalInstance+      importInstance f+      checkInstanceElims es+  -- We need to compile applications of `fromNat`, `fromNeg`, and+  -- `fromString` where the constraint type is ⊤ or IsTrue .... Ideally+  -- this constraint would be marked as erased but this would involve+  -- changing Agda builtins.+    Con c _ _+      | prettyShow (conName c) == "Agda.Builtin.Unit.tt" ||+        prettyShow (conName c) == "Haskell.Prim.IsTrue.itsTrue" ||+        prettyShow (conName c) == "Haskell.Prim.IsFalse.itsFalse" -> return ()+    _ -> illegalInstance++  where+    illegalInstance :: C ()+    illegalInstance = do+      reportSDoc "agda2hs.checkInstance" 15 $ text "illegal instance: " <+> pretty u+      agda2hsErrorM $ text "illegal instance: " <+> prettyTCM u++    checkInstanceElims :: Elims -> C ()+    checkInstanceElims = mapM_ checkInstanceElim++    checkInstanceElim :: Elim -> C ()+    checkInstanceElim (Apply v) =+      when (isInstance v && usableQuantity v) $+        checkInstance $ unArg v+    checkInstanceElim IApply{} = illegalInstance+    checkInstanceElim (Proj _ f) =+      unlessM (isInstance . defArgInfo <$> getConstInfo f) illegalInstance
src/Agda2Hs/Compile/Type.hs view
@@ -11,10 +11,6 @@ import Data.Maybe ( mapMaybe, isJust ) import qualified Data.Set as Set ( singleton ) -import qualified Language.Haskell.Exts.Syntax as Hs-import qualified Language.Haskell.Exts.Extension as Hs-import qualified Language.Haskell.Exts.Pretty as Hs- import Agda.Compiler.Backend hiding ( Args )  import Agda.Syntax.Common@@ -38,7 +34,9 @@ import Agda2Hs.Compile.Utils import Agda2Hs.Compile.Var import Agda2Hs.AgdaUtils-import Agda2Hs.HsUtils+import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils+  ( Strictness(Lazy), hsName, tApp, constrainType, qualifyType )   -- | Type definitions from the prelude that get special translation rules.@@ -69,7 +67,7 @@ delayType :: Elims -> C (Hs.Type ()) delayType (Apply a : _) = compileType (unArg a) delayType (_       : _) = __IMPOSSIBLE__-delayType [] = genericDocError =<< text "Cannot compile unapplied Delay type"+delayType [] = agda2hsError "Cannot compile unapplied Delay type"   -- | Compile an Agda term into a Haskell type, along with its strictness.@@ -94,7 +92,7 @@   instantiate t >>= \case     Pi a b -> do       reportSDoc "agda2hs.compile.type" 13 $ text "Compiling pi type (" <+> prettyTCM (absName b)-        <+> text ":" <+> prettyTCM a <+> text ") -> " <+> prettyTCM (unAbs b)+        <+> text ":" <+> prettyTCM a <+> text ") -> " <+> underAbstraction a b prettyTCM       let compileB = underAbstraction a b (compileType . unEl)       compileDomType (absName b) a >>= \case         DomType _ hsA -> Hs.TyFun () hsA <$> compileB@@ -105,8 +103,8 @@     Def f es -> maybeUnfoldCopy f es compileType $ \f es -> do       def <- getConstInfo f       if | not (usableModality def) ->-            genericDocError-              =<< text "Cannot use erased definition" <+> prettyTCM f+            agda2hsErrorM $+                  text "Cannot use erased definition" <+> prettyTCM f               <+> text "in Haskell type"          | Just semantics <- isSpecialType f -> setCurrentRange f $ semantics es          | Just args <- allApplyElims es ->@@ -120,11 +118,11 @@          | otherwise -> fail      Var x es | Just args <- allApplyElims es -> do-      xi <- lookupBV x-      unless (usableModality xi) $ genericDocError-        =<< text "Cannot use erased variable" <+> prettyTCM (var x)+      CtxVar _ ti <- lookupBV x+      unless (usableModality ti) $ agda2hsErrorM $+            text "Cannot use erased variable" <+> prettyTCM (var x)         <+> text "in Haskell type"-      vs <- compileTypeArgs (snd $ unDom xi) args+      vs <- compileTypeArgs (unDom ti) args       x  <- hsName <$> compileDBVar x       return $ tApp (Hs.TyVar () x) vs @@ -144,10 +142,10 @@          -- Rewrite `\x -> f x` to `f`          | Hs.TyApp _ f (Hs.TyVar _ y) <- body          , y == x0 -> return f-         | otherwise -> genericDocError =<< text "Not supported: type-level lambda" <+> prettyTCM t+         | otherwise -> agda2hsErrorM $ text "Not supported: type-level lambda" <+> prettyTCM t      _ -> fail-  where fail = genericDocError =<< text "Bad Haskell type:" <?> prettyTCM t+  where fail = agda2hsErrorM $ text "Bad Haskell type:" <?> prettyTCM t   compileTypeArgs :: Type -> Args -> C [Hs.Type ()]@@ -158,7 +156,7 @@   reportSDoc "agda2hs.compile.type" 16 $ text "                a =" <+> prettyTCM a   reportSDoc "agda2hs.compile.type" 16 $ text "         modality =" <+> prettyTCM (getModality a)   let rest = compileTypeArgs (absApp b $ unArg x) xs-  let fail msg = genericDocError =<< (text msg <> text ":") <+> parens (prettyTCM (absName b) <+> text ":" <+> prettyTCM (unDom a))+  let fail msg = agda2hsErrorM $ (text msg <> text ":") <+> parens (prettyTCM (absName b) <+> text ":" <+> prettyTCM (unDom a))   compileDom a >>= \case     DODropped -> rest     DOInstance -> fail "Type-level instance argument not supported"@@ -212,7 +210,7 @@    let [ Clause { namedClausePats = pats } ] = filter (isJust . clauseBody) cs -  when (length args < length pats) $ genericDocError =<<+  when (length args < length pats) $ agda2hsErrorM $     text "Cannot compile inlinable type alias" <+> prettyTCM f <+> text "as it must be fully applied."    r <- liftReduce $ locallyReduceDefs (OnlyReduceDefs $ Set.singleton f)@@ -220,7 +218,7 @@    case r of     YesReduction _ t -> compileType t-    _                -> genericDocError =<< text "Could not reduce inline type alias " <+> prettyTCM f+    _                -> agda2hsErrorM $ text "Could not reduce inline type alias " <+> prettyTCM f   data DomOutput = DOInstance | DODropped | DOType | DOTerm@@ -270,14 +268,14 @@ compileTeleBinds EmptyTel = return [] compileTeleBinds (ExtendTel a tel) = do   reportSDoc "agda2hs.compile.type" 15 $ text "Compiling type parameter: " <+> prettyTCM a-  let fail msg = genericDocError =<< (text msg <> text ":") <+> parens (prettyTCM (absName tel) <+> text ":" <+> prettyTCM (unDom a))+  let fail msg = agda2hsErrorM $ (text msg <> text ":") <+> parens (prettyTCM (absName tel) <+> text ":" <+> prettyTCM (unDom a))   compileDom a >>= \case     DODropped  -> underAbstraction a tel compileTeleBinds     DOType -> do       ha <- compileKeptTeleBind (hsName $ absName tel) (unDom a)       (ha:) <$> underAbstraction a tel compileTeleBinds-    DOInstance -> fail "Constraint in type parameter not supported"-    DOTerm -> fail "Term variable in type parameter not supported"+    DOInstance -> agda2hsError "Constraint in type parameter not supported"+    DOTerm -> agda2hsError "Term variable in type parameter not supported"  compileKeptTeleBind :: Hs.Name () -> Type -> C (Hs.TyVarBind ()) compileKeptTeleBind x t = do@@ -295,4 +293,4 @@     DOInstance -> err   _ -> err   where-    err = genericDocError =<< text "Not a valid Haskell kind: " <+> prettyTCM t+    err = agda2hsErrorM $ text "Not a valid Haskell kind: " <+> prettyTCM t
src/Agda2Hs/Compile/TypeDefinition.hs view
@@ -4,8 +4,6 @@  import Data.Maybe ( fromMaybe ) -import qualified Language.Haskell.Exts.Syntax as Hs- import Agda.Compiler.Backend  import Agda.Syntax.Common ( namedArg )@@ -21,10 +19,11 @@ import Agda2Hs.Compile.Types import Agda2Hs.Compile.Utils import Agda2Hs.Compile.Var ( compileDBVar )-import Agda2Hs.HsUtils import Agda.Syntax.Common.Pretty (prettyShow) import Agda.TypeChecking.Substitute +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( hsName )  compileTypeDef :: Hs.Name () -> Definition -> C [Hs.Decl ()] compileTypeDef name (Defn {..}) = do@@ -39,7 +38,7 @@     Function{..} = theDef     singleClause = \case       [cl] -> return cl-      _    -> genericError "Not supported: type definition with several clauses"+      _    -> agda2hsError "Not supported: type definition with several clauses"  compileTypePatternArgs :: Type -> NAPs -> C [Hs.TyVarBind ()] compileTypePatternArgs ty naps = do@@ -49,11 +48,11 @@     assertIsTyVarBind :: Hs.Type () -> C (Hs.TyVarBind ())     assertIsTyVarBind = \case       Hs.TyVar _ n -> pure $ Hs.UnkindedVar () n-      _ -> genericError "Not supported: type definition by pattern matching"+      _ -> agda2hsError "Not supported: type definition by pattern matching"  compileTypeArg :: DeBruijnPattern -> C (Hs.TyVarBind ()) compileTypeArg p@(VarP o i) = do   name <- hsName <$> compileDBVar (dbPatVarIndex i)   checkValidTyVarName name   return $ Hs.UnkindedVar () name-compileTypeArg _ = genericError "Not supported: type definition by pattern matching"+compileTypeArg _ = agda2hsError "Not supported: type definition by pattern matching"
src/Agda2Hs/Compile/Types.hs view
@@ -14,18 +14,15 @@ import Data.Map ( Map ) import Data.String ( IsString(..) ) -import qualified Language.Haskell.Exts.SrcLoc as Hs-import qualified Language.Haskell.Exts.Syntax as Hs-import qualified Language.Haskell.Exts.Extension as Hs-import qualified Language.Haskell.Exts.Comments as Hs- import Agda.Compiler.Backend import Agda.Syntax.Position ( Range ) import Agda.Syntax.TopLevelModuleName ( TopLevelModuleName )+import Agda.TypeChecking.Warnings ( MonadWarning ) import Agda.Utils.Null import Agda.Utils.Impossible -import Agda2Hs.HsUtils ( Strictness )+import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( Strictness )  type ModuleEnv   = TopLevelModuleName type ModuleRes   = ()@@ -107,16 +104,21 @@  -- | Encoding of a Haskell module import statement. data Import = Import-  { importModule    :: Hs.ModuleName ()-  , importQualified :: Qualifier-  , importParent    :: Maybe (Hs.Name ())-  , importName      :: Hs.Name ()-  , importNamespace :: Hs.Namespace ()+  { _importModule    :: Hs.ModuleName ()+  , _importQualified :: Qualifier+  , _importParent    :: Maybe (Hs.Name ())+  , _importName      :: Hs.Name ()+  , _importNamespace :: Hs.Namespace ()                     -- ^^ if this is a type or something like that, we can add a namespace qualifier to the import spec                     -- now it's only useful for differentiating type operators; so for others we always put Hs.NoNamespace () here                     -- (we don't calculate it if it's not necessary)   }+  | ImportInstances (Hs.ModuleName ()) +importModule :: Import -> Hs.ModuleName ()+importModule (Import{ _importModule = mod }) = mod+importModule (ImportInstances mod) = mod+ type Imports = [Import]  -- | Output produced during the compilation of a module@@ -174,6 +176,7 @@   runStConcreteNames m = rwsT $ \r s -> runStConcreteNames $ StateT $ \ns -> do     ((x, ns'), s', w) <- runRWST (runStateT m ns) r s     pure ((x, s', w), ns')+instance MonadWarning C where instance IsString a => IsString (C a) where fromString = pure . fromString instance PureTCM C where instance Null a => Null (C a) where
src/Agda2Hs/Compile/Utils.hs view
@@ -7,12 +7,19 @@ import Control.Monad.Writer ( tell ) import Control.Monad.State ( put, modify ) +import Data.List ( isPrefixOf, stripPrefix ) import Data.Maybe ( isJust ) import qualified Data.Map as M+import Data.String ( IsString(..) ) +import GHC.Stack (HasCallStack)+ import qualified Language.Haskell.Exts as Hs +import System.FilePath ( (</>) )+ import Agda.Compiler.Backend hiding ( Args )+import Agda.Compiler.Common ( compileDir )  import Agda.Syntax.Common import qualified Agda.Syntax.Concrete.Name as C@@ -20,6 +27,7 @@ import Agda.Syntax.Position ( noRange ) import Agda.Syntax.Scope.Base import Agda.Syntax.Scope.Monad ( bindVariable, freshConcreteName, isDatatypeModule )+import Agda.Syntax.TopLevelModuleName import Agda.Syntax.Common.Pretty ( prettyShow ) import qualified Agda.Syntax.Common.Pretty as P @@ -44,12 +52,30 @@ import AgdaInternals import Agda2Hs.AgdaUtils ( (~~) ) import Agda2Hs.Compile.Types-import Agda2Hs.HsUtils import Agda2Hs.Pragma import qualified Data.List as L import Agda.Utils.Impossible ( __IMPOSSIBLE__ ) +import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils+  ( Strictness(..), validVarName, validTypeName, validConName, hsName, pp ) +agda2hsError :: (HasCallStack, MonadTCError m) => Doc -> m a+agda2hsError msg = typeError $ CustomBackendError "agda2hs" msg++agda2hsErrorM :: (HasCallStack, MonadTCError m) => m Doc -> m a+agda2hsErrorM msg = agda2hsError =<< msg++agda2hsStringError :: (HasCallStack, MonadTCError m) => String -> m a+agda2hsStringError = agda2hsError . fromString+++data HsModuleKind+  = PrimModule+  | HsModule+  | AgdaModule+  deriving (Eq)+ -- | Primitive modules provided by the agda2hs library. -- None of those (and none of their children) will get processed. primModules =@@ -57,10 +83,18 @@   , "Agda.Primitive"   , "Haskell.Prim"   , "Haskell.Prelude"-  , "Haskell.Law"   ] +hsModuleKind :: Hs.ModuleName () -> HsModuleKind+hsModuleKind mod+  | any (`isPrefixOf` pp mod) primModules = PrimModule+  | "Haskell." `isPrefixOf` pp mod        = HsModule+  | otherwise                             = AgdaModule +dropHaskellPrefix :: Hs.ModuleName () -> Hs.ModuleName ()+dropHaskellPrefix (Hs.ModuleName l s) =+  Hs.ModuleName l $ fromMaybe s $ stripPrefix "Haskell." s+ concatUnzip :: [([a], [b])] -> ([a], [b]) concatUnzip = (concat *** concat) . unzip @@ -102,7 +136,7 @@     Con c _ es       | []      <- vis es, conName c ~~ nil  -> return []       | [x, xs] <- vis es, conName c ~~ cons -> (x :) <$> makeList' nil cons err xs-    _ -> genericDocError =<< err+    _ -> agda2hsErrorM err   where     vis es = [ unArg a | Apply a <- es, visible a ] @@ -112,7 +146,7 @@     ConP c _ ps       | []      <- vis ps, conName c ~~ nil  -> return []       | [x, xs] <- vis ps, conName c ~~ cons -> (x :) <$> makeListP' nil cons err xs-    _ -> genericDocError =<< err+    _ -> agda2hsErrorM err   where     vis ps = [ namedArg p | p <- ps, visible p ] @@ -152,6 +186,18 @@   ]   where b = El __DUMMY_SORT__ x +hasCompilePragma :: QName -> C Bool+hasCompilePragma q = processPragma q <&> \case+  NoPragma{} -> False+  InlinePragma{} -> True+  DefaultPragma{} -> True+  ClassPragma{} -> True+  ExistingClassPragma{} -> True+  UnboxPragma{} -> True+  TransparentPragma{} -> True+  NewTypePragma{} -> True+  DerivePragma{} -> True+ -- Exploits the fact that the name of the record type and the name of the record module are the -- same, including the unique name ids. isClassFunction :: QName -> C Bool@@ -189,6 +235,12 @@   True  -> dropClassModule $ MName $ init ns   False -> return m +-- Gets the path of the Haskell file to be generated+moduleFileName :: Options -> TopLevelModuleName -> TCM FilePath+moduleFileName opts name = do+  outDir <- compileDir+  return $ fromMaybe outDir (optOutDir opts) </> moduleNameToFileName name "hs"+ isUnboxRecord :: QName -> C (Maybe Strictness) isUnboxRecord q = do   getConstInfo q >>= \case@@ -237,44 +289,6 @@       (InlinePragma ==) <$> processPragma r     _ -> return False -checkInstance :: Term -> C ()-checkInstance u = do-  reportSDoc "agda2hs.checkInstance" 12 $ text "checkInstance" <+> prettyTCM u-  reduce u >>= \case-    Var x es -> do-      unlessM (isInstance <$> domOfBV x) illegalInstance-      checkInstanceElims es-    Def f es -> do-      unlessM (isJust . defInstance <$> getConstInfo f) illegalInstance-      checkInstanceElims es-  -- We need to compile applications of `fromNat`, `fromNeg`, and-  -- `fromString` where the constraint type is ⊤ or IsTrue .... Ideally-  -- this constraint would be marked as erased but this would involve-  -- changing Agda builtins.-    Con c _ _-      | prettyShow (conName c) == "Agda.Builtin.Unit.tt" ||-        prettyShow (conName c) == "Haskell.Prim.IsTrue.itsTrue" ||-        prettyShow (conName c) == "Haskell.Prim.IsFalse.itsFalse" -> return ()-    _ -> illegalInstance--  where-    illegalInstance :: C ()-    illegalInstance = do-      reportSDoc "agda2hs.checkInstance" 15 $ text "illegal instance: " <+> pretty u-      genericDocError =<< text "illegal instance: " <+> prettyTCM u--    checkInstanceElims :: Elims -> C ()-    checkInstanceElims = mapM_ checkInstanceElim--    checkInstanceElim :: Elim -> C ()-    checkInstanceElim (Apply v) = case getHiding v of-      Instance{} -> checkInstance $ unArg v-      Hidden     -> return ()-      NotHidden  -> return ()-    checkInstanceElim IApply{} = illegalInstance-    checkInstanceElim (Proj _ f) =-      unlessM (isInstance . defArgInfo <$> getConstInfo f) illegalInstance- withNestedType :: C a -> C a withNestedType = local $ \e -> e { isNestedInType = True } @@ -296,29 +310,29 @@ hsLCase = (incrementLCase >>) . return . Hs.LCase ()  ensureNoLocals :: String -> C ()-ensureNoLocals msg = unlessM (null <$> asks locals) $ genericError msg+ensureNoLocals msg = unlessM (null <$> asks locals) $ agda2hsStringError msg  withLocals :: LocalDecls -> C a -> C a withLocals ls = local $ \e -> e { locals = ls }  checkValidVarName :: Hs.Name () -> C ()-checkValidVarName x = unless (validVarName x) $ genericDocError =<< do+checkValidVarName x = unless (validVarName x) $ agda2hsErrorM $ do   text "Invalid name for Haskell variable: " <+> text (Hs.prettyPrint x)  checkValidTyVarName :: Hs.Name () -> C ()-checkValidTyVarName x = unless (validVarName x) $ genericDocError =<< do+checkValidTyVarName x = unless (validVarName x) $ agda2hsErrorM $ do   text "Invalid name for Haskell type variable: " <+> text (Hs.prettyPrint x)  checkValidFunName :: Hs.Name () -> C ()-checkValidFunName x = unless (validVarName x) $ genericDocError =<< do+checkValidFunName x = unless (validVarName x) $ agda2hsErrorM $ do   text "Invalid name for Haskell function: " <+> text (Hs.prettyPrint x)  checkValidTypeName :: Hs.Name () -> C ()-checkValidTypeName x = unless (validTypeName x) $ genericDocError =<< do+checkValidTypeName x = unless (validTypeName x) $ agda2hsErrorM $ do   text "Invalid name for Haskell type: " <+> text (Hs.prettyPrint x)  checkValidConName :: Hs.Name () -> C ()-checkValidConName x = unless (validConName x) $ genericDocError =<< do+checkValidConName x = unless (validConName x) $ agda2hsErrorM $ do   text "Invalid name for Haskell constructor: " <+> text (Hs.prettyPrint x)  tellImport :: Import -> C ()@@ -342,7 +356,7 @@ addTyBang Lazy   ty = return ty  checkSingleElement :: Hs.Name () -> [b] -> String -> C ()-checkSingleElement name fs s = unless (length fs == 1) $ genericDocError =<< do+checkSingleElement name fs s = unless (length fs == 1) $ agda2hsErrorM $ do   text (s ++ ":") <+> text (Hs.prettyPrint name)  checkNewtypeCon :: Hs.Name () -> [b] -> C ()@@ -353,8 +367,8 @@ checkFixityLevel name Unrelated = pure Nothing checkFixityLevel name (Related lvl) =   if lvl /= fromInteger (round lvl) || lvl < 0-    then genericDocError =<< text "Invalid fixity" <+> pretty lvl-                         <+> text "for operator"   <+> prettyTCM name+    then agda2hsErrorM $ text "Invalid fixity" <+> pretty lvl+                     <+> text "for operator"   <+> prettyTCM name     else pure (Just (round lvl))  maybePrependFixity :: QName -> Fixity -> C [Hs.Decl ()] -> C [Hs.Decl ()]@@ -385,7 +399,7 @@   where     checkPatternInfo :: PatternInfo -> C ()     checkPatternInfo i = unless (null $ patAsNames i) $-      genericDocError =<< text "not supported by agda2hs: as patterns"+      agda2hsError "not supported: as patterns"  noWriteImports :: C a -> C a noWriteImports = local $ \e -> e { writeImports = False }
src/Agda2Hs/Compile/Var.hs view
@@ -10,7 +10,7 @@ import Agda.Syntax.Common.Pretty ( prettyShow ) import Agda.Syntax.Abstract.Name ( nameConcrete ) import Agda.TypeChecking.Pretty ( text )-import Agda.TypeChecking.Monad.Base ( genericDocError )+import Agda.TypeChecking.Monad.Base ( ContextEntry(..) ) import Agda.TypeChecking.Monad.Context ( lookupBV ) import Agda.Utils.Monad ( whenM ) @@ -18,5 +18,5 @@ -- | Compile a variable. compileDBVar :: Nat -> C String compileDBVar x = do-  (d, n) <- (fmap snd &&& fst . unDom) <$> lookupBV x+  n <- ceName <$> lookupBV x   return $ prettyShow $ nameConcrete n
src/Agda2Hs/Config.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} -- Read additional configuration options from a file. module Agda2Hs.Config (checkConfig) where @@ -15,7 +14,9 @@  import Agda2Hs.Compile.Types import Agda2Hs.Compile.Name ( toNameImport )-import Agda.TypeChecking.Monad.Base ( TCM, genericDocError )+import Agda2Hs.Compile.Utils ( agda2hsError )++import Agda.TypeChecking.Monad.Base ( TCM ) import Agda.Syntax.Common.Pretty  -- | Config file data.@@ -48,7 +49,7 @@ readConfigFile :: FilePath -> TCM Config readConfigFile src = do   liftIO (Yaml.decodeFileEither src) >>= \case-    Left err  -> genericDocError $ vcat+    Left err  -> agda2hsError $ vcat       [ text "An error occured while trying to parse config file " <> text src <>":"       , multiLineText (Yaml.prettyPrintParseException err)       ]
− src/Agda2Hs/HsUtils.hs 
@@ -1,316 +0,0 @@--module Agda2Hs.HsUtils where--import Control.Monad ( guard )--import Data.Data ( Data )-import Data.Generics ( listify, everywhere, mkT, extT )-import Data.List ( foldl' )-import Data.Map ( Map )--import qualified Data.Map as Map--import Language.Haskell.Exts hiding ( Strict, Lazy )--import Agda.Syntax.Position--import Agda.Utils.FileName ( mkAbsolute )-import Agda.Utils.List ( initLast )-import Agda.Utils.Maybe.Strict ( toStrict )-import System.FilePath (isAbsolute)-import Agda.Utils.Maybe (boolToMaybe)---- Names ---------------------------------------------------------------------validVarId :: String -> Bool-validVarId s = case lexTokenStream s of-  ParseOk [Loc _ VarId{}] -> True-  _ -> False--validConId :: String -> Bool-validConId s = case lexTokenStream s of-  ParseOk [Loc _ ConId{}] -> True-  _ -> False--validVarSym :: String -> Bool-validVarSym s = case lexTokenStream s of-  ParseOk [Loc _ VarSym{}] -> True-  _ -> False--validConSym :: String -> Bool-validConSym s = case lexTokenStream s of-  ParseOk [Loc _ ConSym{}] -> True-  _ -> False--validVarName :: Name () -> Bool-validVarName (Ident _ s)  = validVarId s-validVarName (Symbol _ s) = validVarSym s--validTypeName :: Name () -> Bool-validTypeName (Ident _ s) = validConId s-validTypeName (Symbol _ s) = validVarSym s || validConSym s -- type operators need not start with a colon--validConName :: Name () -> Bool-validConName (Ident _ s)  = validConId s-validConName (Symbol _ s) = validConSym s--isInfix :: String -> Maybe String-isInfix ('_' : f) = do-  (op, '_') <- initLast f-  guard $ not $ '_' `elem` op-  return op-isInfix _ = Nothing--hsName :: String -> Name ()-hsName x-  | Just op <- isInfix x = Symbol () op-  | otherwise            = Ident () (map underscore x)-  where-    -- Agda uses underscores for operators, which means that you can't have both mapM and mapM_-    -- without getting ambiguities. To work around this we translate subscript '-' to underscore.-    underscore '₋' = '_'-    underscore c   = c--extToName :: KnownExtension -> Name ()-extToName = Ident () . show--hsModuleName :: String -> ModuleName ()-hsModuleName = ModuleName ()--isOp :: QName () -> Bool-isOp (UnQual _ Symbol{}) = True-isOp (Special _ Cons{})  = True-isOp _                   = False--isSpecial :: QName () -> Bool-isSpecial (Special _ _)  = True-isSpecial _              = False--unQual :: QName () -> Name ()-unQual (UnQual _ n) = n-unQual (Qual _ _ n) = n-unQual (Special _ _)  = error "Unexpected special con"--definedName :: Match l -> Name l-definedName (Match _ f _ _ _) = f-definedName (InfixMatch _ _ f _ _ _) = f--replaceName :: Data a => Name () -> Name () -> a -> a-replaceName pre post = everywhere (mkT go `extT` go')-  where-    go :: QName () -> QName ()-    go n | isSpecial n = n-         | unQual n == pre = UnQual () post-         | otherwise = n--    go' :: Match () -> Match ()-    go' m = case m of-      (Match () n ps rhs bs) -> Match () (f n) ps rhs bs-      (InfixMatch () p n ps rhs bs) -> InfixMatch () p (f n) ps rhs bs-      where f n | n == pre  = post-                | otherwise = n--dropPatterns :: Data a => Int -> a -> a-dropPatterns n = everywhere (mkT go)-  where-    go :: Match () -> Match ()-    go (Match () f ps rhs bs) = Match () f (drop n ps) rhs bs-    go m = m----- Utilities for building Haskell constructs--pp :: Pretty a => a -> String-pp = prettyPrintWithMode defaultMode{ spacing = False-                                    , classIndent = 4-                                    , whereIndent = 2-                                    }----- exactPrint really looks at the line numbers (and we're using the locations from the agda source--- to report Haskell parse errors at the right location), so shift everything to start at line 1.-moveToTop :: Annotated ast => (ast SrcSpanInfo, [Comment]) -> (ast SrcSpanInfo, [Comment])-moveToTop (x, cs) = (subtractLine l <$> x, [ Comment b (sub l r) str | Comment b r str <- cs ])-  where l = startLine (ann x) - 1-        subtractLine :: Int -> SrcSpanInfo -> SrcSpanInfo-        subtractLine l (SrcSpanInfo s ss) = SrcSpanInfo (sub l s) (map (sub l) ss)--        sub :: Int -> SrcSpan -> SrcSpan-        sub l (SrcSpan f l0 c0 l1 c1) = SrcSpan f (l0 - l) c0 (l1 - l) c1--getList :: Exp () -> Maybe [Exp ()]-getList (Con _ (Special _ ListCon{})) = Just []-getList (List _ es)                   = Just es-getList _                             = Nothing--getListP :: Pat () -> Maybe [Pat ()]-getListP (PApp _ (Special _ ListCon{}) []) = Just []-getListP (PList _ es)                      = Just es-getListP _                                 = Nothing--pApp :: QName () -> [Pat ()] -> Pat ()-pApp c@(UnQual () (Symbol () _)) [p, q]                = PInfixApp () p c q-pApp (Special _ Cons{}) [p, q] | Just ps <- getListP q = PList () (p : ps)-pApp c@(Special () Cons{}) [p, q]                      = PInfixApp () p c q-pApp c ps                                              = PApp () c ps--getOp :: Exp () -> Maybe (QOp ())-getOp (Var _ x) | isOp x = Just $ QVarOp () x-getOp (Con _ c) | isOp c = Just $ QConOp () c-getOp _                  = Nothing--eApp :: Exp () -> [Exp ()] -> Exp ()-eApp f [a, b] | Just (QConOp () (Special _ Cons{})) <- getOp f,-                Just as <- getList b = List () (a : as)-eApp f (a : b : as) | Just op <- getOp f = foldl (App ()) (InfixApp () a op b) as-eApp f [a]          | Just op <- getOp f = LeftSection () a op-eApp f es = foldl (App ()) f es--tApp :: Type () -> [Type ()] -> Type ()-tApp (TyCon () (Special () ListCon{})) [a] = TyList () a-tApp t vs = foldl (TyApp ()) t vs--hsLambda :: String -> Exp () -> Exp ()-hsLambda x e =-  case e of-    Lambda l ps b -> Lambda l (p : ps) b-    _             -> Lambda () [p] e-  where-    p = PVar () $ hsName x--hsUnqualName :: String -> QName ()-hsUnqualName = UnQual () . hsName--hsVar :: String -> Exp ()-hsVar = Var () . hsUnqualName--hsUndefined :: Exp ()-hsUndefined = hsVar "undefined"--hsError :: String -> Exp ()-hsError s = hsVar "error" `eApp` [strE s]--cname :: CName l -> Name l-cname (VarName _ n) = n-cname (ConName _ n) = n--cloc :: CName l -> l-cloc (VarName l _) = l-cloc (ConName l _) = l--srcSpanToRange :: SrcSpan -> Range-srcSpanToRange (SrcSpan file l1 c1 l2 c2) =-  intervalToRange (toStrict $ boolToMaybe (isAbsolute file) $ mkRangeFile (mkAbsolute file) Nothing) $ Interval (pos l1 c1) (pos l2 c2)-  where pos l c = Pn () 0 (fromIntegral l) (fromIntegral c)--srcLocToRange :: SrcLoc -> Range-srcLocToRange (SrcLoc file l c) = srcSpanToRange (SrcSpan file l c l c)--srcSpanInfoToRange :: SrcSpanInfo -> Range-srcSpanInfoToRange = srcSpanToRange . srcInfoSpan--allUsedTypes :: Data a => a -> [Type ()]-allUsedTypes = listify (const True)--usedTypesOf :: Data a => String -> a -> [Type ()]-usedTypesOf s = listify $ (== s) . pp--uses :: Data a => String -> a -> Bool-uses ty = not . null . usedTypesOf ty---- Fixities---- Ideally, our pretty-printing library should insert parenthesis where needed.--- However, hs-src-exts does not insert adequate parenthesis for infix--- operators so we need to insert some by hand (see issues #54 and #273 and #317).---- | Properly parenthesize an expression with regards to the default fixities.-insertParens :: Data a => a -> a-insertParens = everywhere (mkT $ insertPars $ fixityMap baseFixities)-  where-    fixityMap fxs = Map.fromList [ (q, fx) | fx@(Fixity _ _ q) <- fxs ]---- | Given fixities of operators, properly parenthesize an expression.-insertPars :: Map (QName ()) Fixity -> Exp () -> Exp ()-insertPars fixs = \case-  (InfixApp l e1 op e2) -> InfixApp l (parL op e1) op (parR op e2)-  (LeftSection l e1 op) -> LeftSection l (parL op e1) op-  (RightSection l op e2) -> RightSection l op (parR op e2)-  e -> e-  where-    getFix op = Map.lookup (qopName op) fixs--    qopName (QVarOp _ x) = x-    qopName (QConOp _ x) = x--    needParen same (Just (Fixity atop top _)) (Just (Fixity achild child _))-      | top > child    = True-      | top < child    = False-      | atop /= achild = True-      | otherwise      = same atop-    needParen _ Nothing _ = True  -- If we don't know, add parens-    needParen _ _ Nothing = True--    needParenExpr (InfixApp _ _ _ e2) = needParenExpr e2-    needParenExpr Lambda{} = True-    needParenExpr _ = False--    parL topOp e =-      if needParenExpr e-      then mkParen e-      else par topOp (needParen (AssocLeft () /=)) e-    parR topOp = par topOp (needParen (AssocRight () /=))--    par topOp need e@(InfixApp _ _ op _)-      | need (getFix topOp) (getFix op) = mkParen e-    par _ _ e = e--mkParen :: Exp () -> Exp ()-mkParen e@Paren{} = e-mkParen e = Paren () e----- Patterns-patToExp :: Pat l -> Maybe (Exp l)-patToExp = \case-  PVar l x            -> Just $ Var l (UnQual l x)-  PLit l s v          -> Just $ Lit l v-  PInfixApp l p f q   -> InfixApp l <$> patToExp p <*> pure (QConOp l f) <*> patToExp q-  PApp l x ps         -> foldl' (App l) (Con l x) <$> traverse patToExp ps-  PTuple l b ps       -> Tuple l b <$> traverse patToExp ps-  PUnboxedSum l i j p -> UnboxedSum l i j <$> patToExp p-  PList l ps          -> List l <$> traverse patToExp ps-  PParen l p          -> Paren l <$> patToExp p-  PAsPat _ _ p        -> patToExp p-  PIrrPat _ p         -> patToExp p-  PatTypeSig _ p _    -> patToExp p-  PBangPat _ p        -> patToExp p-  _                   -> Nothing---data Strictness = Lazy | Strict-  deriving (Eq, Show)----- | Add a class constraint to a Haskell type.-constrainType-  :: Asst () -- ^ The class assertion.-  -> Type () -- ^ The type to constrain.-  -> Type ()-constrainType c = \case-  TyForall _ as (Just (CxTuple _  cs)) t -> TyForall () as      (Just (CxTuple  () (c:cs))) t-  TyForall _ as (Just (CxSingle _ c')) t -> TyForall () as      (Just (CxTuple  () [c,c'])) t-  TyForall _ as Nothing                t -> TyForall () as      (Just (CxSingle () c     )) t-  t                                      -> TyForall () Nothing (Just (CxSingle () c     )) t----- | Add explicit quantification over a variable to a Haskell type.-qualifyType-  :: TyVarBind ()  -- ^ Name of the variable.-  -> Type () -- ^ Type to quantify.-  -> Type ()-qualifyType a = \case-    TyForall _ (Just as) cs t -> TyForall () (Just (a:as)) cs      t-    TyForall _ Nothing   cs t -> TyForall () (Just [a]   ) cs      t-    t                         -> TyForall () (Just [a]   ) Nothing t
+ src/Agda2Hs/Language/Haskell.hs view
@@ -0,0 +1,30 @@+-- | Haskell syntax, parsing, pretty printing.+--+-- This module contains those elements of the Haskell language+-- that are needed by Agda2hs.+--+-- We are mainly re-exporting @haskell-src-exts@.+module Agda2Hs.Language.Haskell+  ( module Language.Haskell.Exts.Build+  , module Language.Haskell.Exts.Comments+  , module Language.Haskell.Exts.ExactPrint+  , module Language.Haskell.Exts.Extension+  , module Language.Haskell.Exts.Parser+  , module Language.Haskell.Exts.Pretty+  , module Language.Haskell.Exts.SrcLoc+  , module Language.Haskell.Exts.Syntax+  , module Agda2Hs.Language.Haskell.Pretty+  , module Agda2Hs.Language.Haskell.Utils+  ) where++import Agda2Hs.Language.Haskell.Pretty+import Agda2Hs.Language.Haskell.Utils++import Language.Haskell.Exts.Comments (Comment)+import Language.Haskell.Exts.Build hiding (pApp)+import Language.Haskell.Exts.ExactPrint (exactPrint)+import Language.Haskell.Exts.Extension hiding (Strict, Lazy)+import Language.Haskell.Exts.Parser+import Language.Haskell.Exts.Pretty+import Language.Haskell.Exts.SrcLoc (SrcSpanInfo)+import Language.Haskell.Exts.Syntax
+ src/Agda2Hs/Language/Haskell/Pretty.hs view
@@ -0,0 +1,61 @@+-- | Pretty printing tweaks for @haskell-src-exts@.+module Agda2Hs.Language.Haskell.Pretty+  ( prettyShowImportDecl+  ) where++import Language.Haskell.Exts.Pretty as Hs+import Language.Haskell.Exts.Syntax as Hs++import Agda2Hs.Language.Haskell.Utils ( pp )++-- | Custom implementation of 'prettyShow' for 'Hs.ImportDecl'+-- that supports type operators.+--+-- Specifically, in the IThingAll and IThingWith import specs,+-- the "type" prefixes get before type operators if necessary.+-- See https://github.com/haskell-suite/haskell-src-exts/pull/475+-- If this pull request gets merged,+-- this custom implementation will be unnecessary.+prettyShowImportDecl :: Hs.ImportDecl () -> String+prettyShowImportDecl (Hs.ImportDecl _ m qual src safe mbPkg mbName mbSpecs) =+  unwords $ ("import" :) $+            (if src  then ("{-# SOURCE #-}" :) else id) $+            (if safe then ("safe" :) else id) $+            (if qual then ("qualified" :) else id) $+            maybeAppend (\ str -> show str) mbPkg $+            (pp m :) $+            maybeAppend (\m' -> "as " ++ pp m') mbName $+            (case mbSpecs of {Just specs -> [prettyShowSpecList specs]; Nothing -> []})+    where+      maybeAppend :: (a -> String) -> Maybe a -> ([String] -> [String])+      maybeAppend f (Just a) = (f a :)+      maybeAppend _ Nothing  = id++      prettyShowSpecList :: Hs.ImportSpecList () -> String+      prettyShowSpecList (Hs.ImportSpecList _ b ispecs)  =+            (if b then "hiding " else "")+                ++ parenList (map prettyShowSpec ispecs)++      parenList :: [String] -> String+      parenList [] = "()"+      parenList (x:xs) = '(' : (x ++ go xs)+        where+          go :: [String] -> String+          go [] = ")"+          go (x:xs) = ", " ++ x ++ go xs++      -- this is why we have rewritten it+      prettyShowSpec :: Hs.ImportSpec () -> String+      prettyShowSpec (Hs.IVar _ name  )        = pp name+      prettyShowSpec (Hs.IAbs _ ns name)       = let ppns = pp ns in case ppns of+          []                                  -> pp name -- then we don't write a space before it+          _                                   -> ppns ++ (' ' : pp name)+      prettyShowSpec (Hs.IThingAll _ name) = let rest = pp name ++ "(..)" in+        case name of+          -- if it's a symbol, append a "type" prefix to the beginning+          (Hs.Symbol _ _)                     -> pp (Hs.TypeNamespace ()) ++ (' ' : rest)+          (Hs.Ident  _ _)                     -> rest+      prettyShowSpec (Hs.IThingWith _ name nameList) = let rest = pp name ++ (parenList . map pp $ nameList) in+        case name of+          (Hs.Symbol _ _)                     -> pp (Hs.TypeNamespace ()) ++ (' ' : rest)+          (Hs.Ident  _ _)                     -> rest
+ src/Agda2Hs/Language/Haskell/Utils.hs view
@@ -0,0 +1,321 @@++module Agda2Hs.Language.Haskell.Utils where++import Control.Monad ( guard )++import Data.Data ( Data )+import Data.Generics ( listify, everywhere, mkT, extT )+import Data.List ( foldl' )+import Data.Map ( Map )++import qualified Data.Map as Map++import Language.Haskell.Exts hiding ( Strict, Lazy )++import Agda.Syntax.Position++import Agda.Utils.FileName ( mkAbsolute )+import Agda.Utils.List ( initLast )+import Agda.Utils.Maybe.Strict ( toStrict )+import System.FilePath (isAbsolute)+import Agda.Utils.Maybe (boolToMaybe)++-- Names ------------------------------------------------------------------+++validVarId :: String -> Bool+validVarId s = case lexTokenStream s of+  ParseOk [Loc _ VarId{}] -> True+  _ -> False++validConId :: String -> Bool+validConId s = case lexTokenStream s of+  ParseOk [Loc _ ConId{}] -> True+  _ -> False++validVarSym :: String -> Bool+validVarSym s = case lexTokenStream s of+  ParseOk [Loc _ VarSym{}] -> True+  _ -> False++validConSym :: String -> Bool+validConSym s = case lexTokenStream s of+  ParseOk [Loc _ ConSym{}] -> True+  _ -> False++validVarName :: Name () -> Bool+validVarName (Ident _ s)  = validVarId s+validVarName (Symbol _ s) = validVarSym s++validTypeName :: Name () -> Bool+validTypeName (Ident _ s) = validConId s+validTypeName (Symbol _ s) = validVarSym s || validConSym s -- type operators need not start with a colon++validConName :: Name () -> Bool+validConName (Ident _ s)  = validConId s+validConName (Symbol _ s) = validConSym s++isInfix :: String -> Maybe String+isInfix ('_' : f) = do+  (op, '_') <- initLast f+  guard $ not $ '_' `elem` op+  return op+isInfix _ = Nothing++hsName :: String -> Name ()+hsName x+  | Just op <- isInfix x = Symbol () op+  | otherwise            = Ident () (map underscore x)+  where+    -- Agda uses underscores for operators, which means that you can't have both mapM and mapM_+    -- without getting ambiguities. To work around this we translate subscript '-' to underscore.+    underscore '₋' = '_'+    underscore c   = c++extToName :: KnownExtension -> Name ()+extToName = Ident () . show++hsModuleName :: String -> ModuleName ()+hsModuleName = ModuleName ()++isOp :: QName () -> Bool+isOp (UnQual _ Symbol{}) = True+isOp (Special _ Cons{})  = True+isOp _                   = False++isSpecial :: QName () -> Bool+isSpecial (Special _ _)  = True+isSpecial _              = False++unQual :: QName () -> Name ()+unQual (UnQual _ n) = n+unQual (Qual _ _ n) = n+unQual (Special _ _)  = error "Unexpected special con"++definedName :: Match l -> Name l+definedName (Match _ f _ _ _) = f+definedName (InfixMatch _ _ f _ _ _) = f++replaceName :: Data a => Name () -> Name () -> a -> a+replaceName pre post = everywhere (mkT go `extT` go')+  where+    go :: QName () -> QName ()+    go n | isSpecial n = n+         | unQual n == pre = UnQual () post+         | otherwise = n++    go' :: Match () -> Match ()+    go' m = case m of+      (Match () n ps rhs bs) -> Match () (f n) ps rhs bs+      (InfixMatch () p n ps rhs bs) -> InfixMatch () p (f n) ps rhs bs+      where f n | n == pre  = post+                | otherwise = n++dropPatterns :: Data a => Int -> a -> a+dropPatterns n = everywhere (mkT go)+  where+    go :: Match () -> Match ()+    go (Match () f ps rhs bs) = Match () f (drop n ps) rhs bs+    go m = m+++-- Utilities for building Haskell constructs++pp :: Pretty a => a -> String+pp = prettyPrintWithMode defaultMode{ spacing = False+                                    , classIndent = 4+                                    , whereIndent = 2+                                    }+++-- exactPrint really looks at the line numbers (and we're using the locations from the agda source+-- to report Haskell parse errors at the right location), so shift everything to start at line 1.+moveToTop :: Annotated ast => (ast SrcSpanInfo, [Comment]) -> (ast SrcSpanInfo, [Comment])+moveToTop (x, cs) = (subtractLine l <$> x, [ Comment b (sub l r) str | Comment b r str <- cs ])+  where l = startLine (ann x) - 1+        subtractLine :: Int -> SrcSpanInfo -> SrcSpanInfo+        subtractLine l (SrcSpanInfo s ss) = SrcSpanInfo (sub l s) (map (sub l) ss)++        sub :: Int -> SrcSpan -> SrcSpan+        sub l (SrcSpan f l0 c0 l1 c1) = SrcSpan f (l0 - l) c0 (l1 - l) c1++getList :: Exp () -> Maybe [Exp ()]+getList (Con _ (Special _ ListCon{})) = Just []+getList (List _ es)                   = Just es+getList _                             = Nothing++getListP :: Pat () -> Maybe [Pat ()]+getListP (PApp _ (Special _ ListCon{}) []) = Just []+getListP (PList _ es)                      = Just es+getListP _                                 = Nothing++pApp :: QName () -> [Pat ()] -> Pat ()+pApp c@(UnQual () (Symbol () _)) [p, q]                = PInfixApp () p c q+pApp (Special _ Cons{}) [p, q] | Just ps <- getListP q = PList () (p : ps)+pApp c@(Special () Cons{}) [p, q]                      = PInfixApp () p c q+pApp c ps                                              = PApp () c ps++getOp :: Exp () -> Maybe (QOp ())+getOp (Var _ x) | isOp x = Just $ QVarOp () x+getOp (Con _ c) | isOp c = Just $ QConOp () c+getOp _                  = Nothing++eApp :: Exp () -> [Exp ()] -> Exp ()+eApp f [a, b] | Just (QConOp () (Special _ Cons{})) <- getOp f,+                Just as <- getList b = List () (a : as)+eApp f (a : b : as) | Just op <- getOp f = foldl (App ()) (InfixApp () a op b) as+eApp f [a]          | Just op <- getOp f = LeftSection () a op+eApp f es = foldl (App ()) f es++tApp :: Type () -> [Type ()] -> Type ()+tApp (TyCon () (Special () ListCon{})) [a] = TyList () a+tApp t vs = foldl (TyApp ()) t vs++hsLambda :: String -> Exp () -> Exp ()+hsLambda x e =+  case e of+    Lambda l ps b -> Lambda l (p : ps) b+    _             -> Lambda () [p] e+  where+    p = PVar () $ hsName x++hsUnqualName :: String -> QName ()+hsUnqualName = UnQual () . hsName++hsVar :: String -> Exp ()+hsVar = Var () . hsUnqualName++hsUndefined :: Exp ()+hsUndefined = hsVar "undefined"++hsError :: String -> Exp ()+hsError s = hsVar "error" `eApp` [strE s]++cname :: CName l -> Name l+cname (VarName _ n) = n+cname (ConName _ n) = n++cloc :: CName l -> l+cloc (VarName l _) = l+cloc (ConName l _) = l++srcSpanToRange :: SrcSpan -> Range+srcSpanToRange (SrcSpan file l1 c1 l2 c2) =+  intervalToRange (toStrict $ boolToMaybe (isAbsolute file) $ mkRangeFile (mkAbsolute file) Nothing) $ Interval () (pos l1 c1) (pos l2 c2)+  where pos l c = Pn () 0 (fromIntegral l) (fromIntegral c)++srcLocToRange :: SrcLoc -> Range+srcLocToRange (SrcLoc file l c) = srcSpanToRange (SrcSpan file l c l c)++srcSpanInfoToRange :: SrcSpanInfo -> Range+srcSpanInfoToRange = srcSpanToRange . srcInfoSpan++allUsedTypes :: Data a => a -> [Type ()]+allUsedTypes = listify (const True)++usedTypesOf :: Data a => String -> a -> [Type ()]+usedTypesOf s = listify $ (== s) . pp++uses :: Data a => String -> a -> Bool+uses ty = not . null . usedTypesOf ty++-- Fixities++-- Ideally, our pretty-printing library should insert parenthesis where needed.+-- However, hs-src-exts does not insert adequate parenthesis for infix+-- operators so we need to insert some by hand (see issues #54 and #273 and #317).++-- | Properly parenthesize an expression with regards to the default fixities.+insertParens :: Data a => a -> a+insertParens = everywhere (mkT $ insertPars $ fixityMap baseFixities)+  where+    fixityMap fxs = Map.fromList [ (q, fx) | fx@(Fixity _ _ q) <- fxs ]++-- | Given fixities of operators, properly parenthesize an expression.+insertPars :: Map (QName ()) Fixity -> Exp () -> Exp ()+insertPars fixs = \case+  (InfixApp l e1 op e2) -> InfixApp l (parL op e1) op (parR op e2)+  (LeftSection l e1 op) -> LeftSection l (parL op e1) op+  (RightSection l op e2) -> RightSection l op (parR op e2)+  e -> e+  where+    getFix op = Map.lookup (qopName op) fixs++    qopName (QVarOp _ x) = x+    qopName (QConOp _ x) = x++    needParen same (Just (Fixity atop top _)) (Just (Fixity achild child _))+      | top > child    = True+      | top < child    = False+      | atop /= achild = True+      | otherwise      = same atop+    needParen _ Nothing _ = True  -- If we don't know, add parens+    needParen _ _ Nothing = True++    needParenExpr (InfixApp _ _ _ e2) = needParenExpr e2+    needParenExpr Lambda{} = True+    needParenExpr _ = False++    parL topOp e =+      if needParenExpr e+      then mkParen e+      else par topOp (needParen (AssocLeft () /=)) e+    parR topOp = par topOp (needParen (AssocRight () /=))++    par topOp need e@(InfixApp _ _ op _)+      | need (getFix topOp) (getFix op) = mkParen e+    par _ _ e = e++mkParen :: Exp () -> Exp ()+mkParen e@Paren{} = e+mkParen e = Paren () e+++-- Patterns+patToExp :: Pat l -> Maybe (Exp l)+patToExp = \case+  PVar l x            -> Just $ Var l (UnQual l x)+  PLit l s v          -> Just $ Lit l v+  PInfixApp l p f q   -> InfixApp l <$> patToExp p <*> pure (QConOp l f) <*> patToExp q+  PApp l x ps         -> foldl' (App l) (Con l x) <$> traverse patToExp ps+  PTuple l b ps       -> Tuple l b <$> traverse patToExp ps+  PUnboxedSum l i j p -> UnboxedSum l i j <$> patToExp p+  PList l ps          -> List l <$> traverse patToExp ps+  PParen l p          -> Paren l <$> patToExp p+  PAsPat _ _ p        -> patToExp p+  PIrrPat _ p         -> patToExp p+  PatTypeSig _ p _    -> patToExp p+  PBangPat _ p        -> patToExp p+  _                   -> Nothing+++data Strictness = Lazy | Strict+  deriving (Eq, Show)+++-- | Add a class constraint to a Haskell type.+constrainType+  :: Asst () -- ^ The class assertion.+  -> Type () -- ^ The type to constrain.+  -> Type ()+constrainType c = \case+  TyForall _ as (Just (CxTuple _  cs)) t -> TyForall () as      (Just (CxTuple  () (c:cs))) t+  TyForall _ as (Just (CxSingle _ c')) t -> TyForall () as      (Just (CxTuple  () [c,c'])) t+  TyForall _ as Nothing                t -> TyForall () as      (Just (CxSingle () c     )) t+  t                                      -> TyForall () Nothing (Just (CxSingle () c     )) t+++-- | Add explicit quantification over a variable to a Haskell type.+qualifyType+  :: TyVarBind ()  -- ^ Name of the variable.+  -> Type () -- ^ Type to quantify.+  -> Type ()+qualifyType a = \case+    TyForall _ (Just as) cs t -> TyForall () (Just (a:as)) cs      t+    TyForall _ Nothing   cs t -> TyForall () (Just [a]   ) cs      t+    t                         -> TyForall () (Just [a]   ) Nothing t++isQuantifiedAsst :: Asst () -> Bool+isQuantifiedAsst (TypeA _ TyForall{}) = True+isQuantifiedAsst (IParam _ _ TyForall{}) = True+isQuantifiedAsst _ = False
src/Agda2Hs/Pragma.hs view
@@ -3,23 +3,23 @@ import Data.List ( isPrefixOf ) import Data.Maybe ( fromMaybe ) import qualified Data.Map as Map--import qualified Language.Haskell.Exts.Syntax as Hs-import qualified Language.Haskell.Exts.Parser as Hs-import qualified Language.Haskell.Exts.Extension as Hs+import qualified Data.Text as Text  import Agda.Compiler.Backend import Agda.Compiler.Common ( curIF )  import Agda.Syntax.Position+import Agda.TypeChecking.Pretty (text)  import Agda.Utils.FileName ( filePath ) import Agda.Utils.Maybe.Strict ( toLazy ) -import Agda2Hs.HsUtils import Agda2Hs.Compile.Types -pragmaName :: String+import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils ( Strictness(..), srcLocToRange )++pragmaName :: Text.Text pragmaName = "AGDA2HS"  languagePragmas :: Code -> [Hs.Extension]@@ -43,7 +43,7 @@                        Just l  -> "{-# LINE " ++ show l ++ show file ++ " #-}\n"                        Nothing -> ""           case Hs.parseWithComments pmode (line ++ code) of-            Hs.ParseFailed loc msg -> setCurrentRange (srcLocToRange loc) $ genericError msg+            Hs.ParseFailed loc msg -> setCurrentRange (srcLocToRange loc) $ typeError <$> CustomBackendError "agda2hs" =<< text msg             Hs.ParseOk m           -> ((r, m) :) <$> getCode (exts ++ languagePragmas m) pragmas  data ParsedPragma@@ -77,7 +77,7 @@   -- dummy datatype and then only keeping the deriving part   case Hs.parseDecl ("data X = X " ++ d) of     Hs.ParseFailed loc msg -> do-      setCurrentRange r $ genericError msg+      setCurrentRange r $ typeError <$> CustomBackendError "agda2hs" =<< text msg     Hs.ParseOk (Hs.DataDecl _ _ _ _ _ ds) ->       return $ pragma (map (() <$) ds)     Hs.ParseOk _ -> return $ pragma []
src/Agda2Hs/Render.hs view
@@ -9,17 +9,10 @@ import Data.Set ( Set ) import qualified Data.Set as Set -import System.FilePath ( takeDirectory, (</>) )+import System.FilePath ( takeDirectory ) import System.Directory ( createDirectoryIfMissing ) -import qualified Language.Haskell.Exts.SrcLoc as Hs-import qualified Language.Haskell.Exts.Syntax as Hs-import qualified Language.Haskell.Exts.Build as Hs-import qualified Language.Haskell.Exts.ExactPrint as Hs-import qualified Language.Haskell.Exts.Extension as Hs- import Agda.Compiler.Backend-import Agda.Compiler.Common ( compileDir )  import Agda.TypeChecking.Pretty import qualified Agda.Syntax.Concrete.Name as C@@ -32,12 +25,12 @@ import Agda2Hs.Compile import Agda2Hs.Compile.Types import Agda2Hs.Compile.Imports-import Agda2Hs.Compile.Utils ( primModules )-import Agda2Hs.HsUtils+import Agda2Hs.Compile.Utils ( primModules, moduleFileName )+import qualified Agda2Hs.Language.Haskell as Hs+import Agda2Hs.Language.Haskell.Utils+  ( extToName, pp, moveToTop, insertParens ) import Agda2Hs.Pragma ( getForeignPragmas ) -import Language.Haskell.Exts as Hs (prettyPrint, prelude_mod)- -- Rendering --------------------------------------------------------------  type Block = Ranged [String]@@ -71,62 +64,30 @@  -- Generating the files ------------------------------------------------------- -moduleFileName :: Options -> TopLevelModuleName -> TCM FilePath-moduleFileName opts name = do-  outDir <- compileDir-  return $ fromMaybe outDir (optOutDir opts) </> moduleNameToFileName name "hs"-- ensureDirectory :: FilePath -> IO () ensureDirectory = createDirectoryIfMissing True . takeDirectory --- We have to rewrite this so that in the IThingAll and IThingWith import specs,--- the "type" prefixes get before type operators if necessary.--- But see haskell-src-exts, PR #475. If it gets merged, this will be unnecessary.-prettyShowImportDecl :: Hs.ImportDecl () -> String-prettyShowImportDecl (Hs.ImportDecl _ m qual src safe mbPkg mbName mbSpecs) =-  unwords $ ("import" :) $-            (if src  then ("{-# SOURCE #-}" :) else id) $-            (if safe then ("safe" :) else id) $-            (if qual then ("qualified" :) else id) $-            maybeAppend (\ str -> show str) mbPkg $-            (pp m :) $-            maybeAppend (\m' -> "as " ++ pp m') mbName $-            (case mbSpecs of {Just specs -> [prettyShowSpecList specs]; Nothing -> []})-    where-      maybeAppend :: (a -> String) -> Maybe a -> ([String] -> [String])-      maybeAppend f (Just a) = (f a :)-      maybeAppend _ Nothing  = id--      prettyShowSpecList :: Hs.ImportSpecList () -> String-      prettyShowSpecList (Hs.ImportSpecList _ b ispecs)  =-            (if b then "hiding " else "")-                ++ parenList (map prettyShowSpec ispecs)--      parenList :: [String] -> String-      parenList [] = ""-      parenList (x:xs) = '(' : (x ++ go xs)-        where-          go :: [String] -> String-          go [] = ")"-          go (x:xs) = ", " ++ x ++ go xs+-- | Compile the full import list,+-- with special handling for the @Prelude@ as prescribed by 'Options'.+compileImportsWithPrelude+  :: Options -> String -> Imports -> TCM [Hs.ImportDecl ()]+compileImportsWithPrelude opts mod imps = do+    -- if the prelude is supposed to be implicit,+    -- or the prelude imports have been fixed in the config file,+    -- we remove it from the list of imports+    let filteredImps =+          if not preludeImplicit && isNothing preludeImports+            then imps+            else filter ((/= Hs.prelude_mod ()) . importModule) imps -      -- this is why we have rewritten it-      prettyShowSpec :: Hs.ImportSpec () -> String-      prettyShowSpec (Hs.IVar _ name  )        = pp name-      prettyShowSpec (Hs.IAbs _ ns name)       = let ppns = pp ns in case ppns of-          []                                  -> pp name -- then we don't write a space before it-          _                                   -> ppns ++ (' ' : pp name)-      prettyShowSpec (Hs.IThingAll _ name) = let rest = pp name ++ "(..)" in-        case name of-          -- if it's a symbol, append a "type" prefix to the beginning-          (Hs.Symbol _ _)                     -> pp (Hs.TypeNamespace ()) ++ (' ' : rest)-          (Hs.Ident  _ _)                     -> rest-      prettyShowSpec (Hs.IThingWith _ name nameList) = let rest = pp name ++ (parenList . map pp $ nameList) in-        case name of-          (Hs.Symbol _ _)                     -> pp (Hs.TypeNamespace ()) ++ (' ' : rest)-          (Hs.Ident  _ _)                     -> rest+    -- then we try to add it back+    if (not preludeImplicit && isNothing preludeImports) || null preludeHiding+      then compileImports mod filteredImps+      else (preludeImportDecl preOpts:) <$> compileImports mod filteredImps+  where+    preOpts@PreludeOpts{..} = optPrelude opts +-- | Render the @.hs@ module as a 'String' and write it to a file. writeModule :: Options -> ModuleEnv -> IsMain -> TopLevelModuleName             -> [(CompiledDef, CompileOutput)] -> TCM ModuleRes writeModule opts _ isMain m outs = do@@ -142,24 +103,8 @@     let unlines' [] = []         unlines' ss = unlines ss ++ "\n" -    let preOpts@PreludeOpts{..} = optPrelude opts--    -- if the prelude is supposed to be implicit,-    -- or the prelude imports have been fixed in the config file,-    -- we remove it from the list of imports-    let filteredImps =-          if not preludeImplicit && isNothing preludeImports-            then imps-            else filter ((/= Hs.prelude_mod ()) . importModule) imps--    -- then we try to add it back-    let autoImportList =-          if (not preludeImplicit && isNothing preludeImports) || null preludeHiding-            then compileImports mod filteredImps-            else (preludeImportDecl preOpts:) <$> compileImports mod filteredImps--    -- Add automatic imports-    autoImports <- (unlines' . map prettyShowImportDecl) <$> autoImportList+    autoImports <- unlines' . map Hs.prettyShowImportDecl+      <$> compileImportsWithPrelude opts mod imps      -- The comments make it hard to generate and pretty print a full module     hsFile <- moduleFileName opts m
src/AgdaInternals.hs view
@@ -38,15 +38,6 @@   applySubst rhoP d@Defn{..} =     d {defType = applyPatSubst rhoP defType, theDef = applySubst rhoP theDef} -instance (Monoid r, MonadFresh i m) => MonadFresh i (WriterT r m)-instance (Monoid r, MonadInteractionPoints m) => MonadInteractionPoints (WriterT r m)-instance (Monoid r, MonadStConcreteNames m) => MonadStConcreteNames (WriterT r m) where-  --runStConcreteNames :: StateT ConcreteNames (WriterT r m) a -> WriterT r m a-  runStConcreteNames m = WriterT $ runStConcreteNames $ StateT $ \s -> do-    ((x,s'),ns) <- runWriterT $ runStateT m s-    return ((x,ns),s')-instance (Monoid r, Monad m, IsString (m a)) => IsString (WriterT r m a) where-  fromString s = WriterT $ fmap (,mempty) $ fromString s instance (Monoid r, MonadBlock m) => MonadBlock (WriterT r m) where   catchPatternErr h m = WriterT $ catchPatternErr (runWriterT . h) (runWriterT m) instance MonadBlock m => MonadBlock (StateT s m) where
src/Main.hs view
@@ -1,26 +1,25 @@ module Main where  import Data.Maybe ( fromMaybe )+import qualified Data.Text as Text import Data.Version ( showVersion ) import Control.Monad.IO.Class ( MonadIO(liftIO) ) -import System.Console.GetOpt import System.Environment ( getArgs ) -import qualified Language.Haskell.Exts.Syntax as Hs-import qualified Language.Haskell.Exts.Build as Hs-import qualified Language.Haskell.Exts.Parser as Hs-import qualified Language.Haskell.Exts.Extension as Hs- import Agda.Main import Agda.Compiler.Backend+import Agda.Utils.GetOpt +import Agda2Hs.AgdaUtils import Agda2Hs.Compile.Name ( defaultSpecialRules ) import Agda2Hs.Compile import Agda2Hs.Config ( checkConfig ) import Agda2Hs.Compile.Types import Agda2Hs.Render +import qualified Agda2Hs.Language.Haskell as Hs+ import Paths_agda2hs ( version, getDataFileName )  @@ -53,7 +52,7 @@ backend :: Backend' Options Options ModuleEnv ModuleRes (CompiledDef, CompileOutput) backend = Backend'   { backendName           = "agda2hs"-  , backendVersion        = Just (showVersion version)+  , backendVersion        = Just $ Text.pack $ showVersion version   , options               = defaultOptions   , commandLineFlags      =       [ Option ['d'] ["disable-backend"] (NoArg disableOpt)@@ -75,15 +74,18 @@   , compileDef            = compile   , scopeCheckingSuffices = False   , mayEraseType          = \ _ -> return True+  , backendInteractTop    = Nothing+  , backendInteractHole   = Nothing   }   where     verifyAndWriteModule opts env isM m out = verifyOutput opts env isM m out >> writeModule opts env isM m out --- | Parse command-line arguments to check whether we are in interactive mode.-isInteractive :: IO Bool-isInteractive = do+-- | Parse command-line arguments to check whether we are in interactive mode+--   or the user is just requesting information.+shouldDisable :: IO Bool+shouldDisable = do   let interactionFlag = Option ['I'] ["interactive", "interaction", "interaction-json"] (NoArg ()) ""-  (i , _ , _) <- getOpt Permute [interactionFlag] <$> getArgs+  (i , _ , _) <- getOpt Permute (interactionFlag:infoFlags) <$> getArgs   return $ not $ null i  main = do@@ -91,11 +93,9 @@    -- Issue #370: `agda2hs locate` will print out the path to the prelude agda-lib file   if args == ["locate"] then-    putStrLn =<< getDataFileName "agda2hs.agda-lib"+    putStrLn =<< getDataFileName "lib/base/base.agda-lib"   else do     -- Issue #201: disable backend when run in interactive mode-    isInt <- isInteractive+    disable <- shouldDisable -    if isInt-      then runAgda [Backend backend{isEnabled = const False}]-      else runAgda [Backend backend]+    runAgda [Backend backend{isEnabled = const $ not disable }]