Alternative way to perform levitation.

Alternative way to perform levitation.

Dagand typically levitates Desc and elimDesc,
keeping El, Hyps, and prove primitive.

Instead, we can levitate El, Hyps, and prove,
keeping Desc and elimDesc primitive.

This alternative version has the advantage that it can be
performed in an intrinsically typed theory, whereas Dagand
levitation is limited to extrinsic typing.

The disadvantage is that Desc values must be eliminated with
elimDesc instead of ind.

Note that Agda cannot tell that Fix is strictly positive.
El expands to elimDesc, and Agda cannot see that the "Rec"
branch of elimDesc is strictly positive. In fact, the helper
function El' is defined such that its arguments do not contain
occurrences of Fix, but its return type does. This is a positive
occurrence in the constructor,
similiar to "foo : (Bar → Baz → Foo) → Foo".

{-# OPTIONS --type-in-type --no-positivity-check #-}
open import Data.Unit
open import Data.Product hiding ( curry ; uncurry )
open import Data.List hiding ( concat )
open import Data.String
open import Relation.Binary.PropositionalEquality
open import Function
module Spire.Examples.PropLev2 where

----------------------------------------------------------------------

data Desc (I : Set) : Set₁ where
  End : (i : I) → Desc I
  Rec : (i : I) (D : Desc I) → Desc I
  Arg : (A : Set) (B : A → Desc I) → Desc I

elimDesc : {I : Set} (P : Desc I → Set)
  (pend : (i : I) → P (End i))
  (prec : (i : I) (D : Desc I) (pd : P D) → P (Rec i D))
  (parg : (A : Set) (B : A → Desc I) (pb : (a : A) → P (B a)) → P (Arg A B))
  (D : Desc I) → P D
elimDesc P pend prec parg (End i) = pend i
elimDesc P pend prec parg (Rec i D) = prec i D (elimDesc P pend prec parg D)
elimDesc P pend prec parg (Arg A B) = parg A B (λ a → elimDesc P pend prec parg (B a))

----------------------------------------------------------------------

ISet : Set → Set₁
ISet I = I → Set

El' : {I : Set} (X : ISet I) (i : I) (D : Desc I) → Set
El' X i = elimDesc _
  (λ j → j ≡ i)
  (λ j D ih → X j × ih)
  (λ A B ih → Σ A ih)

El : {I : Set} (D : Desc I) (X : ISet I) (i : I) → Set
El D X i = El' X i D

Hyps : {I : Set} (D : Desc I) (X : ISet I) (P : (i : I) → X i → Set) (i : I) (xs : El D X i) → Set
Hyps = elimDesc _
  (λ j X P i q → ⊤)
  (λ j D ih X P i x,xs → P j (proj₁ x,xs) × ih X P i (proj₂ x,xs))
  (λ A B ih X P i a,b → ih (proj₁ a,b) X P i (proj₂ a,b))

----------------------------------------------------------------------

data μ {I : Set} (D : Desc I) (i : I) : Set where
  init : El D (μ D) i → μ D i

----------------------------------------------------------------------

prove : {I : Set} (D : Desc I) (X : I → Set)
  (P : (i : I) → X i → Set)
  (α : (i : I) (x : X i) → P i x)
  (i : I) (xs : El D X i) → Hyps D X P i xs
prove = elimDesc _
  (λ j X P α i q → tt)
  (λ j D ih X P α i x,xs → α j (proj₁ x,xs) , ih X P α i (proj₂ x,xs))
  (λ A B ih X P α i a,xs → ih (proj₁ a,xs) X P α i (proj₂ a,xs))

{-# NO_TERMINATION_CHECK #-}
ind : {I : Set} (D : Desc I)
  (P : (i : I) → μ D i → Set)
  (α : ∀ i (xs : El D (μ D) i) (ihs : Hyps D (μ D) P i xs) → P i (init xs))
  (i : I)
  (x : μ D i)
  → P i x
ind D P α i (init xs) = α i xs $
  prove D (μ D) P (ind D P α) i xs

----------------------------------------------------------------------

Label : Set
Label = String

Enum : Set
Enum = List Label

data Tag : Enum → Set where
  here : ∀{l E} → Tag (l ∷ E)
  there : ∀{l E} → Tag E → Tag (l ∷ E)

Branches : (E : Enum) (P : Tag E → Set) → Set
Branches [] P = ⊤
Branches (l ∷ E) P = P here × Branches E (λ t → P (there t))

case : {E : Enum} (P : Tag E → Set) (cs : Branches E P) (t : Tag E) → P t
case P (c , cs) here = c
case P (c , cs) (there t) = case (λ t → P (there t)) cs t

----------------------------------------------------------------------

UncurriedBranches : (E : Enum) (P : Tag E → Set) (X : Set)
  → Set
UncurriedBranches E P X = Branches E P → X

CurriedBranches : (E : Enum) (P : Tag E → Set) (X : Set)
  → Set
CurriedBranches [] P X = X
CurriedBranches (l ∷ E) P X = P here → CurriedBranches E (λ t → P (there t)) X

curryBranches : {E : Enum} {P : Tag E → Set} {X : Set}
  → UncurriedBranches E P X → CurriedBranches E P X
curryBranches {[]} f = f tt
curryBranches {l ∷ E} f = λ c → curryBranches (λ cs → f (c , cs))

uncurryBranches : {E : Enum} {P : Tag E → Set} {X : Set}
  → CurriedBranches E P X → UncurriedBranches E P X
uncurryBranches {[]} x tt = x
uncurryBranches {l ∷ E} f (c , cs) = uncurryBranches (f c) cs

----------------------------------------------------------------------

UncurriedEl : {I : Set} (D : Desc I) (X : ISet I) → Set
UncurriedEl D X = ∀{i} → El D X i → X i

CurriedEl : {I : Set} (D : Desc I) (X : ISet I) → Set
CurriedEl (End i) X = X i
CurriedEl (Rec i D) X = (x : X i) → CurriedEl D X
CurriedEl (Arg A B) X = (a : A) → CurriedEl (B a) X

CurriedEl' : {I : Set} (D : Desc I) (X : ISet I) (i : I) → Set
CurriedEl' (End j) X i = j ≡ i → X i
CurriedEl' (Rec j D) X i = (x : X j) → CurriedEl' D X i
CurriedEl' (Arg A B) X i = (a : A) → CurriedEl' (B a) X i

curryEl : {I : Set} (D : Desc I) (X : ISet I)
  → UncurriedEl D X → CurriedEl D X
curryEl (End i) X cn = cn refl
curryEl (Rec i D) X cn = λ x → curryEl D X (λ xs → cn (x , xs))
curryEl (Arg A B) X cn = λ a → curryEl (B a) X (λ xs → cn (a , xs))

uncurryEl : {I : Set} (D : Desc I) (X : ISet I)
  → CurriedEl D X → UncurriedEl D X
uncurryEl (End i) X cn refl = cn
uncurryEl (Rec i D) X cn (x , xs) = uncurryEl D X (cn x) xs
uncurryEl (Arg A B) X cn (a , xs) = uncurryEl (B a) X (cn a) xs

----------------------------------------------------------------------

UncurriedHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → Set
UncurriedHyps D X P cn =
  ∀ i (xs : El D X i) (ihs : Hyps D X P i xs) → P i (cn xs)

CurriedHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → Set
CurriedHyps (End i) X P cn =
  P i (cn refl)
CurriedHyps (Rec i D) X P cn =
  (x : X i) → P i x → CurriedHyps D X P (λ xs → cn (x , xs))
CurriedHyps (Arg A B) X P cn =
  (a : A) → CurriedHyps (B a) X P (λ xs → cn (a , xs))

CurriedHyps' : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (i : I)
  (cn : El D X i → X i)
  → Set
CurriedHyps' (End j) X P i cn = (q : j ≡ i) → P i (cn q)
CurriedHyps' (Rec j D) X P i cn =
  (x : X j) → P j x → CurriedHyps' D X P i (λ xs → cn (x , xs))
CurriedHyps' (Arg A B) X P i cn =
  (a : A) → CurriedHyps' (B a) X P i (λ xs → cn (a , xs))

curryHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → UncurriedHyps D X P cn
  → CurriedHyps D X P cn
curryHyps (End i) X P cn pf =
  pf i refl tt
curryHyps (Rec i D) X P cn pf =
  λ x ih → curryHyps D X P (λ xs → cn (x , xs)) (λ i xs ihs → pf i (x , xs) (ih , ihs))
curryHyps (Arg A B) X P cn pf =
  λ a → curryHyps (B a) X P (λ xs → cn (a , xs)) (λ i xs ihs → pf i (a , xs) ihs)

uncurryHyps : {I : Set} (D : Desc I) (X : ISet I)
  (P : (i : I) → X i → Set)
  (cn : UncurriedEl D X)
  → CurriedHyps D X P cn
  → UncurriedHyps D X P cn
uncurryHyps (End .i) X P cn pf i refl tt =
  pf
uncurryHyps (Rec j D) X P cn pf i (x , xs) (ih , ihs) =
  uncurryHyps D X P (λ ys → cn (x , ys)) (pf x ih) i xs ihs
uncurryHyps (Arg A B) X P cn pf i (a , xs) ihs =
  uncurryHyps (B a) X P (λ ys → cn (a , ys)) (pf a) i xs ihs

----------------------------------------------------------------------

Data : Set
Data =
  Σ Set λ I →
  Σ Enum λ E →
  Branches E (λ _ → Desc I)

DataI : Data → Set
DataI (I , E , B) = I

DataE : Data → Enum
DataE (I , E , B) = E

DataT : Data → Set
DataT R = Tag (DataE R)

DataB : (R : Data) → Branches (DataE R) (λ _ → Desc (DataI R))
DataB (I , E , B) = B

DataD : (R : Data) → Desc (DataI R)
DataD R = Arg (DataT R) (case (λ _ → Desc (DataI R)) (DataB R))

caseR : (R : Data) → DataT R → Desc (DataI R)
caseR R = case (λ _ → Desc (DataI R)) (DataB R)

----------------------------------------------------------------------

inj : (R : Data)
  → let D = DataD R
  in CurriedEl D (μ D)
inj R = let D = DataD R
  in curryEl D (μ D) init

----------------------------------------------------------------------

indCurried : {I : Set} (D : Desc I)
  (P : (i : I) → μ D i → Set)
  (f : CurriedHyps D (μ D) P init)
  (i : I)
  (x : μ D i)
  → P i x
indCurried D P f i x = ind D P (uncurryHyps D (μ D) P init f) i x

SumCurriedHyps : (R : Data)
  → let D = DataD R in
  (P : ∀ i → μ D i → Set)
  → DataT R → Set
SumCurriedHyps R P t =
  CurriedHyps (caseR R t) (μ (DataD R)) P (λ xs → init (t , xs))

elimUncurried : (R : Data)
  → let D = DataD R in
  (P : ∀ i → μ D i → Set)
  → Branches (DataE R) (SumCurriedHyps R P)
  → ∀ i (x : μ D i) → P i x
elimUncurried R P cs i x =
  indCurried (DataD R) P
    (case (SumCurriedHyps R P) cs)
    i x

elim : (R : Data)
  → let D = DataD R in
  (P : ∀ i → μ D i → Set)
  → CurriedBranches (DataE R)
      (SumCurriedHyps R P)
      (∀ i (x : μ D i) → P i x)
elim R P = curryBranches (elimUncurried R P)

----------------------------------------------------------------------

ℕE : Enum
ℕE = "zero" ∷ "suc" ∷ []

VecE : Enum
VecE = "nil" ∷ "cons" ∷ []

ℕT : Set
ℕT = Tag ℕE

VecT : Set
VecT = Tag VecE

zeroT : ℕT
zeroT = here

sucT : ℕT
sucT = there here

nilT : VecT
nilT = here

consT : VecT
consT = there here

ℕR : Data
ℕR = ⊤ , ℕE
  , End tt
  , Rec tt (End tt)
  , tt

ℕD : Desc ⊤
ℕD = DataD ℕR

ℕ : ⊤ → Set
ℕ = μ ℕD

zero : ℕ tt
zero = init (zeroT , refl)

suc : ℕ tt → ℕ tt
suc n = init (sucT , n , refl)

VecR : (A : Set) → Data
VecR A = (ℕ tt) , VecE
  , End zero
  , Arg (ℕ tt) (λ n → Arg A λ _ → Rec n (End (suc n)))
  , tt

nilD : (A : Set) → Desc (ℕ tt)
nilD A = End zero

consD : (A : Set) → Desc (ℕ tt)
consD A = Arg (ℕ tt) (λ n → Arg A (λ _ → Rec n (End (suc n))))

VecD : (A : Set) → Desc (ℕ tt)
VecD A = DataD (VecR A)

Vec : (A : Set) → ℕ tt → Set
Vec A = μ (VecD A)

NilEl : (A : Set) (n : ℕ tt) → Set
NilEl A n = El (nilD A) (Vec A) n

ConsEl : (A : Set) → ℕ tt → Set
ConsEl A n = El (consD A) (Vec A) n

VecEl : (A : Set) → ℕ tt → Set
VecEl A n = El (VecD A) (Vec A) n

NilHyps : (A : Set) (P : (n : ℕ tt) → Vec A n → Set) (n : ℕ tt) (xs : NilEl A n) → Set
NilHyps A P n xs = Hyps (nilD A) (Vec A) P n xs

ConsHyps : (A : Set) (P : (n : ℕ tt) → Vec A n → Set) (n : ℕ tt) (xs : ConsEl A n) → Set
ConsHyps A P n xs = Hyps (consD A) (Vec A) P n xs

VecHyps : (A : Set) (P : (n : ℕ tt) → Vec A n → Set) (n : ℕ tt) (xs : VecEl A n) → Set
VecHyps A P n xs = Hyps (VecD A) (Vec A) P n xs

ConsUncurriedHyps : (A : Set)
  (P : (n : ℕ tt) → Vec A n → Set)
  (cn : UncurriedEl (consD A) (Vec A)) → Set
ConsUncurriedHyps A P cn = UncurriedHyps (consD A) (Vec A) P cn

nil : (A : Set) → Vec A zero
nil A = init (nilT , refl)

cons : (A : Set) (n : ℕ tt) (x : A) (xs : Vec A n) → Vec A (suc n)
cons A n x xs = init (consT , n , x , xs , refl)

nil2 : (A : Set) → Vec A zero
nil2 A = inj (VecR A) nilT

cons2 : (A : Set) (n : ℕ tt) (x : A) (xs : Vec A n) → Vec A (suc n)
cons2 A = inj (VecR A) consT

----------------------------------------------------------------------

add : ℕ tt → ℕ tt → ℕ tt
add = elim ℕR _
  (λ n → n)
  (λ m ih n → suc (ih n))
  tt

mult : ℕ tt → ℕ tt → ℕ tt
mult = elim ℕR _
  (λ n → zero)
  (λ m ih n → add n (ih n))
  tt

append : (A : Set) (m : ℕ tt) (xs : Vec A m) (n : ℕ tt) (ys : Vec A n) → Vec A (add m n)
append A = elim (VecR A) (λ m xs → (n : ℕ tt) (ys : Vec A n) → Vec A (add m n))
  (λ n ys → ys)
  (λ m x xs ih n ys → cons A (add m n) x (ih n ys))

concat : (A : Set) (m n : ℕ tt) (xss : Vec (Vec A m) n) → Vec A (mult n m)
concat A m = elim (VecR (Vec A m)) (λ n xss → Vec A (mult n m))
  (nil A)
  (λ n xs xss ih → append A m xs (mult n m) ih)

----------------------------------------------------------------------

error: pathspec 'formalization/agda/Spire/Examples/PropLev2.agda' did not match any file(s) known to git


{-# OPTIONS --without-K #-}
open import Type
open import Function.NP
open import Level.NP

module Data.ShapePolymorphism where

data ☐ {a}(A : ★_ a) : ★_ a where
  [_] : ..(x : A) → ☐ A

un☐ : ∀ {a b}{A : ★_ a}{B : ☐ A → ★_ b} → (..(x : A) → B [ x ]) → Π (☐ A) B
un☐ f [ x ] = f x

Π☐ : ∀ {a b}(A : ★_ a) → (B : ☐ A → ★_ b) → ★_ (a ⊔ b)
Π☐ A B = (x : ☐ A) → B x

_>>☐_ : ∀ {a b}{A : ★_ a}{B : ☐ A → ★_ b} (x : ☐ A) → (..(x : A) → B [ x ]) → B x
[ x ] >>☐ f = f x

-- This is not a proper map since the function takes a ..A.
map☐ : ∀ {a b}{A : ★_ a}{B : ★_ b} → (..(x : A) → B) → ☐ A → ☐ B
map☐ f [ x ] = [ f x ]

-- This does not work since a ☐ has to be relevant when eliminated.
-- join☐ : ∀ {a}{A : ★_ a} → ☐ (☐ A) → ☐ A

{- This is not a proper bind either.
_>>=☐_ : ∀ {a b}{A : ★_ a}{B : ★_ b} (x : ☐ A) → (..(x : A) → ☐ B) → ☐ B
_>>=☐_ = _>>☐_
-}

data _≡☐_ {a} {A : ★_ a} (x : A) : ..(y : A) → ★_ a where
  refl : x ≡☐ x

record S⟨_⟩ {a} {A : ★_ a} ..(x : A) : ★_ a where
  constructor S[_∥_]
  field
    unS : A
    isS : unS ≡☐ x
open S⟨_⟩ public

pattern S[_] x = S[ x ∥ refl ]
{-
S[_] : ∀ {a}{A : ★_ a} (x : A) → S⟨ x ⟩
S[ x ] = S[ x ∥ refl ]
-}

error: pathspec 'lib/Data/ShapePolymorphism.agda' did not match any file(s) known to git


+Opaque

+Opaque

open import Data.String using (String)
open import Relation.Binary.PropositionalEquality

module Opaque {a} {A : Set a} where

{-
abstract
  opaque : String → A → A
  opaque _ = λ x → x

  opaque-rule : ∀ {s} x → opaque s x ≡ x
  opaque-rule x = refl
-}

postulate
  opaque : String → A → A
  opaque-rule : ∀ {s} x → opaque s x ≡ x

error: pathspec 'lib/Opaque.agda' did not match any file(s) known to git


Helios.agda

Helios.agda

open import Type
open import Data.List
open import Data.Product renaming (proj₁ to fst; proj₂ to snd)
{-
open import Data.Zero
open import Data.One
open import Data.Nat
-}
open import Data.Two
open import Control.Strategy

module Helios
  (VoterId : ★)
  (PublicKey : ★)
  (SecretKey : ★)
  (Vote   : ★)
  (Ballot : ★)
  (Decryption-share : ★)
  (PublicInfo : ★)
  where

Ballots = List (VoterId × Ballot)
Decryption-shares = List Decryption-share

record BB : ★ where
  constructor <_,,_,,_>
  field
    Y-pk              : PublicKey
    ballots           : Ballots
    decryption-shares : Decryption-shares
open BB public

module Nested
  (R-setup : ★)
  (setup : R-setup → PublicKey × {-List-} SecretKey)
  (R-vote : ★)

  (vote : PublicKey → R-vote → VoterId → Vote → Ballot)
  (validate : BB → VoterId × Ballot → 𝟚)

  (Tally : ★) -- could be a valid tally or a special symbol ⊥
  (dec-shares : PublicKey → Ballots → {-List-} SecretKey → Decryption-shares)
  (result : BB → Tally)

  (R-adversary : ★)
  where

  tally : BB → {-List-} SecretKey → BB
  tally < Y ,, bs ,, ds > sks = < Y ,, bs ,, dec-shares Y bs sks >

  data Q : ★ where
    ask-vote   : (v_ : Vote ²) → Q
    ask-ballot : (b  : Ballot) → Q

  VotingPhase = List (BB → VoterId × Q)

  add-ballot : VoterId → Ballot → BB → BB
  add-ballot vid b bb = record bb { ballots = (vid , b) ∷ ballots bb }

  module Run (β : 𝟚)
             (pk : PublicKey)
             (r-votes : VoterId → R-vote ²)
           where

    run-query : VoterId → Q → BB ² → BB ²
    run-query vid (ask-vote v_)  bb_ i = case validate (bb_ i) (vid , b)
                                          0: bb_ i
                                          1: add-ballot vid b (bb_ i)
      where
        b : Ballot
        b = vote pk (r-votes vid i) vid (v i)

    run-query vid (ask-ballot b) bb_ i =
        case validate (bb_ β) (vid , b)
          0: bb_ i
          1: case validate (bb_ (not β)) (vid , b)
               0: case i
                    0: add-ballot vid b (bb_ 0₂)
                    1: bb_ 1₂
               1: add-ballot vid b (bb_ i)

    run-voting-phase : VotingPhase → BB ² → BB ²
    run-voting-phase []       bb_ = bb_
    run-voting-phase (q ∷ qs) bb_ = run-voting-phase qs (uncurry run-query (q (bb_ β)) bb_)

  Adversary = R-adversary →
              PublicKey →
              VotingPhase ×
              (BB →
              𝟚)

  module Game (β : 𝟚)
              (r-setup : R-setup)
              (r-votes : VoterId → R-vote ²)
              (r-adversary : R-adversary)
              (A : Adversary)
              where
    pksk = setup r-setup
    pk = fst pksk
    sk = snd pksk

    BB-setup : BB
    BB-setup = < pk ,, [] ,, [] >

    BB²-setup : BB ²
    BB²-setup _ = BB-setup

    A-setup = A r-adversary pk

    A-voting-phase : VotingPhase
    A-voting-phase = fst A-setup

    open Run β pk r-votes

    exp : 𝟚
    exp = snd A-setup (run-voting-phase A-voting-phase BB²-setup β)

    game = exp == β
-- -}
-- -}
-- -}
-- -}
-- -}

error: pathspec 'Helios.agda' did not match any file(s) known to git


use lambda literal

use lambda literal

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/nfjinjing/chu2.git/'


add example of non-regular traversable functor

-- A traversable functor that is not regular.

open import Data.Nat
open import Data.Vec
open import Data.Product

record Applicative : Set₁ where
  constructor
    appl
  field
    Map   : Set → Set
    pure  : ∀ {A} → A → Map A
    call  : ∀ {A B} → Map (A → B) → Map A → Map B

Traversable : (Set → Set) → Set₁
Traversable F = (G : Applicative) →
                ∀ {A B} → (A → Map G B) → F A → Map G (F B)
  where open Applicative

infixr 10 _^_

-- exponents for naturals
_^_ : ℕ → ℕ → ℕ
m ^ zero = 1
m ^ suc n = m * (m ^ n)

-- a regular container
RegCon : Set → Set
RegCon A = Σ ℕ (Vec A)

-- a regular traversal
regTrav : Traversable RegCon

regTrav G f (0 , []) = pure G ((0 , []))
  where open Applicative

regTrav G f (suc n , x ∷ xs) =
  call G (call G
    (pure G (λ y nys → (suc (proj₁ nys) , y ∷ proj₂ nys)))
    (f x)) (regTrav G f (n , xs))
  where open Applicative

-- a nonregular language: 0, 10, 1100, 111000, ....
nonreg : ℕ → ℕ
nonreg n = let 2n = 2 ^ n in 2n * pred 2n

-- a nonregular finitary container
NonregCon : Set → Set
NonregCon A = Σ ℕ (λ n → Vec A (nonreg n))

fmap : ∀ {A B} (G : Applicative) → (A → B) →
       let open Applicative in Map G A → Map G B
fmap G f gx = call G (pure G f) gx
  where open Applicative

-- a nonregular traversable functor
nonregTrav : Traversable NonregCon
nonregTrav G f (n , xs) =
  let
    gnnys = regTrav G f ((nonreg n , xs))
  in
    fmap G (λ{(nn , ys) → (n , {!ys!})}) gnnys
    -- should be well-typed but is not

error: pathspec 'experiments/NonregularTraversable.agda' did not match any file(s) known to git


Added a README file

Added a README file

module EXPLORE-README where

open import Explore.Type
open import Explore.Explorable
open import Explore.Sum

-- Examples
open import Explore.Sum
open import Explore.Product

error: pathspec 'lib/EXPLORE-README.agda' did not match any file(s) known to git


markov.agda

markov.agda

Trans R S = S → M R S
          = S → R → S
          = W R S → S
          = R × S → S

Trans composition

Trans choice

TransFunction R S = R → S
TransFunction = M

if<_then_else_ : [0,1] → S → S → ([0,1] → S)
(if< p then x else y) q = if q <? p then x else y

withPr[_]then_else_ : [0,1] → Trans R S → Trans R S → Trans ([0,1] × R) S
withPr[ p ]then x else y = rand >>= if< p then x else y

data Machine R S ...

run : Machine R S → Trans R S
run ...

error: pathspec 'markov.agda' did not match any file(s) known to git


cyclic10.agda

error: pathspec 'cyclic10.agda' did not match any file(s) known to git


drafts/dsa.agda

drafts/dsa.agda

-- Draft: we should move to something provably secure, like Schnorr signature.

open import Function
open import Data.Bool using (Bool; true; false; if_then_else_; _∨_)
open import Data.Nat using (ℕ)
open import Data.Fin using (Fin; zero; suc)
open import Data.Maybe using (Maybe; nothing; just)
open import Data.Product using (_×_; _,_)

module dsa

-- (N : ℕ) -- = 256
-- (L : ℕ) -- = 2048

-- (q : ℕ) -- Bits N, Prime q
-- (p : ℕ) -- Bits L, Prime p, st. ∃ k, q * k = p-1

(ℤq : Set)

(G : Set) -- = ⟨ℤp⟩★ should for a group of order q
(g : G)   -- generator of the group G
(_^_  : G → ℤq → G)
(_∙pq_  : G → G → ℤq)

(g^_  : ℤq → ℤq)
(_⊞_  : ℤq → ℤq → ℤq)
(_∙_  : ℤq → ℤq → ℤq)
(_/_  : ℤq → ℤq → ℤq)

(ℤq★ : Set)
(refine? : ℤq → Maybe ℤq★)
(weaken : ℤq★ → ℤq)
(_==_ : ℤq → ℤq → Bool)
(_⁻¹ : ℤq★ → ℤq)

(M : Set)
(ℋ : M → ℤq)

where

Sig : Set
Sig = ℤq★ × ℤq★

Sign : (m : M) (x : ℤq) (r : ℤq) → Maybe Sig
Sign m x r = case (refine? R , refine? S) of λ
                { (just R′ , just S′) → just (R′ , S′)
                ; _                   → nothing
                }
  where R = g^ r
        S = (ℋ m ⊞ (x ∙ R)) / r

-- Reject the signature if 0 < r < q or 0 < s < q is not satisfied.
Ver : (m : M) (gˣ : G) (sig : Sig) → Bool
Ver m gˣ (R′ , S′) = R == v
  where R = weaken R′
        S = weaken S′
        w = S′ ⁻¹
        u₁ = ℋ m ∙ w -- mod q
        u₂ = R ∙ w    -- mod q
        v = (g ^ u₁) ∙pq (gˣ ^ u₂) {-mod p [mod-q] -}

error: pathspec 'drafts/dsa.agda' did not match any file(s) known to git


Add bytecode.agda to experiment with circuits

-- This module is an example of the use of the circuit building library.
-- The point is to start with a tiny bytecode evaluator for bit operations.
module bytecode where

open import Function
open import Data.Nat
open import Data.Vec
open import Data.Product.NP
open import Data.Bits
open import Data.Bool
open import Algebra.FunctionProperties

data I : ℕ → Set where
  `[]  : I 1
  `op₀ : ∀ {i} (b : Bit) (is : I (1 + i)) → I i
  `op₁ : ∀ {i} (op₁ : Op₁ Bit) (is : I (1 + i)) → I (1 + i)
  `op₂ : ∀ {i} (op₂ : Op₂ Bit) (is : I (1 + i)) → I (2 + i)

eval : ∀ {i} → I i → Bits i → Bit
eval `[] (x ∷ []) = x
eval (`op₀ b is) st = eval is (b ∷ st)
eval (`op₁ op₁ is) (b ∷ st) = eval is (op₁ b ∷ st)
eval (`op₂ op₂ is) (b₀ ∷ b₁ ∷ st) = eval is (op₂ b₀ b₁ ∷ st)

eval₀ : I 0 → Bit
eval₀ i₀ = eval i₀ []

open import circuit

module Ck {C} (cb : CircuitBuilder C) where
  open CircuitBuilder cb

  data IC : ℕ → Set where
    `[] : IC 1
    `op : ∀ {i ki ko} (op : C ki ko) (is : IC (ko + i)) → IC (ki + i)

  module Eval (runC : RunCircuit C) where
    module CF = CircuitBuilder bitsFunCircuitBuilder
    ckIC : ∀ {i} → IC i → C i 1
    ckIC `[]         = idC
    ckIC (`op op is) = op *** idC >>> ckIC is

    evalIC : ∀ {i} → IC i → Bits i → Bit
    evalIC is bs = head (runC (ckIC is) bs)

  ck : ∀ {i} → I i → C i 1
  ck `[]           = idC
  ck (`op₀ b   is) = bit b *** idC >>> ck is
  ck (`op₁ op₁ is) = unOp op₁ *** idC >>> ck is
  ck (`op₂ op₂ is) = binOp op₂ *** idC >>> ck is

  I2IC : ∀ {i} → I i → IC i
  I2IC `[] = `[]
  I2IC (`op₀ b is) = `op (bit b) (I2IC is)
  I2IC (`op₁ op₁ is) = `op (unOp op₁) (I2IC is)
  I2IC (`op₂ op₂ is) = `op (binOp op₂) (I2IC is)

  ck₀ : I 0 → C 0 1
  ck₀ = ck

module CheckCk where
  open Ck bitsFunCircuitBuilder
  open CircuitBuilder bitsFunCircuitBuilder
  open import Relation.Binary.PropositionalEquality

  ck-eval : ∀ {i} (is : I i) bs → ck is bs ≡ eval is bs ∷ []
  ck-eval `[] (x ∷ []) = refl
  ck-eval (`op₀ b is) bs = ck-eval is (b ∷ bs)
  ck-eval (`op₁ op₁ is) (b ∷ bs) = ck-eval is (op₁ b ∷ bs)
  ck-eval (`op₂ op₂ is) (b₀ ∷ b₁ ∷ bs) = ck-eval is (op₂ b₀ b₁ ∷ bs)

error: pathspec 'bytecode.agda' did not match any file(s) known to git


Added rewrite of Inference by Prabhakar

Added rewrite of Inference by Prabhakar

module 842Inference where
import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl; sym; trans; cong; cong₂; _≢_)
open import Data.Empty using (⊥; ⊥-elim)
open import Data.Nat using (ℕ; zero; suc; _+_)
open import Data.String using (String; _≟_)
open import Data.Product using (_×_; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
open import Relation.Nullary using (¬_; Dec; yes; no)
import plfa.part2.DeBruijn as DB

-- Syntax.

infix   4  _∋_⦂_
infix   4  _⊢_↑_
infix   4  _⊢_↓_
infixl  5  _,_⦂_

infixr  7  _⇒_

infix   5  ƛ_⇒_
infix   5  μ_⇒_
infix   6  _↑
infix   6  _↓_
infixl  7  _·_
infix   8  `suc_
infix   9  `_

Id : Set
Id = String

data Type : Set where
  `ℕ    : Type
  _⇒_   : Type → Type → Type

data Context : Set where
  ∅     : Context
  _,_⦂_ : Context → Id → Type → Context

data Term⁺ : Set
data Term⁻ : Set

data Term⁺ where
  `_                        : Id → Term⁺
  _·_                       : Term⁺ → Term⁻ → Term⁺
  _↓_                       : Term⁻ → Type → Term⁺

data Term⁻ where
  ƛ_⇒_                     : Id → Term⁻ → Term⁻
  `zero                    : Term⁻
  `suc_                    : Term⁻ → Term⁻
  `case_[zero⇒_|suc_⇒_]    : Term⁺ → Term⁻ → Id → Term⁻ → Term⁻
  μ_⇒_                     : Id → Term⁻ → Term⁻
  _↑                       : Term⁺ → Term⁻

-- Examples of terms.

two : Term⁻
two = `suc (`suc `zero)

plus : Term⁺
plus = (μ "p" ⇒ ƛ "m" ⇒ ƛ "n" ⇒
          `case (` "m") [zero⇒ ` "n" ↑
                        |suc "m" ⇒ `suc (` "p" · (` "m" ↑) · (` "n" ↑) ↑) ])
            ↓ (`ℕ ⇒ `ℕ ⇒ `ℕ)

2+2 : Term⁺
2+2 = plus · two · two
Ch : Type
Ch = (`ℕ ⇒ `ℕ) ⇒ `ℕ ⇒ `ℕ

twoᶜ : Term⁻
twoᶜ = (ƛ "s" ⇒ ƛ "z" ⇒ ` "s" · (` "s" · (` "z" ↑) ↑) ↑)

plusᶜ : Term⁺
plusᶜ = (ƛ "m" ⇒ ƛ "n" ⇒ ƛ "s" ⇒ ƛ "z" ⇒
           ` "m" · (` "s" ↑) · (` "n" · (` "s" ↑) · (` "z" ↑) ↑) ↑)
             ↓ (Ch ⇒ Ch ⇒ Ch)

sucᶜ : Term⁻
sucᶜ = ƛ "x" ⇒ `suc (` "x" ↑)

2+2ᶜ : Term⁺
2+2ᶜ = plusᶜ · twoᶜ · twoᶜ · sucᶜ · `zero

-- Lookup judgments.

data _∋_⦂_ : Context → Id → Type → Set where

  Z : ∀ {Γ x A}
      --------------------
    → Γ , x ⦂ A ∋ x ⦂ A

  S : ∀ {Γ x y A B}
    → x ≢ y
    → Γ ∋ x ⦂ A
      -----------------
    → Γ , y ⦂ B ∋ x ⦂ A

-- Synthesis and inheritance.

data _⊢_↑_ : Context → Term⁺ → Type → Set
data _⊢_↓_ : Context → Term⁻ → Type → Set

data _⊢_↑_ where

  ⊢` : ∀ {Γ A x}
    → Γ ∋ x ⦂ A
      -----------
    → Γ ⊢ ` x ↑ A

  _·_ : ∀ {Γ L M A B}
    → Γ ⊢ L ↑ A ⇒ B
    → Γ ⊢ M ↓ A
      -------------
    → Γ ⊢ L · M ↑ B

  ⊢↓ : ∀ {Γ M A}
    → Γ ⊢ M ↓ A
      ---------------
    → Γ ⊢ (M ↓ A) ↑ A

data _⊢_↓_ where

  ⊢ƛ : ∀ {Γ x N A B}
    → Γ , x ⦂ A ⊢ N ↓ B
      -------------------
    → Γ ⊢ ƛ x ⇒ N ↓ A ⇒ B

  ⊢zero : ∀ {Γ}
      --------------
    → Γ ⊢ `zero ↓ `ℕ

  ⊢suc : ∀ {Γ M}
    → Γ ⊢ M ↓ `ℕ
      ---------------
    → Γ ⊢ `suc M ↓ `ℕ

  ⊢case : ∀ {Γ L M x N A}
    → Γ ⊢ L ↑ `ℕ
    → Γ ⊢ M ↓ A
    → Γ , x ⦂ `ℕ ⊢ N ↓ A
      -------------------------------------
    → Γ ⊢ `case L [zero⇒ M |suc x ⇒ N ] ↓ A

  ⊢μ : ∀ {Γ x N A}
    → Γ , x ⦂ A ⊢ N ↓ A
      -----------------
    → Γ ⊢ μ x ⇒ N ↓ A

  ⊢↑ : ∀ {Γ M A B}
    → Γ ⊢ M ↑ A
    → A ≡ B
      -------------
    → Γ ⊢ (M ↑) ↓ B

-- PLFA exercise: write the term for multiplication (from Lambda)

-- PLFA exercise: extend the rules to support products (from More)

-- PLFA exercise (stretch): extend the rules to support the other
-- constructs from More

-- Equality of types.

_≟Tp_ : (A B : Type) → Dec (A ≡ B)
`ℕ      ≟Tp `ℕ              =  yes refl
`ℕ      ≟Tp (A ⇒ B)         =  no λ()
(A ⇒ B) ≟Tp `ℕ              =  no λ()
(A ⇒ B) ≟Tp (A′ ⇒ B′)
  with A ≟Tp A′ | B ≟Tp B′
...  | no A≢    | _         =  no λ{refl → A≢ refl}
...  | yes _    | no B≢     =  no λ{refl → B≢ refl}
...  | yes refl | yes refl  =  yes refl

-- Helpers: domain and range of equal function types are equal,
-- `ℕ is not a function type.

dom≡ : ∀ {A A′ B B′} → A ⇒ B ≡ A′ ⇒ B′ → A ≡ A′
dom≡ refl = refl

rng≡ : ∀ {A A′ B B′} → A ⇒ B ≡ A′ ⇒ B′ → B ≡ B′
rng≡ refl = refl

ℕ≢⇒ : ∀ {A B} → `ℕ ≢ A ⇒ B
ℕ≢⇒ ()

-- Lookup judgments are unique.

uniq-∋ : ∀ {Γ x A B} → Γ ∋ x ⦂ A → Γ ∋ x ⦂ B → A ≡ B
uniq-∋ Z Z                 =  refl
uniq-∋ Z (S x≢y _)         =  ⊥-elim (x≢y refl)
uniq-∋ (S x≢y _) Z         =  ⊥-elim (x≢y refl)
uniq-∋ (S _ ∋x) (S _ ∋x′)  =  uniq-∋ ∋x ∋x′

-- A synthesized type is unique.

uniq-↑ : ∀ {Γ M A B} → Γ ⊢ M ↑ A → Γ ⊢ M ↑ B → A ≡ B
uniq-↑ (⊢` ∋x) (⊢` ∋x′)       =  uniq-∋ ∋x ∋x′
uniq-↑ (⊢L · ⊢M) (⊢L′ · ⊢M′)  =  rng≡ (uniq-↑ ⊢L ⊢L′)
uniq-↑ (⊢↓ ⊢M) (⊢↓ ⊢M′)       =  refl

-- Failed lookups still fail if a different binding is added.

ext∋ : ∀ {Γ B x y}
  → x ≢ y
  → ¬ ∃[ A ]( Γ ∋ x ⦂ A )
    -----------------------------
  → ¬ ∃[ A ]( Γ , y ⦂ B ∋ x ⦂ A )
ext∋ x≢y _  ⟨ A , Z ⟩       =  x≢y refl
ext∋ _   ¬∃ ⟨ A , S _ ⊢x ⟩  =  ¬∃ ⟨ A , ⊢x ⟩

-- Decision procedure for lookup judgments.

lookup : ∀ (Γ : Context) (x : Id)
    -----------------------
  → Dec (∃[ A ](Γ ∋ x ⦂ A))
lookup ∅ x                        =  no  (λ ())
lookup (Γ , y ⦂ B) x with x ≟ y
... | yes refl                    =  yes ⟨ B , Z ⟩
... | no x≢y with lookup Γ x
...             | no  ¬∃          =  no  (ext∋ x≢y ¬∃)
...             | yes ⟨ A , ⊢x ⟩  =  yes ⟨ A , S x≢y ⊢x ⟩

-- Helpers for promoting a failure to type.

¬arg : ∀ {Γ A B L M}
  → Γ ⊢ L ↑ A ⇒ B
  → ¬ Γ ⊢ M ↓ A
    -------------------------
  → ¬ ∃[ B′ ](Γ ⊢ L · M ↑ B′)
¬arg ⊢L ¬⊢M ⟨ B′ , ⊢L′ · ⊢M′ ⟩ rewrite dom≡ (uniq-↑ ⊢L ⊢L′) = ¬⊢M ⊢M′

¬switch : ∀ {Γ M A B}
  → Γ ⊢ M ↑ A
  → A ≢ B
    ---------------
  → ¬ Γ ⊢ (M ↑) ↓ B
¬switch ⊢M A≢B (⊢↑ ⊢M′ A′≡B) rewrite uniq-↑ ⊢M ⊢M′ = A≢B A′≡B

-- Mutually-recursive synthesize and inherit functions.

synthesize : ∀ (Γ : Context) (M : Term⁺)
    -----------------------
  → Dec (∃[ A ](Γ ⊢ M ↑ A))

inherit : ∀ (Γ : Context) (M : Term⁻) (A : Type)
    ---------------
  → Dec (Γ ⊢ M ↓ A)

synthesize Γ (` x) with lookup Γ x
... | no  ¬∃              =  no  (λ{ ⟨ A , ⊢` ∋x ⟩ → ¬∃ ⟨ A , ∋x ⟩ })
... | yes ⟨ A , ∋x ⟩      =  yes ⟨ A , ⊢` ∋x ⟩
synthesize Γ (L · M) with synthesize Γ L
... | no  ¬∃              =  no  (λ{ ⟨ _ , ⊢L  · _  ⟩  →  ¬∃ ⟨ _ , ⊢L ⟩ })
... | yes ⟨ `ℕ ,    ⊢L ⟩  =  no  (λ{ ⟨ _ , ⊢L′ · _  ⟩  →  ℕ≢⇒ (uniq-↑ ⊢L ⊢L′) })
... | yes ⟨ A ⇒ B , ⊢L ⟩ with inherit Γ M A
...    | no  ¬⊢M          =  no  (¬arg ⊢L ¬⊢M)
...    | yes ⊢M           =  yes ⟨ B , ⊢L · ⊢M ⟩
synthesize Γ (M ↓ A) with inherit Γ M A
... | no  ¬⊢M             =  no  (λ{ ⟨ _ , ⊢↓ ⊢M ⟩  →  ¬⊢M ⊢M })
... | yes ⊢M              =  yes ⟨ A , ⊢↓ ⊢M ⟩

inherit Γ (ƛ x ⇒ N) `ℕ      =  no  (λ())
inherit Γ (ƛ x ⇒ N) (A ⇒ B) with inherit (Γ , x ⦂ A) N B
... | no ¬⊢N                =  no  (λ{ (⊢ƛ ⊢N)  →  ¬⊢N ⊢N })
... | yes ⊢N                =  yes (⊢ƛ ⊢N)
inherit Γ `zero `ℕ          =  yes ⊢zero
inherit Γ `zero (A ⇒ B)     =  no  (λ())
inherit Γ (`suc M) `ℕ with inherit Γ M `ℕ
... | no ¬⊢M                =  no  (λ{ (⊢suc ⊢M)  →  ¬⊢M ⊢M })
... | yes ⊢M                =  yes (⊢suc ⊢M)
inherit Γ (`suc M) (A ⇒ B)  =  no  (λ())
inherit Γ (`case L [zero⇒ M |suc x ⇒ N ]) A with synthesize Γ L
... | no ¬∃                 =  no  (λ{ (⊢case ⊢L  _ _) → ¬∃ ⟨ `ℕ , ⊢L ⟩})
... | yes ⟨ _ ⇒ _ , ⊢L ⟩    =  no  (λ{ (⊢case ⊢L′ _ _) → ℕ≢⇒ (uniq-↑ ⊢L′ ⊢L) })
... | yes ⟨ `ℕ ,    ⊢L ⟩ with inherit Γ M A
...    | no ¬⊢M             =  no  (λ{ (⊢case _ ⊢M _) → ¬⊢M ⊢M })
...    | yes ⊢M with inherit (Γ , x ⦂ `ℕ) N A
...       | no ¬⊢N          =  no  (λ{ (⊢case _ _ ⊢N) → ¬⊢N ⊢N })
...       | yes ⊢N          =  yes (⊢case ⊢L ⊢M ⊢N)
inherit Γ (μ x ⇒ N) A with inherit (Γ , x ⦂ A) N A
... | no ¬⊢N                =  no  (λ{ (⊢μ ⊢N) → ¬⊢N ⊢N })
... | yes ⊢N                =  yes (⊢μ ⊢N)
inherit Γ (M ↑) B with synthesize Γ M
... | no  ¬∃                =  no  (λ{ (⊢↑ ⊢M _) → ¬∃ ⟨ _ , ⊢M ⟩ })
... | yes ⟨ A , ⊢M ⟩ with A ≟Tp B
...   | no  A≢B             =  no  (¬switch ⊢M A≢B)
...   | yes A≡B             =  yes (⊢↑ ⊢M A≡B)

-- Copied from Lambda.

_≠_ : ∀ (x y : Id) → x ≢ y
x ≠ y  with x ≟ y
...       | no  x≢y  =  x≢y
...       | yes _    =  ⊥-elim impossible
  where postulate impossible : ⊥

-- Computed by evaluating 'synthesize ∅ 2+2' and editing.

⊢2+2 : ∅ ⊢ 2+2 ↑ `ℕ
⊢2+2 =
  (⊢↓
   (⊢μ
    (⊢ƛ
     (⊢ƛ
      (⊢case (⊢` (S (λ()) Z)) (⊢↑ (⊢` Z) refl)
       (⊢suc
        (⊢↑
         (⊢`
          (S (λ())
           (S (λ())
            (S (λ()) Z)))
          · ⊢↑ (⊢` Z) refl
          · ⊢↑ (⊢` (S (λ()) Z)) refl)
         refl))))))
   · ⊢suc (⊢suc ⊢zero)
   · ⊢suc (⊢suc ⊢zero))

-- Check that synthesis is correct (more below).

_ : synthesize ∅ 2+2 ≡ yes ⟨ `ℕ , ⊢2+2 ⟩
_ = refl

-- Example: 2+2 for Church numerals.

⊢2+2ᶜ : ∅ ⊢ 2+2ᶜ ↑ `ℕ
⊢2+2ᶜ =
  ⊢↓
  (⊢ƛ
   (⊢ƛ
    (⊢ƛ
     (⊢ƛ
      (⊢↑
       (⊢`
        (S (λ())
         (S (λ())
          (S (λ()) Z)))
        · ⊢↑ (⊢` (S (λ()) Z)) refl
        ·
        ⊢↑
        (⊢`
         (S (λ())
          (S (λ()) Z))
         · ⊢↑ (⊢` (S (λ()) Z)) refl
         · ⊢↑ (⊢` Z) refl)
        refl)
       refl)))))
  ·
  ⊢ƛ
  (⊢ƛ
   (⊢↑
    (⊢` (S (λ()) Z) ·
     ⊢↑ (⊢` (S (λ()) Z) · ⊢↑ (⊢` Z) refl)
     refl)
    refl))
  ·
  ⊢ƛ
  (⊢ƛ
   (⊢↑
    (⊢` (S (λ()) Z) ·
     ⊢↑ (⊢` (S (λ()) Z) · ⊢↑ (⊢` Z) refl)
     refl)
    refl))
  · ⊢ƛ (⊢suc (⊢↑ (⊢` Z) refl))
  · ⊢zero

_ : synthesize ∅ 2+2ᶜ ≡ yes ⟨ `ℕ , ⊢2+2ᶜ ⟩
_ = refl

-- Testing error cases.

_ : synthesize ∅ ((ƛ "x" ⇒ ` "y" ↑) ↓ (`ℕ ⇒ `ℕ)) ≡ no _
_ = refl

-- Bad argument type.

_ : synthesize ∅ (plus · sucᶜ) ≡ no _
_ = refl

-- Bad function types.

_ : synthesize ∅ (plus · sucᶜ · two) ≡ no _
_ = refl

_ : synthesize ∅ ((two ↓ `ℕ) · two) ≡ no _
_ = refl

_ : synthesize ∅ (twoᶜ ↓ `ℕ) ≡ no _
_ = refl

-- A natural can't have a function type.

_ : synthesize ∅ (`zero ↓ `ℕ ⇒ `ℕ) ≡ no _
_ = refl

_ : synthesize ∅ (two ↓ `ℕ ⇒ `ℕ) ≡ no _
_ = refl

-- Can't hide a bad type.

_ : synthesize ∅ (`suc twoᶜ ↓ `ℕ) ≡ no _
_ = refl

-- Can't case on a function type.

_ : synthesize ∅
      ((`case (twoᶜ ↓ Ch) [zero⇒ `zero |suc "x" ⇒ ` "x" ↑ ] ↓ `ℕ) ) ≡ no _
_ = refl

-- Can't hide a bad type inside case.

_ : synthesize ∅
      ((`case (twoᶜ ↓ `ℕ) [zero⇒ `zero |suc "x" ⇒ ` "x" ↑ ] ↓ `ℕ) ) ≡ no _
_ = refl

-- Mismatch of inherited and synthesized types.

_ : synthesize ∅ (((ƛ "x" ⇒ ` "x" ↑) ↓ `ℕ ⇒ (`ℕ ⇒ `ℕ))) ≡ no _
_ = refl

-- Erasure: Taking the evidence provided by synthesis on a decorated term
-- and producing the corresponding inherently-typed term.

-- Erasing a type.

∥_∥Tp : Type → DB.Type
∥ `ℕ ∥Tp             =  DB.`ℕ
∥ A ⇒ B ∥Tp          =  ∥ A ∥Tp DB.⇒ ∥ B ∥Tp

-- Erasing a context.

∥_∥Cx : Context → DB.Context
∥ ∅ ∥Cx              =  DB.∅
∥ Γ , x ⦂ A ∥Cx      =  ∥ Γ ∥Cx DB., ∥ A ∥Tp

-- Erasing a lookup judgment.

∥_∥∋ : ∀ {Γ x A} → Γ ∋ x ⦂ A → ∥ Γ ∥Cx DB.∋ ∥ A ∥Tp
∥ Z ∥∋               =  DB.Z
∥ S x≢ ⊢x ∥∋         =  DB.S ∥ ⊢x ∥∋

-- Mutually-recursive functions to erase typing judgments.

∥_∥⁺ : ∀ {Γ M A} → Γ ⊢ M ↑ A → ∥ Γ ∥Cx DB.⊢ ∥ A ∥Tp
∥_∥⁻ : ∀ {Γ M A} → Γ ⊢ M ↓ A → ∥ Γ ∥Cx DB.⊢ ∥ A ∥Tp

∥ ⊢` ⊢x ∥⁺           =  DB.` ∥ ⊢x ∥∋
∥ ⊢L · ⊢M ∥⁺         =  ∥ ⊢L ∥⁺ DB.· ∥ ⊢M ∥⁻
∥ ⊢↓ ⊢M ∥⁺           =  ∥ ⊢M ∥⁻

∥ ⊢ƛ ⊢N ∥⁻           =  DB.ƛ ∥ ⊢N ∥⁻
∥ ⊢zero ∥⁻           =  DB.`zero
∥ ⊢suc ⊢M ∥⁻         =  DB.`suc ∥ ⊢M ∥⁻
∥ ⊢case ⊢L ⊢M ⊢N ∥⁻  =  DB.case ∥ ⊢L ∥⁺ ∥ ⊢M ∥⁻ ∥ ⊢N ∥⁻
∥ ⊢μ ⊢M ∥⁻           =  DB.μ ∥ ⊢M ∥⁻
∥ ⊢↑ ⊢M refl ∥⁻      =  ∥ ⊢M ∥⁺

-- Tests that erasure works.

_ : ∥ ⊢2+2 ∥⁺ ≡ DB.2+2
_ = refl

_ : ∥ ⊢2+2ᶜ ∥⁺ ≡ DB.2+2ᶜ
_ = refl

-- PLFA exercise: demonstrate that synthesis on your decorated multiplication
-- followed by erasure gives your inherently-typed multiplication.

-- PLFA exercise: extend the above to include products.

-- PLFA exercise (stretch): extend the above to include
-- the rest of the features added in More.

-- Additions by PR:

-- From Lambda, with type annotation added

data Term : Set where
  `_                      :  Id → Term
  ƛ_⇒_                    :  Id → Term → Term
  _·_                     :  Term → Term → Term
  `zero                   :  Term
  `suc_                   :  Term → Term
  `case_[zero⇒_|suc_⇒_]    :  Term → Term → Id → Term → Term
  μ_⇒_                    :  Id → Term → Term
  _⦂_                     :  Term → Type → Term

-- Mutually-recursive decorators.

decorate⁻ : Term → Term⁻
decorate⁺ : Term → Term⁺

decorate⁻ (` x) = ` x ↑
decorate⁻ (ƛ x ⇒ M) = ƛ x ⇒ decorate⁻ M
decorate⁻ (M · M₁) = (decorate⁺ M) · (decorate⁻ M₁) ↑
decorate⁻ `zero = `zero
decorate⁻ (`suc M) = `suc (decorate⁻ M)
decorate⁻ `case M [zero⇒ M₁ |suc x ⇒ M₂ ]
 = `case (decorate⁺ M) [zero⇒ (decorate⁻ M₁) |suc x ⇒ (decorate⁻ M₂) ]
decorate⁻ (μ x ⇒ M) = μ x ⇒ decorate⁻ M
decorate⁻ (M ⦂ x) = decorate⁻ M

decorate⁺ (` x) = ` x
decorate⁺ (ƛ x ⇒ M) = ⊥-elim impossible
 where postulate impossible : ⊥
decorate⁺ (M · M₁) = (decorate⁺ M) · (decorate⁻ M₁)
decorate⁺ `zero = ⊥-elim impossible
 where postulate impossible : ⊥
decorate⁺ (`suc M) = ⊥-elim impossible
 where postulate impossible : ⊥
decorate⁺ `case M [zero⇒ M₁ |suc x ⇒ M₂ ] = ⊥-elim impossible
 where postulate impossible : ⊥
decorate⁺ (μ x ⇒ M) = ⊥-elim impossible
 where postulate impossible : ⊥
decorate⁺ (M ⦂ x) = decorate⁻ M ↓ x

ltwo : Term
ltwo = `suc `suc `zero

lplus : Term
lplus = (μ "p" ⇒ ƛ "m" ⇒ ƛ "n" ⇒
          `case ` "m"
            [zero⇒ ` "n"
            |suc "m" ⇒ `suc (` "p" · ` "m" · ` "n") ])
         ⦂ (`ℕ ⇒ `ℕ ⇒ `ℕ)

l2+2 : Term
l2+2 = lplus · ltwo · ltwo

ltwoᶜ : Term
ltwoᶜ =  ƛ "s" ⇒ ƛ "z" ⇒ ` "s" · (` "s" · ` "z")

lplusᶜ : Term
lplusᶜ =  (ƛ "m" ⇒ ƛ "n" ⇒ ƛ "s" ⇒ ƛ "z" ⇒
         ` "m" · ` "s" · (` "n" · ` "s" · ` "z"))
         ⦂ (Ch ⇒ Ch ⇒ Ch)

lsucᶜ : Term
lsucᶜ = ƛ "x" ⇒ `suc (` "x")

l2+2ᶜ : Term
l2+2ᶜ = lplusᶜ · ltwoᶜ · ltwoᶜ · lsucᶜ · `zero

_ : decorate⁻ ltwo ≡ two
_ = refl

_ : decorate⁺ lplus ≡ plus
_ = refl

_ : decorate⁺ l2+2 ≡ 2+2
_ = refl

_ : decorate⁻ ltwoᶜ ≡ twoᶜ
_ = refl

_ : decorate⁺ lplusᶜ ≡ plusᶜ
_ = refl

_ : decorate⁻ lsucᶜ ≡ sucᶜ
_ = refl

_ : decorate⁺ l2+2ᶜ ≡ 2+2ᶜ
_ = refl

{-
  Unicode used in this chapter:

  ↓  U+2193:  DOWNWARDS ARROW (\d)
  ↑  U+2191:  UPWARDS ARROW (\u)
  ∥  U+2225:  PARALLEL TO (\||)

-}

error: pathspec 'extra/842Inference.agda' did not match any file(s) known to git


Unfinished Group.Endomorphism module

Unfinished Group.Endomorphism module

{-# OPTIONS --without-K --copatterns #-}
open import Function.NP hiding (_∘_) renaming (_∘′_ to _∘_)
import Algebra.FunctionProperties.Eq
open Algebra.FunctionProperties.Eq.Implicits
open import Function.Extensionality
open import Data.Product.NP
open import Algebra.Monoid
open import Algebra.Monoid.Homomorphism
open import Algebra.Group
open import Algebra.Group.Abelian
open import Algebra.Group.Homomorphism
open import Relation.Binary.PropositionalEquality.NP renaming (_∙_ to _♦_)

import Algebra as A
import Algebra.Structures as AS

{- without commutativity
module Algebra.Group.Endomorphism {{_ : FunExt}}{ℓ}{G : Set ℓ}(𝔾 : Group G)
  where

open Group 𝔾 public

GroupEndomorphism : ∀ {ℓ}{G : Set ℓ} → Group G → Endo G → Set ℓ
GroupEndomorphism 𝔾 = GroupHomomorphism 𝔾 𝔾

EndoG = Σ (Endo G) (GroupEndomorphism 𝔾)

_⊙_ : Endo G → Endo G → Endo G
(f ⊙ g) x = f x ∙ g x

_⁽⁻¹⁾ : Endo G → Endo G
(f ⁽⁻¹⁾) x = (f x)⁻¹

⟨ε⟩ : Endo G
⟨ε⟩ = λ _ → ε

⊙-mon-ops : Monoid-Ops (Endo G)
⊙-mon-ops = _⊙_ , ⟨ε⟩

⊙-mon-struct : Monoid-Struct ⊙-mon-ops
⊙-mon-struct = (λ=ⁱ assoc , λ=ⁱ !assoc) , λ=ⁱ ε∙-identity , λ=ⁱ ∙ε-identity

⊙-grp-ops : Group-Ops (Endo G)
⊙-grp-ops = ⊙-mon-ops , _⁽⁻¹⁾

⊙-grp-struct : Group-Struct ⊙-grp-ops
⊙-grp-struct = ⊙-mon-struct , λ=ⁱ (fst inverse) , λ=ⁱ (snd inverse)

distr : _∘_ DistributesOverˡ _⊙_
distr {f} {g} {h} = λ= λ x → {!!}

ring : A.Ring _ _
ring = record
         { Carrier = Endo G
         ; _≈_ = _≡_
         ; _+_ = _⊙_
         ; _*_ = _∘_
         ; -_ = _⁽⁻¹⁾
         ; 0# = ⟨ε⟩
         ; 1# = id
         ; isRing =
           record
           { +-isAbelianGroup =
             record
             { isGroup =
               record
               { isMonoid =
                 record
                 { isSemigroup =
                   record { isEquivalence = isEquivalence
                          ; assoc = λ _ _ _ → λ=ⁱ assoc
                          ; ∙-cong = ap₂ _⊙_ }
                 ; identity = (λ _ → λ=ⁱ ε∙-identity)
                            , (λ _ → λ=ⁱ ∙ε-identity) }
               ; inverse = (λ _ → λ=ⁱ (fst inverse))
                         , (λ _ → λ=ⁱ (snd inverse))
               ; ⁻¹-cong = ap _⁽⁻¹⁾ }
             ; comm = {!!} }
           ; *-isMonoid =
             record
             { isSemigroup =
               record { isEquivalence = isEquivalence
                      ; assoc = λ _ _ _ → idp
                      ; ∙-cong = ap₂ _∘_ }
             ; identity = (λ _ → idp) , (λ _ → idp) }
           ; distrib = {!!} }
         }
-}

module Algebra.Group.Endomorphism {{_ : FunExt}}{ℓ}{G : Set ℓ} -- (𝔾 : Group G)
  where

postulate
  𝔾 : Abelian-Group G

module 𝔾 = Abelian-Group 𝔾

open 𝔾

𝔾' : Group G
𝔾' = grp

open GroupHomomorphism

GroupEndomorphism : ∀ {ℓ}{G : Set ℓ} → Group G → Endo G → Set ℓ
GroupEndomorphism 𝔾 = GroupHomomorphism 𝔾 𝔾

EndoG = Σ (Endo G) (GroupEndomorphism grp)

endoG= : {f g : EndoG} → (∀ {x} → fst f x ≡ fst g x) → f ≡ g
endoG= {f} {g} fg = ?

_⊙_ : Endo G → Endo G → Endo G
(f ⊙ g) x = f x ∙ g x

_⊙'_ : EndoG → EndoG → EndoG
fst (f ⊙' g) = fst f ⊙ fst g
hom (snd (f ⊙' g)) = ∙= (hom (snd f)) (hom (snd g)) ♦ interchange

_⁽⁻¹⁾ : Endo G → Endo G
(f ⁽⁻¹⁾) x = (f x)⁻¹

_⁽⁻¹⁾' : EndoG → EndoG
fst (f ⁽⁻¹⁾') x = (fst f x)⁻¹
hom (snd (f ⁽⁻¹⁾')) = ap _⁻¹ (hom (snd f)) ♦ ⁻¹-hom

⟨ε⟩ : Endo G
⟨ε⟩ = λ _ → ε

⟨ε⟩' : EndoG
fst ⟨ε⟩'       = ⟨ε⟩
hom (snd ⟨ε⟩') = ! ε∙-identity

⊙-mon-ops : Monoid-Ops (Endo G)
⊙-mon-ops = _⊙_ , ⟨ε⟩

⊙-mon-ops' : Monoid-Ops EndoG
⊙-mon-ops' = _⊙'_ , ⟨ε⟩'

⊙-mon-struct : Monoid-Struct ⊙-mon-ops
⊙-mon-struct = (λ=ⁱ assoc , λ=ⁱ !assoc) , λ=ⁱ ε∙-identity , λ=ⁱ ∙ε-identity

⊙-mon-struct' : Monoid-Struct ⊙-mon-ops'
⊙-mon-struct' = (endoG= assoc , endoG= !assoc) , endoG= ε∙-identity , endoG= ∙ε-identity

⊙-grp-ops : Group-Ops (Endo G)
⊙-grp-ops = ⊙-mon-ops , _⁽⁻¹⁾

⊙-grp-ops' : Group-Ops EndoG
⊙-grp-ops' = ⊙-mon-ops' , _⁽⁻¹⁾'

⊙-grp-struct : Group-Struct ⊙-grp-ops
⊙-grp-struct = ⊙-mon-struct , λ=ⁱ (fst inverse) , λ=ⁱ (snd inverse)

⊙-grp-struct' : Group-Struct ⊙-grp-ops'
⊙-grp-struct' = ⊙-mon-struct' , endoG= (fst inverse) , endoG= (snd inverse)

id' : EndoG
fst id' = id
hom (snd id') = idp

_∘'_ : EndoG → EndoG → EndoG
fst (f ∘' g) = fst f ∘ fst g
hom (snd (f ∘' g)) = ap (fst f) (hom (snd g)) ♦ hom (snd f)

-- NOTE: only the the first function needs to be an homomorphism
distr : _∘'_ DistributesOverˡ _⊙'_
distr {_ , mk f-hom} = endoG= f-hom

{-
ring : A.Ring _ _
ring = record
         { Carrier = EndoG
         ; _≈_ = _≡_
         ; _+_ = _⊙'_
         ; _*_ = _∘'_
         ; -_ = _⁽⁻¹⁾'
         ; 0# = ⟨ε⟩'
         ; 1# = {!id!}
         ; isRing =
           record
           { +-isAbelianGroup =
             record
             { isGroup =
               record
               { isMonoid =
                 record
                 { isSemigroup =
                   record { isEquivalence = isEquivalence
                          ; assoc = {!λ _ _ _ → λ=ⁱ assoc!}
                          ; ∙-cong = ap₂ _⊙'_ }
                 ; identity = (λ _ → λ=ⁱ ε∙-identity)
                            , (λ _ → λ=ⁱ ∙ε-identity) }
               ; inverse = (λ _ → λ=ⁱ (fst inverse))
                         , (λ _ → λ=ⁱ (snd inverse))
               ; ⁻¹-cong = ap _⁽⁻¹⁾ }
             ; comm = λ _ _ → λ=ⁱ comm }
           ; *-isMonoid =
             record
             { isSemigroup =
               record { isEquivalence = isEquivalence
                      ; assoc = λ _ _ _ → idp
                      ; ∙-cong = ap₂ _∘_ }
             ; identity = (λ _ → idp) , (λ _ → idp) }
           ; distrib = (λ _ _ _ → λ=ⁱ {!!}) , {!λ _ _ _ → λ=ⁱ distr!} }
         }
{-
ring : A.Ring _ _
ring = record
         { Carrier = Endo G
         ; _≈_ = _≡_
         ; _+_ = _⊙_
         ; _*_ = _∘_
         ; -_ = _⁽⁻¹⁾
         ; 0# = ⟨ε⟩
         ; 1# = id
         ; isRing =
           record
           { +-isAbelianGroup =
             record
             { isGroup =
               record
               { isMonoid =
                 record
                 { isSemigroup =
                   record { isEquivalence = isEquivalence
                          ; assoc = λ _ _ _ → λ=ⁱ assoc
                          ; ∙-cong = ap₂ _⊙_ }
                 ; identity = (λ _ → λ=ⁱ ε∙-identity)
                            , (λ _ → λ=ⁱ ∙ε-identity) }
               ; inverse = (λ _ → λ=ⁱ (fst inverse))
                         , (λ _ → λ=ⁱ (snd inverse))
               ; ⁻¹-cong = ap _⁽⁻¹⁾ }
             ; comm = λ _ _ → λ=ⁱ comm }
           ; *-isMonoid =
             record
             { isSemigroup =
               record { isEquivalence = isEquivalence
                      ; assoc = λ _ _ _ → idp
                      ; ∙-cong = ap₂ _∘_ }
             ; identity = (λ _ → idp) , (λ _ → idp) }
           ; distrib = (λ _ _ _ → λ=ⁱ {!!}) , {!λ _ _ _ → λ=ⁱ distr!} }
         }
-- -}
-- -}
-- -}
-- -}

error: pathspec 'lib/Algebra/Group/Endomorphism.agda' did not match any file(s) known to git


{-# OPTIONS --without-K #-}
open import Type
open import Control.Protocol
open import Control.Protocol.Additive
open import Control.Protocol.Multiplicative

module Control.Protocol.CLL where
{-
A `⊗ B 'times', context chooses how A and B are used
A `⅋ B 'par', "we" chooses how A and B are used
A `⊕ B 'plus', select from A or B
A `& B 'with', offer choice of A or B
`! A   'of course!', server accept
`? A   'why not?', client request
`1     unit for `⊗
`⊥     unit for `⅋
`0     unit for `⊕
`⊤     unit for `&
-}
data CLL : ★ where
  `1 `⊤ `0 `⊥ : CLL
  _`⊗_ _`⅋_ _`⊕_ _`&_ : (A B : CLL) → CLL
  -- `!_ `?_ : (A : CLL) → CLL

_⊥ : CLL → CLL
`1 ⊥ = `⊥
`⊥ ⊥ = `1
`0 ⊥ = `⊤
`⊤ ⊥ = `0
(A `⊗ B)⊥ = A ⊥ `⅋ B ⊥
(A `⅋ B)⊥ = A ⊥ `⊗ B ⊥
(A `⊕ B)⊥ = A ⊥ `& B ⊥
(A `& B)⊥ = A ⊥ `⊕ B ⊥
{-
(`! A)⊥ = `?(A ⊥)
(`? A)⊥ = `!(A ⊥)
-}

CLL-proto : CLL → Proto
CLL-proto `1       = end
CLL-proto `⊥       = end
CLL-proto `0       = P0
CLL-proto `⊤       = P⊤
CLL-proto (A `⊗ B) = CLL-proto A ⊗ CLL-proto B
CLL-proto (A `⅋ B) = CLL-proto A ⅋ CLL-proto B
CLL-proto (A `⊕ B) = CLL-proto A ⊕ CLL-proto B
CLL-proto (A `& B) = CLL-proto A & CLL-proto B

{- The point of this could be to devise a particular equivalence
   relation for processes. It could properly deal with ⅋. -}

error: pathspec 'Control/Protocol/CLL.agda' did not match any file(s) known to git


Add ZK.SigmaProtocol.KnowStatement

Add ZK.SigmaProtocol.KnowStatement

open import Type                 using (Type)
open import Data.Bool.Base       using (Bool; true)
open import Relation.Binary.Core using (_≡_; _≢_)

-- This module assumes the exact statement of the Zero-Knowledge proof to be
-- known by all parties.
module ZK.SigmaProtocol.KnownStatement
          (Commitment : Type) -- Prover commitments
          (Challenge  : Type) -- Verifier challenges, picked at random
          (Response   : Type) -- Prover responses/proofs to challenges
          (Randomness : Type) -- Prover's randomness
          (Witness    : Type) -- Prover's witness
          (ValidWitness : Witness → Type) -- Valid witness for the statement
       where

-- The prover is made of two steps.
-- * First, send the commitment.
-- * Second, receive a challenge and send back the response.
--
-- Therefor one represents a prover as a pair (a record) made
-- of a commitment (get-A) and a function (get-f) from challenges
-- to responses.
--
-- Note that one might wish the function get-f to be partial.
--
-- This covers any kind of prover, either honest or dishonest
-- Notice as well that such should depend on some randomness.
-- So such a prover as type: SomeRandomness → Prover
record Prover-Interaction : Type where
  constructor _,_
  field
    get-A : Commitment
    get-f : Challenge → Response

Prover : Type
Prover = (r : Randomness)(w : Witness) → Prover-Interaction

-- A transcript of the interaction between the prover and the
-- verifier.
--
-- Note that in the case of an interactive zero-knowledge
-- proof the transcript alone does not prove anything. It can usually
-- be simulated if one knows the challenge before the commitment.
--
-- The only way to be convinced by an interactive prover is to be/trust the verifier,
-- namely to receive the commitment first and send a randomly picked challenge
-- thereafter. So the proof is not transferable.
--
-- The other way is by making the zero-knowledge proof non-interactive, which forces the
-- challenge to be a cryptographic hash of the commitment and the statement.
-- See the StrongFiatShamir module and the corresponding paper for more details.
record Transcript : Type where
  constructor mk
  field
    get-A : Commitment
    get-c : Challenge
    get-f : Response

-- The actual behavior of an interactive verifier is as follows:
-- * Given a statement
-- * Receive a commitment from the prover
-- * Send a randomly chosen challenge to the prover
-- * Receive a response to that challenge
-- Since the first two points are common to all Σ-protocols we describe
-- the verifier behavior as a computable test on the transcript.
Verifier : Type
Verifier = (t : Transcript) → Bool

-- To run the interaction, one only needs the prover and a randomly
-- chosen challenge. The returned transcript is then checked by the
-- verifier afterwards.
run : Prover-Interaction → Challenge → Transcript
run (A , f) c = mk A c (f c)

-- A Σ-protocol is made of the code for honest prover
-- and honest verifier.
record Σ-Protocol : Type where
  constructor _,_
  field
    prover   : Prover
    verifier : Verifier

  Verified : (t : Transcript) → Type
  Verified t = verifier t ≡ true

-- Correctness (also called completeness in some papers): a Σ-protocol is said
-- to be correct if for any challenge, the (honest) verifier accepts what
-- the (honest) prover returns.
Correct : Σ-Protocol → Type
Correct (prover , verifier) = ∀ r {w} c → ValidWitness w → verifier (run (prover r w) c) ≡ true

-- A simulator takes a challenge and a response and returns a commitment.
--
-- As defined next, a correct simulator picks the commitment such that
-- the transcript is accepted by the verifier.
--
-- Notice that generally, to make a valid looking transcript one should
-- randomly pick the challenge and the response.
Simulator : Type
Simulator = (c : Challenge) (s : Response) → Commitment

-- A correct simulator always convinces the honest verifier.
Correct-simulator : Verifier → Simulator → Type
Correct-simulator verifier simulator
  = ∀ c s → let A = simulator c s in
            verifier (mk A c s) ≡ true

{-
  A Σ-protocol, more specifically a verifier which is equipped with
  a correct simulator is said to be Special Honest Verifier Zero Knowledge.
  This property is one of the condition to apply the Strong Fiat Shamir
  transformation.

  The Special part of Special-Honest-Verifier-Zero-Knowledge is covered by the
  simulator being correct.

  The Honest part is not covered yet, the definition is informally adapted from
  the paper "How not to prove yourself":

  Furthermore, if the challenge c and response s where chosen uniformly at random from their respective
  domains then the triple (A, c, s) is distributed identically to that of an execution
  between the (honest) prover and the (honest) verifier (run prover c).

  where A = simulator c s
-}
record Special-Honest-Verifier-Zero-Knowledge (Σ-proto : Σ-Protocol) : Type where
  open Σ-Protocol Σ-proto
  field
    simulator         : Simulator
    correct-simulator : Correct-simulator verifier simulator

-- A pair of "Transcript"s such that the commitment is shared
-- and the challenges are different.
record Transcript² (verifier : Verifier) : Type where
  constructor mk
  field
    -- The commitment is shared
    get-A         : Commitment

    -- The challenges...
    get-c₀ get-c₁ : Challenge

    -- ...are different
    c₀≢c₁         : get-c₀ ≢ get-c₁

    -- The responses/proofs are arbitrary
    get-f₀ get-f₁ : Response

  -- The two transcripts
  t₀ : Transcript
  t₀ = mk get-A get-c₀ get-f₀
  t₁ : Transcript
  t₁ = mk get-A get-c₁ get-f₁

  field
    -- The transcripts verify
    verify₀ : verifier t₀ ≡ true
    verify₁ : verifier t₁ ≡ true

-- Remark: What if the underlying witnesses are different? Nothing is enforced here.
-- At least in the case of the Schnorr protocol it does not matter and yield a unique
-- witness.
Extractor : Verifier → Type
Extractor verifier = Transcript² verifier → Witness

Extract-Valid-Witness : (verifier : Verifier) → Extractor verifier → Type
Extract-Valid-Witness verifier extractor = ∀ t² → ValidWitness (extractor t²)

-- A Σ-protocol, more specifically a verifier which is equipped with
-- a correct extractor is said to have the Special Soundness property.
-- This property is one of the condition to apply the Strong Fiat Shamir
-- transformation.
record Special-Soundness Σ-proto : Type where
  open Σ-Protocol Σ-proto
  field
  -- TODO Challenge should exp large wrt the security param
    extractor             : Extractor verifier
    extract-valid-witness : Extract-Valid-Witness verifier extractor

record Special-Σ-Protocol : Type where
  field
    Σ-protocol : Σ-Protocol
    correct : Correct Σ-protocol
    shvzk   : Special-Honest-Verifier-Zero-Knowledge Σ-protocol
    ssound  : Special-Soundness Σ-protocol
  open Σ-Protocol Σ-protocol public
  open Special-Honest-Verifier-Zero-Knowledge shvzk public
  open Special-Soundness ssound public

error: pathspec 'ZK/SigmaProtocol/KnownStatement.agda' did not match any file(s) known to git


start Terminal object structure as adjoint pair

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/zeitraffer/agda-cats.git/'


-- Why I don't want LEM

open import Type
open import Function
open import Data.Two
open import Relation.Binary.Logical
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality.NP

module Relation.Binary.Logical.LEM
  (LEM : (P : ★₁) → Dec P) where

broken-id : ∀ (A : ★) → A → A
broken-id A with LEM (A ≡ 𝟚)
... | yes p = coe! p ∘ not ∘ coe p
... | no ¬p = id

error: pathspec 'lib/Relation/Binary/Logical/LEM.agda' did not match any file(s) known to git


ZK/Types.agda

ZK/Types.agda

open import Type
open import Data.Bool.Minimal

module ZK.Types where

-- Minimal interface needed for cyclic group + base field
record Cyclic-group (G ℤq : ★) : ★ where
  field
    g    : G
    _^_  : G  → ℤq → G
    _·_  : G  → G  → G
    _/_  : G  → G  → G
    _+_  : ℤq → ℤq → ℤq
    _*_  : ℤq → ℤq → ℤq
    _==_ : (x y : G) → Bool

error: pathspec 'ZK/Types.agda' did not match any file(s) known to git


module Search.Searchable.Fin where

open import Function
open import Data.Fin using (Fin; zero; suc)
open import Data.Nat

open import Search.Type
open import Search.Searchable

module _ {A : Set}(μA : Searchable A) where

  sA = search μA

  extend : ∀ {n} → A → (Fin n → A) → Fin (suc n) → A
  extend x g zero    = x
  extend x g (suc i) = g i

  ¬Fin0 : Fin 0 → A
  ¬Fin0 ()

  -- There is one function Fin 0 → A (called abs) so this should be fine
  -- if not there is a version below that forces the domain to be non-empty
  sFun : ∀ n → Search _ (Fin n → A)
  sFun zero    op f = f ¬Fin0
  sFun (suc n) op f = sA op (λ x → sFun n op (f ∘ extend x))

  ind : ∀ n → SearchInd _ (sFun n)
  ind zero    P P∙ Pf = Pf _
  ind (suc n) P P∙ Pf =
    search-ind μA (λ sa → P (λ op f → sa op (λ x → sFun n op (f ∘ extend x))))
      P∙
      (λ x → ind n (λ sf → P (λ op f → sf op (f ∘ extend x)))
        P∙ (Pf ∘ extend x))

  μFun : ∀ {n} → Searchable (Fin n → A)
  μFun = mk _ (ind _) {!!}

error: pathspec 'Search/Searchable/Fin.agda' did not match any file(s) known to git


The embed procedure, pending correctness proof (toward #62)

Old-commit-hash: 3c509c159e02c62a037765e323a4b6f6445c5df9

module Embed62 where

open import TaggedDeltaTypes
open import Data.Product using (_×_ ; _,_ ; proj₁ ; proj₂)

Δ-Type : Type → Type
Δ-Type nats = (nats ⇒ nats ⇒ nats) ⇒ nats -- Church pairs
Δ-Type bags = bags
Δ-Type (σ ⇒ τ) = σ ⇒ Δ-Type σ ⇒ Δ-Type τ

Δ-Context : Context → Context
Δ-Context ∅ = ∅
Δ-Context (τ • Γ) = Δ-Type τ • τ • Δ-Context Γ

⟦fst⟧ : ∀ {A : Set} → A → A → A
⟦fst⟧ a b = a
⟦snd⟧ : ∀ {A : Set} → A → A → A
⟦snd⟧ a b = b

translate : ∀ {τ} → ⟦ Δ-Type τ ⟧ → ΔVal τ
translate {nats} dn = dn ⟦fst⟧ , dn ⟦snd⟧
translate {bags} db = db
translate {σ ⇒ τ} df = λ v dv R[v,dv] → translate (df v {!dv!})
-- TODO figure out what to do to dv to put it in the hole

consistent : ∀ {Γ} → ⟦ Δ-Context Γ ⟧ → Set
consistent {∅} ∅ = EmptySet
consistent {τ • Γ} (dv • v • ρ) = couple (valid v (translate dv)) (consistent ρ)

recall : ∀ {Γ} (ρ : ⟦ Δ-Context Γ ⟧) (γ : consistent ρ)  → ΔEnv Γ
recall {∅} ∅ ∅ = ∅
recall {τ • Γ} (dv • v • ρ) (cons R[v,dv] γ _ _) = {!!}

Γ≼ΔΓ : ∀ {Γ} → Γ ≼ Δ-Context Γ
Γ≼ΔΓ {∅} = ∅≼∅
Γ≼ΔΓ {τ • Γ} = drop Δ-Type τ • keep τ • Γ≼ΔΓ

weak : ∀ {τ Γ} → Term Γ τ → Term (Δ-Context Γ) τ
weak = weaken Γ≼ΔΓ

deriveVar : ∀ {τ Γ} → Var Γ τ → Var (Δ-Context Γ) (Δ-Type τ)
deriveVar this = this
deriveVar (that x) = that (that (deriveVar x))

absurd : ∀ {A B : Set} → A → A → B → B
absurd _ _ b = b

fst : ∀ {τ Γ} → Term Γ (τ ⇒ τ ⇒ τ)
fst = abs (abs (var (that this)))
snd : ∀ {τ Γ} → Term Γ (τ ⇒ τ ⇒ τ)
snd = abs (abs (var this))

difff : ∀ {τ Γ} → Term Γ τ → Term Γ τ → Term Γ (Δ-Type τ)
apply : ∀ {τ Γ} → Term Γ (Δ-Type τ) → Term Γ τ → Term Γ τ

apply {nats} dt t = app dt snd
apply {bags} dt t = union t dt
apply {σ ⇒ τ} dt t = abs (apply
  (app (app (weaken (drop _ • Γ≼Γ) dt)
    (var this)) (difff (var this) (var this)))
  (app (weaken (drop _ • Γ≼Γ) t) (var this)))

difff {nats} s t = abs (app (app (var this)
  (weaken (drop _ • Γ≼Γ) s)) (weaken (drop _ • Γ≼Γ) t))
difff {bags} s t = diff s t
difff {σ ⇒ τ} s t = abs (abs (difff
  (app (weaken (drop _ • drop _ • Γ≼Γ) s)
    (apply (var this) (var (that this))))
  (app (weaken (drop _ • drop _ • Γ≼Γ) t) (var (that this)))))

embed : ∀ {τ Γ} → ΔTerm Γ τ → Term (Δ-Context Γ) (Δ-Type τ)
embed (Δnat old new) = abs (app (app (var this) (nat old)) (nat new))
embed (Δbag db) = bag db
embed (Δvar x) = var (deriveVar x)
embed (Δabs dt) = abs (abs (embed dt))
embed (Δapp ds t dt) = app (app (embed ds) (weak t)) (embed dt)
embed (Δadd ds dt) = abs (app (app (var this)
  (add (app (weaken (drop _ • Γ≼Γ) (embed ds)) fst)
       (app (weaken (drop _ • Γ≼Γ) (embed dt)) fst)))
  (add (app (weaken (drop _ • Γ≼Γ) (embed ds)) snd)
       (app (weaken (drop _ • Γ≼Γ) (embed dt)) snd)))
embed (Δmap₀ s ds t dt) = diff
  (map (apply (embed ds) (weak s)) (apply (embed dt) (weak t)))
  (weak (map s t))
embed (Δmap₁ s dt) = map (weak s) (embed dt)
embed (Δunion ds dt) = union (embed ds) (embed dt)
embed (Δdiff ds dt) = diff (embed ds) (embed dt)

-- embed-correct : ∀ {τ Γ} {t : Term Γ τ} {ρ : ΔEnv}

error: pathspec 'experimental/Embed62.agda' did not match any file(s) known to git


module Search.Searchable.Fun where

open import Type hiding (★)
open import Data.Product
open import Data.Sum
open import Data.Unit
open import Data.Bits
open import Function.NP
open import Search.Type
open import Search.Searchable
open import Search.Searchable.Product
open import Search.Searchable.Sum
import Function.Inverse.NP as FI
open FI using (_↔_; inverses; module Inverse) renaming (_$₁_ to to; _$₂_ to from)
open import Function.Related.TypeIsomorphisms.NP
import Relation.Binary.PropositionalEquality.NP as ≡
open ≡ using (_≡_; _≗_)

private -- unused
    SΠΣ⁻ : ∀ {m A} {B : A → ★ _} {C : Σ A B → ★ _}
           → Search m ((x : A) (y : B x) → C (x , y))
           → Search m (Π (Σ A B) C)
    SΠΣ⁻ s _∙_ f = s _∙_ (f ∘ uncurry)

    SΠΣ⁻-ind : ∀ {m p A} {B : A → ★ _} {C : Σ A B → ★ _}
               → {s : Search m ((x : A) (y : B x) → C (x , y))}
               → SearchInd p s
               → SearchInd p (SΠΣ⁻ s)
    SΠΣ⁻-ind ind P P∙ Pf = ind (P ∘ SΠΣ⁻) P∙ (Pf ∘ uncurry)

    S×⁻ : ∀ {m A B C} → Search m (A → B → C) → Search m (A × B → C)
    S×⁻ = SΠΣ⁻

    S×⁻-ind : ∀ {m p A B C}
              → {s : Search m (A → B → C)}
              → SearchInd p s
              → SearchInd p (S×⁻ s)
    S×⁻-ind = SΠΣ⁻-ind

    SΠ⊎⁻ : ∀ {m A B} {C : A ⊎ B → ★ _}
           → Search m (Π A (C ∘ inj₁) × Π B (C ∘ inj₂))
           → Search m (Π (A ⊎ B) C)
    SΠ⊎⁻ s _∙_ f = s _∙_ (f ∘ uncurry [_,_])

    SΠ⊎⁻-ind : ∀ {m p A B} {C : A ⊎ B → ★ _}
                 {s : Search m (Π A (C ∘ inj₁) × Π B (C ∘ inj₂))}
                 (i : SearchInd p s)
               → SearchInd p (SΠ⊎⁻ {C = C} s) -- A sB)
    SΠ⊎⁻-ind i P P∙ Pf = i (P ∘ SΠ⊎⁻) P∙ (Pf ∘ uncurry [_,_])

    {- For each A→C function
       and each B→C function
       an A⊎B→C function is yield
     -}
    S⊎⁻ : ∀ {m A B C} → Search m (A → C) → Search m (B → C)
                      → Search m (A ⊎ B → C)
    S⊎⁻ sA sB =  SΠ⊎⁻ (sA ×-search sB)

μΠΣ⁻ : ∀ {A B}{C : Σ A B → ★₀} → Searchable ((x : A)(y : B x) → C (x , y)) → Searchable (Π (Σ A B) C)
μΠΣ⁻ = μ-iso (FI.sym curried)

Σ-Fun : ∀ {A B} → Funable A → Funable B → Funable (A × B)
Σ-Fun (μA , μA→) FB  = μΣ μA (searchable FB) , (λ x → μΠΣ⁻ (μA→ (negative FB x)))
  where open Funable

{-
μΠ⊎⁻ : ∀ {A B : ★₀}{C : A ⊎ B → ★ _} → Searchable (Π A (C ∘ inj₁) × Π B (C ∘ inj₂))
     → Searchable (Π (A ⊎ B) C)
μΠ⊎⁻ = μ-iso ?

_⊎-Fun_ : ∀ {A B : ★₀} → Funable A → Funable B → Funable (A ⊎ B)
_⊎-Fun_ (μA , μA→) (μB , μB→) = (μA ⊎-μ μB) , (λ X → μΠ⊎⁻ (μA→ X ×-μ μB→ X))
-}

S⊤ : ∀ {m A} → Search m A → Search m (⊤ → A)
S⊤ sA _∙_ f = sA _∙_ (f ∘ const)

SΠBit : ∀ {m A} → Search m (A 0b) → Search m (A 1b)
                → Search m (Π Bit A)
SΠBit sA₀ sA₁ _∙_ f = sA₀ _∙_ λ x → sA₁ _∙_ λ y → f λ {true → y; false → x}

×-Dist : ∀ {A B} FA FB → DistFunable {A} FA → DistFunable {B} FB → DistFunable (Σ-Fun FA FB)
×-Dist FA FB FA-dist FB-dist μX c _⊙_ distrib _⊙-cong_ f
  = Πᴬ (λ x → Πᴮ (λ y → Σ' (f (x , y))))
  ≈⟨ ⟦search⟧ (searchable FA){_≡_} ≡.refl _≈_ (λ x y → x ⊙-cong y)
       (λ { {x} {.x} ≡.refl → FB-dist μX c _⊙_ distrib _⊙-cong_ (curry f x)}) ⟩
    Πᴬ (λ x → Σᴮ (λ fb → Πᴮ (λ y → f (x , y) (fb y))))
  ≈⟨ FA-dist (negative FB μX) c _⊙_ distrib _⊙-cong_
       (λ x fb → search (searchable FB) _⊙_ (λ y → f (x , y) (fb y))) ⟩
    Σᴬᴮ (λ fab → Πᴬ (λ x → Πᴮ (λ y → f (x , y) (fab x y))))
  ∎
  where
    open CMon c
    open Funable

    Σ' = search μX _∙_

    Πᴬ = search (searchable FA) _⊙_
    Πᴮ = search (searchable FB) _⊙_

    Σᴬᴮ = search (negative FA (negative FB μX)) _∙_
    Σᴮ  = search (negative FB μX) _∙_

    {-
⊎-Dist : ∀ {A B : ★₀} FA FB → DistFunable {A} FA → DistFunable {B} FB → DistFunable (FA ⊎-Fun FB)
⊎-Dist FA FB FA-dist FB-dist μX c _◎_ distrib _◎-cong_ f
 = Πᴬ (Σ' ∘ f ∘ inj₁) ◎ Πᴮ (Σ' ∘ f ∘ inj₂)
 ≈⟨ {!FA-dist μX c _◎_ distrib _◎-cong_ (f ∘ inj₁) ◎-cong FB-dist μX c _◎_ distrib _◎-cong_ (f ∘ inj₂)!} ⟩
 {-
   Σᴬ (λ fa → Πᴬ (λ i → f (inj₁ i) (fa i))) ◎ Σᴮ (λ fb → Πᴮ (λ i → f (inj₂ i) (fb i)))
 ≈⟨ sym (search-linʳ (negative FA μX) monoid _◎_ _ _ (proj₂ distrib)) ⟩
   Σᴬ (λ fa → Πᴬ (λ i → f (inj₁ i) (fa i)) ◎ Σᴮ (λ fb → Πᴮ (λ i → f (inj₂ i) (fb i))))
 ≈⟨ search-sg-ext (negative FA μX) semigroup (λ fa → sym (search-linˡ (negative FB μX) monoid _◎_ _ _ (proj₁ distrib))) ⟩
 -}
   (Σᴬ λ fa → Σᴮ λ fb → Πᴬ ((f ∘ inj₁) ˢ fa) ◎ Πᴮ ((f ∘ inj₂) ˢ fb))
 ∎
 where
    open CMon c
    open Funable

    Σ' = search μX _∙_

    Πᴬ = search (searchable FA) _◎_
    Πᴮ = search (searchable FB) _◎_

    Σᴬ = search (negative FA μX) _∙_
    Σᴮ = search (negative FB μX) _∙_
-}

-- -}
-- -}
-- -}

error: pathspec 'Search/Searchable/Fun.agda' did not match any file(s) known to git


Added Agda examples.

Added Agda examples.

module Introduction where

data ℕ : Set where
  zero : ℕ
  succ : ℕ → ℕ

data List (A : Set) : Set where
  [] : List A
  _∷_ : A → List A → List A

data Fin : ℕ → Set where
  zero : {n : ℕ} → Fin (succ n)
  succ : {n : ℕ} → Fin n → Fin (succ n)

error: pathspec 'notes/thesis/agda-introduction/Introduction.agda' did not match any file(s) known to git


Fix internalized as a computational description.

The idea is that the core could have computatial descriptions,
which do not mention things like which arguments are implicit,
and Desc can be internalized as a description like the current
primitive (non-computational) description that also mentions
which arguments are implicit. Then you can define the fixpoint
of that description as a computational description, parameterized
by (I : Set) (D : DescI) and indexed by (i : I) (E : Desc I).

It's cool that you can do this but I think it's one step too far
in the direction of making the core type theory simple in exchange
for more complicated derivable programs.

If anything, defining `Desc, making an interpretation function for
it, along with a toDesc function might be okay. But, again I think
defining `Fix is probably not worthwhile.

{-# OPTIONS --type-in-type #-}
open import Data.Unit
open import Data.Product hiding ( curry ; uncurry )
open import Data.List hiding ( concat )
open import Data.String
open import Relation.Binary.PropositionalEquality
open import Function
module Spire.Examples.CompLev where

----------------------------------------------------------------------

Label : Set
Label = String

Enum : Set
Enum = List Label

data Tag : Enum → Set where
  here : ∀{l E} → Tag (l ∷ E)
  there : ∀{l E} → Tag E → Tag (l ∷ E)

Branches : (E : Enum) (P : Tag E → Set) → Set
Branches [] P = ⊤
Branches (l ∷ E) P = P here × Branches E (λ t → P (there t))

case : {E : Enum} (P : Tag E → Set) (cs : Branches E P) (t : Tag E) → P t
case P (c , cs) here = c
case P (c , cs) (there t) = case (λ t → P (there t)) cs t

----------------------------------------------------------------------

data Tel : Set where
  End : Tel
  Arg : (A : Set) (B : A → Tel) → Tel

Elᵀ  : Tel → Set
Elᵀ End = ⊤
Elᵀ (Arg A B) = Σ A (λ a → Elᵀ (B a))

----------------------------------------------------------------------

data Desc (I : Set) : Set where
  End : Desc I
  Rec : (i : I) (D : Desc I) → Desc I
  RecFun : (A : Set) (B : A → I) (D : Desc I) → Desc I
  Arg : (A : Set) (B : A → Desc I) → Desc I

----------------------------------------------------------------------

ISet : Set → Set
ISet I = I → Set

Elᴰ : {I : Set} (D : Desc I) → ISet I → Set
Elᴰ End X = ⊤
Elᴰ (Rec j D) X = X j × Elᴰ D X
Elᴰ (RecFun A B D) X = ((a : A) → X (B a)) × Elᴰ D X
Elᴰ (Arg A B) X = Σ A (λ a → Elᴰ (B a) X)

Hyps : {I : Set} (D : Desc I) (X : ISet I) (P : (i : I) → X i → Set) (xs : Elᴰ D X) → Set
Hyps End X P tt = ⊤
Hyps (Rec i D) X P (x , xs) = P i x × Hyps D X P xs
Hyps (RecFun A B D) X P (f , xs) = ((a : A) → P (B a) (f a)) × Hyps D X P xs
Hyps (Arg A B) X P (a , xs) = Hyps (B a) X P xs

----------------------------------------------------------------------

data μ {I : Set} (R : I → Desc I) (i : I) : Set where
  init : Elᴰ (R i) (μ R) → μ R i

----------------------------------------------------------------------

ind : {I : Set} (R : I → Desc I)
  (M : (i : I) → μ R i → Set)
  (α : ∀ i (xs : Elᴰ (R i) (μ R)) (ihs : Hyps (R i) (μ R) M xs) → M i (init xs))
  (i : I)
  (x : μ R i)
  → M i x

prove : {I : Set} (D : Desc I) (R : I → Desc I)
  (M : (i : I) → μ R i → Set)
  (α : ∀ i (xs : Elᴰ (R i) (μ R)) (ihs : Hyps (R i) (μ R) M xs) → M i (init xs))
  (xs : Elᴰ D (μ R)) → Hyps D (μ R) M xs

ind R M α i (init xs) = α i xs (prove (R i) R M α xs)

prove End R M α tt = tt
prove (Rec j D) R M α (x , xs) = ind R M α j x , prove D R M α xs
prove (RecFun A B D) R M α (f , xs) = (λ a → ind R M α (B a) (f a)) , prove D R M α xs
prove (Arg A B) R M α (a , xs) = prove (B a) R M α xs

----------------------------------------------------------------------

DescE : Enum
DescE = "End" ∷ "Rec" ∷ "Arg" ∷ []

DescT : Set
DescT = Tag DescE

-- EndT : DescT
pattern EndT = here

-- RecT : DescT
pattern RecT = there here

-- ArgT : DescT
pattern ArgT = there (there here)

DescR : Set → ⊤ → Desc ⊤
DescR I tt = Arg (Tag DescE)
  (case (λ _ → Desc ⊤) (
      (Arg I λ i → End)
    , (Arg I λ i → Rec tt End)
    , (Arg Set λ A → RecFun A (λ a → tt) End)
    , tt
  ))

`Desc : (I : Set) → Set
`Desc I = μ (DescR I) tt

-- `End : {I : Set} (i : I) → `Desc I
pattern `End i = init (EndT , i , tt)

-- `Rec : {I : Set} (i : I) (D : `Desc I) → `Desc I
pattern `Rec i D = init (RecT , i , D , tt)

-- `Arg : {I : Set} (A : Set) (B : A → `Desc I) → `Desc I
pattern `Arg A B = init (ArgT , A , B , tt)

----------------------------------------------------------------------

FixI : (I : Set) → Set
FixI I = I × `Desc I

FixR' : (I : Set) (D : `Desc I) → I → `Desc I → Desc (FixI I)
FixR' I D i (`End j) = Arg (j ≡ i) λ q → End
FixR' I D i (`Rec j E) = Rec (j , D) (FixR' I D i E)
FixR' I D i (`Arg A B) = Arg A λ a → FixR' I D i (B a)
FixR' I D i (init (there (there (there ())) , xs))

FixR : (I : Set) (D : `Desc I) → FixI I → Desc (FixI I)
FixR I D E,i = FixR' I D (proj₁ E,i) (proj₂ E,i)

`Fix : (I : Set) (D : `Desc I) (i : I) → Set
`Fix I D i = μ (FixR I D) (i , D)

----------------------------------------------------------------------

error: pathspec 'formalization/agda/Spire/Examples/CompLev.agda' did not match any file(s) known to git


Add an initial start for an Agda model.

Add an initial start for an Agda model.

module Language.Greek where

data Maybe A : Set where
  none : Maybe A
  just : A → Maybe A

data Unicode : Set where
  Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π Ρ Σ Τ Υ Φ Χ Ψ Ω α β γ δ ε ζ η θ ι κ λ′ μ ν ξ ο π ρ σ ς τ υ φ χ ψ ω : Unicode
  grave acute diaeresis smooth rough circumflex iotaSubscript : Unicode

postulate
  Char : Set

{-# BUILTIN CHAR Char #-}
{-# COMPILED_TYPE Char Char #-}

charToUnicode : Char -> Maybe Unicode
charToUnicode 'Α' = just Α
charToUnicode 'Β' = just Β
charToUnicode 'Γ' = just Γ
charToUnicode 'Δ' = just Δ
charToUnicode 'Ε' = just Ε
charToUnicode 'Ζ' = just Ζ
charToUnicode 'Η' = just Η
charToUnicode 'Θ' = just Θ
charToUnicode 'Ι' = just Ι
charToUnicode 'Κ' = just Κ
charToUnicode 'Λ' = just Λ
charToUnicode 'Μ' = just Μ
charToUnicode 'Ν' = just Ν
charToUnicode 'Ξ' = just Ξ
charToUnicode 'Ο' = just Ο
charToUnicode 'Π' = just Π
charToUnicode 'Ρ' = just Ρ
charToUnicode 'Σ' = just Σ
charToUnicode 'Τ' = just Τ
charToUnicode 'Υ' = just Υ
charToUnicode 'Φ' = just Φ
charToUnicode 'Χ' = just Χ
charToUnicode 'Ψ' = just Ψ
charToUnicode 'Ω' = just Ω
charToUnicode 'α' = just α
charToUnicode 'β' = just β
charToUnicode 'γ' = just γ
charToUnicode 'δ' = just δ
charToUnicode 'ε' = just ε
charToUnicode 'ζ' = just ζ
charToUnicode 'η' = just η
charToUnicode 'θ' = just θ
charToUnicode 'ι' = just ι
charToUnicode 'κ' = just κ
charToUnicode 'λ' = just λ′
charToUnicode 'μ' = just μ
charToUnicode 'ν' = just ν
charToUnicode 'ξ' = just ξ
charToUnicode 'ο' = just ο
charToUnicode 'π' = just π
charToUnicode 'ρ' = just ρ
charToUnicode 'ς' = just ς
charToUnicode 'σ' = just σ
charToUnicode 'τ' = just τ
charToUnicode 'υ' = just υ
charToUnicode 'φ' = just φ
charToUnicode 'χ' = just χ
charToUnicode 'ψ' = just ψ
charToUnicode 'ω' = just ω
charToUnicode '\x0300' = just grave          -- COMBINING GRAVE ACCENT
charToUnicode '\x0301' = just acute          -- COMBINING ACUTE ACCENT
charToUnicode '\x0308' = just diaeresis      -- COMBINING DIAERESIS
charToUnicode '\x0313' = just smooth         -- COMBINING COMMA ABOVE
charToUnicode '\x0314' = just rough          -- COMBINING REVERSED COMMA ABOVE
charToUnicode '\x0342' = just circumflex     -- COMBINING GREEK PERISPOMENI
charToUnicode '\x0345' = just iotaSubscript  -- COMBINING GREEK YPOGEGRAMMENI
charToUnicode _ = none

data UnicodeCategory : Set where
  letter mark : UnicodeCategory

unicodeToCategory : Unicode → UnicodeCategory
unicodeToCategory Α = letter
unicodeToCategory Β = letter
unicodeToCategory Γ = letter
unicodeToCategory Δ = letter
unicodeToCategory Ε = letter
unicodeToCategory Ζ = letter
unicodeToCategory Η = letter
unicodeToCategory Θ = letter
unicodeToCategory Ι = letter
unicodeToCategory Κ = letter
unicodeToCategory Λ = letter
unicodeToCategory Μ = letter
unicodeToCategory Ν = letter
unicodeToCategory Ξ = letter
unicodeToCategory Ο = letter
unicodeToCategory Π = letter
unicodeToCategory Ρ = letter
unicodeToCategory Σ = letter
unicodeToCategory Τ = letter
unicodeToCategory Υ = letter
unicodeToCategory Φ = letter
unicodeToCategory Χ = letter
unicodeToCategory Ψ = letter
unicodeToCategory Ω = letter
unicodeToCategory α = letter
unicodeToCategory β = letter
unicodeToCategory γ = letter
unicodeToCategory δ = letter
unicodeToCategory ε = letter
unicodeToCategory ζ = letter
unicodeToCategory η = letter
unicodeToCategory θ = letter
unicodeToCategory ι = letter
unicodeToCategory κ = letter
unicodeToCategory λ′ = letter
unicodeToCategory μ = letter
unicodeToCategory ν = letter
unicodeToCategory ξ = letter
unicodeToCategory ο = letter
unicodeToCategory π = letter
unicodeToCategory ρ = letter
unicodeToCategory σ = letter
unicodeToCategory ς = letter
unicodeToCategory τ = letter
unicodeToCategory υ = letter
unicodeToCategory φ = letter
unicodeToCategory χ = letter
unicodeToCategory ψ = letter
unicodeToCategory ω = letter
unicodeToCategory grave = mark
unicodeToCategory acute = mark
unicodeToCategory diaeresis = mark
unicodeToCategory smooth = mark
unicodeToCategory rough = mark
unicodeToCategory circumflex = mark
unicodeToCategory iotaSubscript = mark

data List A : Set where
  [] : List A
  _∷_ : A → List A -> List A

infixr 6 _∷_

foldr : {A B : Set} → (A → B → B) → B → List A → B
foldr f y [] = y
foldr f y (x ∷ xs) = f x (foldr f y xs)

data _And_ : (A : Set) → (B : Set) → Set₁ where
  _and_ : {A B : Set} → A → B → A And B

data ConcreteLetter : Set where
  Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π Ρ Σ Τ Υ Φ Χ Ψ Ω α β γ δ ε ζ η θ ι κ λ′ μ ν ξ ο π ρ σ ς τ υ φ χ ψ ω : ConcreteLetter

data ConcreteMark : Set where
  grave acute diaeresis smooth rough circumflex iotaSubscript : ConcreteMark

error: pathspec 'agda/Language/Greek.agda' did not match any file(s) known to git


Added relation LTM.

Added relation LTM.

Ignore-this: 6ba30eed4255786ce93e42c2812d9d4a

darcs-hash:20110210035613-3bd4e-daec2d205ad19e2446b212c728c4f25507a20cd4.gz

------------------------------------------------------------------------------
-- Inequalities used by the McCarthy 91 function
------------------------------------------------------------------------------

module Draft.McCarthy91.InequalitiesATP where

open import LTC.Base

open import Draft.McCarthy91.Arithmetic

open import LTC.Data.Nat
open import LTC.Data.Nat.Inequalities
open import LTC.Data.Nat.Inequalities.PropertiesATP
open import LTC.Data.Nat.Numbers

------------------------------------------------------------------------------

LMC : D → D → Set
LMC m n = LT (hundred-one ∸ m) (hundred-one ∸ n)

LMC-prop : ∀ {n} → N n → LE n one-hundred → LMC (n + eleven) n
LMC-prop zN 0≤100 = prf
  where
    postulate
      prf : (hundred-one ∸ (zero + eleven)) < (hundred-one ∸ zero) ≡ true
    {-# ATP prove prf #-}
LMC-prop (sN {n} Nn) Sn≤100 = prf (LMC-prop Nn n≤100)
  where
    n≤100 : LE n one-hundred
    n≤100 = ≤-trans Nn (sN Nn) N100 (x<y→x≤y Nn (sN Nn) (x<Sx Nn)) Sn≤100

    postulate
      prf : (hundred-one ∸ (n + eleven)) < (hundred-one ∸ n) ≡ true →  -- IH.
            (hundred-one ∸ (succ n + eleven)) < (hundred-one ∸ succ n) ≡ true
    {-# ATP prove prf #-} -- Fail with all the ATPs.

error: pathspec 'Draft/McCarthy91/InequalitiesATP.agda' did not match any file(s) known to git


[ notes ] Testing a type synonymous for Set.

------------------------------------------------------------------------------
-- Testing a type synonymous for Set
------------------------------------------------------------------------------

{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K #-}

module FOT.FOTC.Data.Nat.SetType where

open import FOTC.Base
open import FOTC.Data.Nat

-- Type synonymous for Set.
Type = Set

data N' : D → Type where
  nzero' : N' zero
  nsucc' : ∀ {n} → N' n → N' (succ₁ n)
{-# ATP axiom nzero' nsucc' #-}

pred-N' : ∀ {n} → N' n → N' (pred₁ n)
pred-N' nzero' = prf
  where postulate prf : N' (pred₁ zero)
        {-# ATP prove prf #-}

pred-N' (nsucc' {n} N'n) = prf
  where postulate prf : N' (pred₁ (succ₁ n))
        {-# ATP prove prf #-}

error: pathspec 'notes/FOT/FOTC/Data/Nat/SetType.agda' did not match any file(s) known to git


use field as string alias

use field as string alias

remote: Support for password authentication was removed on August 13, 2021.
remote: Please see https://docs.github.com/en/get-started/getting-started-with-git/about-remote-repositories#cloning-with-https-urls for information on currently recommended modes of authentication.
fatal: Authentication failed for 'https://github.com/nfjinjing/chu2.git/'


Start adding Greek script model in Agda.

module Text.Greek.Script where

open import Data.Maybe
open import Data.Vec
open import Relation.Nullary using (¬_)
open import Relation.Binary.PropositionalEquality using (_≢_)

data Case : Set where
  lower upper : Case

data Letter : Set where
  α′ β′ γ′ δ′ ε′ ζ′ η′ θ′ ι′ κ′ λ′ μ′ ν′ ξ′ ο′ π′ ρ′ σ′ τ′ υ′ φ′ χ′ ψ′ ω′ : Letter

vowels : Vec _ _
vowels = α′ ∷ ε′ ∷ η′ ∷ ι′ ∷ ο′ ∷ υ′ ∷ ω′ ∷ []

always-short-letters : Vec _ _
always-short-letters = ε′ ∷ ο′ ∷ []

diaeresis-letters : Vec _ _
diaeresis-letters = ι′ ∷ υ′ ∷ []

iota-subscript-letters : Vec _ _
iota-subscript-letters = α′ ∷ η′ ∷ ω′ ∷ []

data _vowel : Letter → Set where
  is-vowel : ∀ {v} → v ∈ vowels → v vowel

data _always-short : Letter → Set where
  is-always-short : ∀ {v} → v vowel → v ∈ always-short-letters → v always-short

data _diaeresis : Letter → Set where
  add-diaeresis : ∀ {v} → v vowel → v ∈ diaeresis-letters → v diaeresis

data _⟦_⟧-final : Letter → Case → Set where
  make-final : σ′ ⟦ lower ⟧-final

data _⟦_⟧-smooth : Letter → Case → Set where
  add-smooth-lower-vowel : ∀ {v} → v vowel → v ⟦ lower ⟧-smooth
  add-smooth-ρ : ρ′ ⟦ lower ⟧-smooth
  add-smooth-upper-vowel-not-Υ : ∀ {v} → v vowel → v ≢ υ′ → v ⟦ upper ⟧-smooth

data _rough : Letter → Set where
  add-rough-vowel : ∀ {v} → v vowel → v rough
  add-rough-ρ : ρ′ rough

data _iota-subscript : Letter → Set where
  add-iota-subscript : ∀ {v} → v vowel → v ∈ iota-subscript-letters → v iota-subscript

data _⟦_⟧-breathing : Letter → Case → Set where
  add-smooth : ∀ {ℓ c} → ℓ ⟦ c ⟧-smooth → ℓ ⟦ c ⟧-breathing
  add-rough : ∀ {ℓ c} → ℓ rough → ℓ ⟦ c ⟧-breathing

data _long-vowel : Letter → Set where
  make-long-vowel : ∀ {v} → v vowel → ¬ v always-short → v long-vowel

data _accent : Letter → Set where
  add-acute : ∀ {ℓ} → ℓ vowel → ℓ accent
  add-grave : ∀ {ℓ} → ℓ vowel → ℓ accent
  add-circumflex : ∀ {ℓ} → ℓ long-vowel → ℓ accent

data Token : Letter → Case → Set where
  unmarked : ∀ {ℓ c} → Token ℓ c
  with-accent : ∀ {ℓ c} → ℓ accent → Token ℓ c
  with-breathing : ∀ {ℓ c} → ℓ ⟦ c ⟧-breathing → Token ℓ c
  with-accent-breathing : ∀ {ℓ c} → ℓ accent → ℓ ⟦ c ⟧-breathing → Token ℓ c
  with-accent-breathing-iota : ∀ {ℓ c} → ℓ accent → ℓ ⟦ c ⟧-breathing → ℓ iota-subscript → Token ℓ c
  with-diaeresis : ∀ {ℓ c} → ℓ diaeresis → Token ℓ c
  with-accent-diaeresis : ∀ {ℓ c} → ℓ accent → ℓ diaeresis → Token ℓ c
  with-accent-iota : ∀ {ℓ c} → ℓ accent → ℓ iota-subscript → Token ℓ c
  with-breathing-iota : ∀ {ℓ c} → ℓ ⟦ c ⟧-breathing → ℓ iota-subscript → Token ℓ c
  with-iota : ∀ {ℓ c} → ℓ iota-subscript → Token ℓ c
  final : ∀ {ℓ c} → ℓ ⟦ c ⟧-final → Token ℓ c

-- Constructions

-- Α α
α-vowel : α′ vowel
α-vowel = is-vowel here

¬α-always-short : ¬ α′ always-short
¬α-always-short (is-always-short α-vowel (there (there ())))

α-long-vowel : α′ long-vowel
α-long-vowel = make-long-vowel α-vowel ¬α-always-short

α-acute : α′ accent
α-acute = add-acute α-vowel

α-grave : α′ accent
α-grave = add-grave α-vowel

α-circumflex : α′ accent
α-circumflex = add-circumflex α-long-vowel

α-smooth : α′ ⟦ lower ⟧-breathing
α-smooth = add-smooth (add-smooth-lower-vowel α-vowel)

Α-smooth : α′ ⟦ upper ⟧-breathing
Α-smooth = add-smooth (add-smooth-upper-vowel-not-Υ α-vowel (λ ()))

α-rough : α′ ⟦ lower ⟧-breathing
α-rough = add-rough (add-rough-vowel α-vowel)

Α-rough : α′ ⟦ upper ⟧-breathing
Α-rough = add-rough (add-rough-vowel α-vowel)

α-iota-subscript : α′ iota-subscript
α-iota-subscript = add-iota-subscript α-vowel here

-- Ε ε
ε-vowel : ε′ vowel
ε-vowel = is-vowel (there here)

ε-always-short : ε′ always-short
ε-always-short = is-always-short ε-vowel here

ε-acute : ε′ accent
ε-acute = add-acute ε-vowel

ε-grave : ε′ accent
ε-grave = add-grave ε-vowel

ε-smooth : ε′ ⟦ lower ⟧-breathing
ε-smooth = add-smooth (add-smooth-lower-vowel ε-vowel)

Ε-smooth : ε′ ⟦ upper ⟧-breathing
Ε-smooth = add-smooth (add-smooth-upper-vowel-not-Υ ε-vowel (λ ()))

ε-rough : ε′ ⟦ lower ⟧-breathing
ε-rough = add-rough (add-rough-vowel ε-vowel)

Ε-rough : ε′ ⟦ upper ⟧-breathing
Ε-rough = add-rough (add-rough-vowel ε-vowel)

-- Η η
η-vowel : η′ vowel
η-vowel = is-vowel (there (there here))

¬η-always-short : ¬ η′ always-short
¬η-always-short (is-always-short η-vowel (there (there ())))

η-long-vowel : η′ long-vowel
η-long-vowel = make-long-vowel η-vowel ¬η-always-short

η-acute : η′ accent
η-acute = add-acute η-vowel

η-grave : η′ accent
η-grave = add-grave η-vowel

η-circumflex : η′ accent
η-circumflex = add-circumflex η-long-vowel

η-smooth : η′ ⟦ lower ⟧-breathing
η-smooth = add-smooth (add-smooth-lower-vowel η-vowel)

Η-smooth : η′ ⟦ upper ⟧-breathing
Η-smooth = add-smooth (add-smooth-upper-vowel-not-Υ η-vowel (λ ()))

η-rough : η′ ⟦ lower ⟧-breathing
η-rough = add-rough (add-rough-vowel η-vowel)

Η-rough : η′ ⟦ upper ⟧-breathing
Η-rough = add-rough (add-rough-vowel η-vowel)

η-iota-subscript : η′ iota-subscript
η-iota-subscript = add-iota-subscript η-vowel (there here)

-- Ι ι

instance
  ι-vowel : ι′ vowel
  ι-vowel = is-vowel (there (there (there here)))

  ¬ι-always-short : ¬ ι′ always-short
  ¬ι-always-short (is-always-short ι-vowel (there (there ())))

  ι-long-vowel : ι′ long-vowel
  ι-long-vowel = make-long-vowel ι-vowel ¬ι-always-short

  ι-not-υ : ι′ ≢ υ′
  ι-not-υ ()

ι-acute : ι′ accent
ι-acute = add-acute ι-vowel

ι-grave : ι′ accent
ι-grave = add-grave ι-vowel

ι-circumflex : ι′ accent
ι-circumflex = add-circumflex ι-long-vowel

ι-smooth : ι′ ⟦ lower ⟧-breathing
ι-smooth = add-smooth (add-smooth-lower-vowel ι-vowel)

Ι-smooth : ι′ ⟦ upper ⟧-breathing
Ι-smooth = add-smooth (add-smooth-upper-vowel-not-Υ ι-vowel (λ ()))

ι-rough : ι′ ⟦ lower ⟧-breathing
ι-rough = add-rough (add-rough-vowel ι-vowel)

-- Ο ο
f : ∀ {ℓ} → {{ p : ℓ vowel }} → ℓ accent
f {{ p }} = add-acute p

ι-acutes : Token ι′ lower
ι-acutes = with-accent f

-- Unicode
-- U+0390 - U+03CE
ΐ : Token ι′ lower -- U+0390 GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
ΐ = unmarked
Α : Token α′ upper -- U+0391 GREEK CAPITAL LETTER ALPHA
Α = unmarked
Β : Token β′ upper -- U+0392 GREEK CAPITAL LETTER BETA
Β = unmarked
Γ : Token γ′ upper -- U+0393 GREEK CAPITAL LETTER GAMMA
Γ = unmarked
Δ : Token δ′ upper -- U+0394 GREEK CAPITAL LETTER DELTA
Δ = unmarked
Ε : Token ε′ upper -- U+0395 GREEK CAPITAL LETTER EPSILON
Ε = unmarked
Ζ : Token ζ′ upper -- U+0396 GREEK CAPITAL LETTER ZETA
Ζ = unmarked
Η : Token η′ upper -- U+0397 GREEK CAPITAL LETTER ETA
Η = unmarked
Θ : Token θ′ upper -- U+0398 GREEK CAPITAL LETTER THETA
Θ = unmarked
Ι : Token ι′ upper -- U+0399 GREEK CAPITAL LETTER IOTA
Ι = unmarked
Κ : Token κ′ upper -- U+039A GREEK CAPITAL LETTER KAPPA
Κ = unmarked
Λ : Token λ′ upper -- U+039B GREEK CAPITAL LETTER LAMDA
Λ = unmarked
Μ : Token μ′ upper -- U+039C GREEK CAPITAL LETTER MU
Μ = unmarked
Ν : Token ν′ upper -- U+039D GREEK CAPITAL LETTER NU
Ν = unmarked
Ξ : Token ξ′ upper -- U+039E GREEK CAPITAL LETTER XI
Ξ = unmarked
Ο : Token ο′ upper -- U+039F GREEK CAPITAL LETTER OMICRON
Ο = unmarked
Π : Token π′ upper -- U+03A0 GREEK CAPITAL LETTER PI
Π = unmarked
Ρ : Token ρ′ upper -- U+03A1 GREEK CAPITAL LETTER RHO
Ρ = unmarked
                  -- U+03A2 <reserved>
Σ : Token σ′ upper -- U+03A3 GREEK CAPITAL LETTER SIGMA
Σ = unmarked
Τ : Token τ′ upper -- U+03A4 GREEK CAPITAL LETTER TAU
Τ = unmarked
Υ : Token υ′ upper -- U+03A5 GREEK CAPITAL LETTER UPSILON
Υ = unmarked
Φ : Token φ′ upper -- U+03A6 GREEK CAPITAL LETTER PHI
Φ = unmarked
Χ : Token χ′ upper -- U+03A7 GREEK CAPITAL LETTER CHI
Χ = unmarked
Ψ : Token ψ′ upper -- U+03A8 GREEK CAPITAL LETTER PSI
Ψ = unmarked
Ω : Token ω′ upper -- U+03A9 GREEK CAPITAL LETTER OMEGA
Ω = unmarked
Ϊ : Token ι′ upper -- U+03AA GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
Ϊ = unmarked
Ϋ : Token υ′ upper -- U+03AB GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
Ϋ = unmarked
ά : Token α′ lower -- U+03AC GREEK SMALL LETTER ALPHA WITH TONOS
ά = unmarked
έ : Token ε′ lower -- U+03AD GREEK SMALL LETTER EPSILON WITH TONOS
έ = unmarked
ή : Token η′ lower -- U+03AE GREEK SMALL LETTER ETA WITH TONOS
ή = unmarked
ί : Token ι′ lower -- U+03AF GREEK SMALL LETTER IOTA WITH TONOS
ί = unmarked
ΰ : Token υ′ lower -- U+03B0 GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
ΰ = unmarked
α : Token α′ lower -- U+03B1 GREEK SMALL LETTER ALPHA
α = unmarked
β : Token β′ lower -- U+03B2 GREEK SMALL LETTER BETA
β = unmarked
γ : Token γ′ lower -- U+03B3 GREEK SMALL LETTER GAMMA
γ = unmarked
δ : Token δ′ lower -- U+03B4 GREEK SMALL LETTER DELTA
δ = unmarked
ε : Token ε′ lower -- U+03B5 GREEK SMALL LETTER EPSILON
ε = unmarked
ζ : Token ζ′ lower -- U+03B6 GREEK SMALL LETTER ZETA
ζ = unmarked
η : Token η′ lower -- U+03B7 GREEK SMALL LETTER ETA
η = unmarked
θ : Token θ′ lower -- U+03B8 GREEK SMALL LETTER THETA
θ = unmarked
ι : Token ι′ lower -- U+03B9 GREEK SMALL LETTER IOTA
ι = unmarked
κ : Token κ′ lower -- U+03BA GREEK SMALL LETTER KAPPA
κ = unmarked
∙λ : Token λ′ lower -- U+03BB GREEK SMALL LETTER LAMDA
∙λ = unmarked
μ : Token μ′ lower -- U+03BC GREEK SMALL LETTER MU
μ = unmarked
ν : Token ν′ lower -- U+03BD GREEK SMALL LETTER NU
ν = unmarked
ξ : Token ξ′ lower -- U+03BE GREEK SMALL LETTER XI
ξ = unmarked
ο : Token ο′ lower -- U+03BF GREEK SMALL LETTER OMICRON
ο = unmarked
π : Token π′ lower -- U+03C0 GREEK SMALL LETTER PI
π = unmarked
ρ : Token ρ′ lower -- U+03C1 GREEK SMALL LETTER RHO
ρ = unmarked
ς : Token σ′ lower -- U+03C2 GREEK SMALL LETTER FINAL SIGMA
ς = unmarked
σ : Token σ′ lower -- U+03C3 GREEK SMALL LETTER SIGMA
σ = unmarked
τ : Token τ′ lower -- U+03C4 GREEK SMALL LETTER TAU
τ = unmarked
υ : Token υ′ lower -- U+03C5 GREEK SMALL LETTER UPSILON
υ = unmarked
φ : Token φ′ lower -- U+03C6 GREEK SMALL LETTER PHI
φ = unmarked
χ : Token χ′ lower -- U+03C7 GREEK SMALL LETTER CHI
χ = unmarked
ψ : Token ψ′ lower -- U+03C8 GREEK SMALL LETTER PSI
ψ = unmarked
ω : Token ω′ lower -- U+03C9 GREEK SMALL LETTER OMEGA
ω = unmarked
ϊ : Token ι′ lower -- U+03CA GREEK SMALL LETTER IOTA WITH DIALYTIKA
ϊ = unmarked
ϋ : Token υ′ lower -- U+03CB GREEK SMALL LETTER UPSILON WITH DIALYTIKA
ϋ = unmarked
ό : Token ο′ lower -- U+03CC GREEK SMALL LETTER OMICRON WITH TONOS
ό = unmarked
ύ : Token υ′ lower -- U+03CD GREEK SMALL LETTER UPSILON WITH TONOS
ύ = unmarked
ώ : Token ω′ lower -- U+03CE GREEK SMALL LETTER OMEGA WITH TONOS
ώ = unmarked

ἀ : Token α′ lower
ἀ = with-breathing α-smooth
ἁ : Token α′ lower
ἁ = with-breathing α-rough
ἂ : Token α′ lower
ἂ = with-accent-breathing α-grave α-smooth
ἃ : Token α′ lower
ἃ = with-accent-breathing α-grave α-rough
ἄ : Token α′ lower
ἄ = with-accent-breathing α-acute α-smooth
ἅ : Token α′ lower
ἅ = with-accent-breathing α-acute α-rough
ἆ : Token α′ lower
ἆ = with-accent-breathing α-circumflex α-smooth
ἇ : Token α′ lower
ἇ = with-accent-breathing α-circumflex α-rough
Ἀ : Token α′ upper
Ἀ = with-breathing Α-smooth
Ἁ : Token α′ upper
Ἁ = with-breathing Α-rough
Ἂ : Token α′ upper
Ἂ = with-accent-breathing α-grave Α-smooth
Ἃ : Token α′ upper
Ἃ = with-accent-breathing α-grave Α-rough
Ἄ : Token α′ upper
Ἄ = with-accent-breathing α-acute Α-smooth
Ἅ : Token α′ upper
Ἅ = with-accent-breathing α-acute Α-rough
Ἆ : Token α′ upper
Ἆ = with-accent-breathing α-circumflex Α-smooth
Ἇ : Token α′ upper
Ἇ = with-accent-breathing α-circumflex Α-rough

-- U+1F7x
ὰ : Token α′ lower
ὰ = with-accent α-grave
ά : Token α′ lower
ά = with-accent α-acute

-- U+1F8x
ᾀ : Token α′ lower
ᾀ = with-breathing-iota α-smooth α-iota-subscript
ᾁ : Token α′ lower
ᾁ = with-breathing-iota α-rough α-iota-subscript
ᾂ : Token α′ lower
ᾂ = with-accent-breathing-iota α-grave α-smooth α-iota-subscript
ᾃ : Token α′ lower
ᾃ = with-accent-breathing-iota α-grave α-rough α-iota-subscript
ᾄ : Token α′ lower
ᾄ = with-accent-breathing-iota α-acute α-smooth α-iota-subscript
ᾅ : Token α′ lower
ᾅ = with-accent-breathing-iota α-acute α-rough α-iota-subscript
ᾆ : Token α′ lower
ᾆ = with-accent-breathing-iota α-circumflex α-smooth α-iota-subscript
ᾇ : Token α′ lower
ᾇ = with-accent-breathing-iota α-circumflex α-rough α-iota-subscript
ᾈ : Token α′ upper
ᾈ = with-breathing-iota Α-smooth α-iota-subscript
ᾉ : Token α′ upper
ᾉ = with-breathing-iota Α-rough α-iota-subscript
ᾊ : Token α′ upper
ᾊ = with-accent-breathing-iota α-grave Α-smooth α-iota-subscript
ᾋ : Token α′ upper
ᾋ = with-accent-breathing-iota α-grave Α-rough α-iota-subscript
ᾌ : Token α′ upper
ᾌ = with-accent-breathing-iota α-acute Α-smooth α-iota-subscript
ᾍ : Token α′ upper
ᾍ = with-accent-breathing-iota α-acute Α-rough α-iota-subscript
ᾎ : Token α′ upper
ᾎ = with-accent-breathing-iota α-circumflex Α-smooth α-iota-subscript
ᾏ : Token α′ upper
ᾏ = with-accent-breathing-iota α-circumflex Α-rough α-iota-subscript

-- U+1FBx
-- ᾰ
-- ᾱ
ᾲ : Token α′ lower
ᾲ = with-accent-iota α-grave α-iota-subscript
ᾳ : Token α′ lower
ᾳ = with-iota α-iota-subscript
ᾴ : Token α′ lower
ᾴ = with-accent-iota α-acute α-iota-subscript
ᾶ : Token α′ lower
ᾶ = with-accent α-circumflex
ᾷ : Token α′ lower
ᾷ = with-accent-iota α-circumflex α-iota-subscript
-- Ᾰ
-- Ᾱ
Ὰ : Token α′ upper
Ὰ = with-accent α-grave
Ά : Token α′ upper
Ά = with-accent α-acute
ᾼ : Token α′ upper
ᾼ = with-iota α-iota-subscript

-- Mapping

data Accent : Set where
  acute-mark grave-mark circumflex-mark : Accent

letter-to-accent : ∀ {v} → v accent → Accent
letter-to-accent (add-acute x) = acute-mark
letter-to-accent (add-grave x) = grave-mark
letter-to-accent (add-circumflex x) = circumflex-mark

get-accent : ∀ {ℓ c} → Token ℓ c → Maybe Accent
get-accent (with-accent a) = just (letter-to-accent a)
get-accent (with-accent-breathing a _) = just (letter-to-accent a)
get-accent (with-accent-breathing-iota a _ _) = just (letter-to-accent a)
get-accent (with-accent-diaeresis a _) = just (letter-to-accent a)
get-accent (with-accent-iota a _) = just (letter-to-accent a)
get-accent _ = nothing

data Breathing : Set where
  smooth-mark rough-mark : Breathing

letter-to-breathing : ∀ {ℓ c} → ℓ ⟦ c ⟧-breathing → Breathing
letter-to-breathing (add-smooth x) = smooth-mark
letter-to-breathing (add-rough x) = rough-mark

get-breathing : ∀ {ℓ c} → Token ℓ c → Maybe Breathing
get-breathing (with-breathing x) = just (letter-to-breathing x)
get-breathing (with-accent-breathing _ x) = just (letter-to-breathing x)
get-breathing (with-accent-breathing-iota _ x _) = just (letter-to-breathing x)
get-breathing (with-breathing-iota x _) = just (letter-to-breathing x)
get-breathing _ = nothing

data IotaSubscript : Set where
  iota-subscript-mark : IotaSubscript

get-iota-subscript : ∀ {ℓ c} → Token ℓ c → Maybe IotaSubscript
get-iota-subscript (with-accent-breathing-iota _ _ _) = just iota-subscript-mark
get-iota-subscript (with-accent-iota _ _) = just iota-subscript-mark
get-iota-subscript (with-breathing-iota _ _) = just iota-subscript-mark
get-iota-subscript _ = nothing

data Diaeresis : Set where
  diaeresis-mark : Diaeresis

get-diaeresis : ∀ {ℓ c} → Token ℓ c → Maybe Diaeresis
get-diaeresis (with-diaeresis _) = just diaeresis-mark
get-diaeresis (with-accent-diaeresis _ _) = just diaeresis-mark
get-diaeresis _ = nothing

data FinalForm : Set where
  final-form : FinalForm

get-final-form : ∀ {ℓ c} → Token ℓ c → Maybe FinalForm
get-final-form (final _) = just final-form
get-final-form _ = nothing

error: pathspec 'agda/Text/Greek/Script.agda' did not match any file(s) known to git


fun-state.agda

fun-state.agda

fatal: unable to access 'https://github.com/crypto-agda/crypto-agda.git/': The requested URL returned error: 403


Added definition of equation using a recursive equation.

------------------------------------------------------------------------------
-- Definition of subtraction using a recursive equation
------------------------------------------------------------------------------

{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K #-}

module FOTC.SubtractionRecursiveEquation where

open import FOTC.Base

-- We add 3 to the fixities of the standard library.
infixl 9 _∸_

------------------------------------------------------------------------------

postulate
  _∸_  : D → D → D
  ∸-eq : ∀ m n → m ∸ n ≡
         if (iszero₁ n)
            then m
            else if (iszero₁ m)
                    then zero
                    else pred₁ m ∸ pred₁ n
{-# ATP axiom ∸-eq #-}

postulate
  ∸-x0 : ∀ n → n ∸ zero ≡ n
{-# ATP prove ∸-x0 #-}

postulate
  ∸-0S : ∀ n → zero ∸ succ₁ n ≡ zero
{-# ATP prove ∸-0S #-}

postulate
  ∸-SS : ∀ m n → succ₁ m ∸ succ₁ n ≡ m ∸ n
{-# ATP prove ∸-SS #-}

-- asr@pc:~/fotc/notes/thesis$ agda2atp -i ~/fotc/src/fot/  -i. FOTC/SubtractionRecursiveEquation.agda
-- Proving the conjecture in /tmp/FOTC/SubtractionRecursiveEquation/32-8760-0S.tptp ...
-- E 1.6 Tiger Hill proved the conjecture in /tmp/FOTC/SubtractionRecursiveEquation/32-8760-0S.tptp
-- Proving the conjecture in /tmp/FOTC/SubtractionRecursiveEquation/36-8760-SS.tptp ...
-- E 1.6 Tiger Hill proved the conjecture in /tmp/FOTC/SubtractionRecursiveEquation/36-8760-SS.tptp
-- Proving the conjecture in /tmp/FOTC/SubtractionRecursiveEquation/28-8760-x0.tptp ...
-- E 1.6 Tiger Hill proved the conjecture in /tmp/FOTC/SubtractionRecursiveEquation/28-8760-x0.tptp

error: pathspec 'notes/thesis/FOTC/SubtractionRecursiveEquation.agda' did not match any file(s) known to git