Fixed Makefile.

Fixed Makefile.

Ignore-this: 31338435bfed927703838c661d7e459b

darcs-hash:20100409024937-3bd4e-9da79543efc45e9a8672175836d2da523fc3716a.gz

------------------------------------------------------------------------------
-- Testing the removal of the quantification over proofs of formulas
------------------------------------------------------------------------------

module Test.Succeed.OnlyAxioms.RemoveQuantificationOverProofs where

postulate
  D    : Set
  succ : D → D

data N : D → Set where
  -- zN : N zero
  sN₁ : {n : D} →  N n → N (succ n)
  sN₂ : {n : D} → (Nn : N n) → N (succ n)

-- The data constructors sN₁ and sN₂ must have the same translation,
-- i.e. we must remove the quantification of the variable Nn on N n.

{-# ATP hint sN₂ #-}

-- The Agda internal type of sN₁
{-
El (Type (Lit (LitLevel  0)))
   (Pi {El (Type (Lit (LitLevel  0)))
           (Def Test.RemoveQuantificationOverProofs.D [])}
       (Abs "n" El (Type (Lit (LitLevel  0)))
                   (Fun (El (Type (Lit (LitLevel  0)))
                            (Def Test.RemoveQuantificationOverProofs.N [(Var 0 [])]))
                        (El (Type (Lit (LitLevel  0)))
                            (Def Test.RemoveQuantificationOverProofs.N
                                 [(Def Test.RemoveQuantificationOverProofs.succ [(Var 0 [])])]
                            )
                        )
                   )
       )
   )
-}

-- The Agda internal type of sN₂
{-
El (Type (Lit (LitLevel  0)))
   (Pi {El (Type (Lit (LitLevel  0)))
           (Def Test.RemoveQuantificationOverProofs.D [])}
       (Abs "n" El (Type (Lit (LitLevel  0)))
                   (Pi (El (Type (Lit (LitLevel  0)))
                           (Def Test.RemoveQuantificationOverProofs.N [(Var 0 [])]))
                       (Abs "Nn" El (Type (Lit (LitLevel  0)))
                                    (Def Test.RemoveQuantificationOverProofs.N
                                         [(Def Test.RemoveQuantificationOverProofs.succ [(Var 1 [])])]
                                    )
                       )
                   )
       )
   )
-}

error: pathspec 'Test/Succeed/OnlyAxioms/RemoveQuantificationOverProofs.agda' did not match any file(s) known to git


Added Agsy test.

Added Agsy test.

Ignore-this: 8c40e2930df08b1bf59edbc3c2e7d27e

darcs-hash:20101203050959-3bd4e-f60a8e16080c611b7bdb958ee245e85297629e0c.gz

------------------------------------------------------------------------------
-- Testing Agsy using the Agda standard library
------------------------------------------------------------------------------

module AgsyTest where

open import Data.Nat

open import Relation.Binary.PropositionalEquality
open ≡-Reasoning

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

0+m≡m+0 : ∀ m → 0 + m ≡ m + 0  -- via Agsy {-c}
0+m≡m+0 zero    = refl
0+m≡m+0 (suc n) = cong suc (0+m≡m+0 n)

+-comm : ∀ m n → m + n ≡ n + m
+-comm zero    zero    = refl -- via Agsy
+-comm zero    (suc n) = sym (cong suc (+-comm n zero))  -- via Agsy
+-comm (suc m) zero    = sym (cong suc (+-comm zero m))  -- via Agsy
+-comm (suc m) (suc n) = {!-t 20!} -- Agsy: No solution found at time out (20s)

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


ModInv: the final property is not finished

{-# OPTIONS --without-K #-}
open import Function
open import Data.Zero
open import Data.Nat.NP
open import Data.Nat.Properties
-- open import Data.Nat.DivMod
open import Data.Nat.DivMod.NP
open import Data.Nat.Primality.NP
open import Data.Nat.Coprimality
open import Data.Nat.Divisibility
open import Data.Nat.GCD
open import Data.Product.NP
open import Data.Fin.NP using (Fin; Fin▹ℕ; zero; suc; Fin▹ℕ<)
open import Relation.Nullary.Decidable hiding (⌊_⌋)
open import Relation.Binary.PropositionalEquality.NP

module Data.Nat.ModInv (q : ℕ) (q-prime : Prime q) where

prime≢0 : ∀ {x} → Prime x → False (x ≟ 0)
prime≢0 {zero}  ()
prime≢0 {suc _} _ = _

q≢0 : False (q ≟ 0)
q≢0 = prime≢0 q-prime

1<q : 1 < q
1<q = prime-≥2 q-prime

0<q : 0 < q
0<q = ℕ≤.trans (s≤s z≤n) 1<q

gcd≡1 : ∀ n d → 0 < n → n < q → GCD n q d → d ≡ 1
gcd≡1 n d 0<n n<q g
  = GCD.unique g (GCD.sym (coprime-gcd (prime⇒coprime q q-prime n 0<n n<q)))

⌊_⌋ : ℕ → ℕ
⌊ x ⌋ = x modℕ q

_/q : ℕ → ℕ
x /q = x div q

∣≢→< : ∀ d q (q≢0 : False (q ≟ 0)) → d ∣ q → d ≢ q → d < q
∣≢→< d zero () d∣q d≢q
∣≢→< d (suc q-1) q≢0 d∣q d≢q = ≤≢→< (∣⇒≤ d∣q) d≢q

open ≡-Reasoning

divMod-prop : ∀ x → x ≡ ⌊ x ⌋ + x /q * q
divMod-prop x = divModPropℕ x q

mod<q : ∀ x → ⌊ x ⌋ < q
mod<q x = modℕ<divisor x q {q≢0}

≥d*q : ∀ x → x ≥ (x /q) * q
≥d*q x = ≡+-≥ x ⌊ x ⌋ (x /q * q) (divMod-prop x)

q/q≡1 : q /q ≡ 1
q/q≡1 = d/d≡1 q {q≢0}

mod-prop : ∀ x → ⌊ x ⌋ ≡ x ∸ (x /q) * q
mod-prop x = modℕ-prop x {q}

q-mod-q : ⌊ q ⌋ ≡ 0
q-mod-q = mod-prop q ∙
  (q ∸ q /q * q ≡⟨ ap (λ z → q ∸ z * q) q/q≡1 ⟩
   q ∸ 1 * q    ≡⟨ ap (_∸_ q) (ℕ°.+-comm q 0) ⟩
   q ∸ q        ≡⟨ n∸n≡0 q ⟩
   0 ∎)

0-mod : ⌊ 0 ⌋ ≡ 0
0-mod = mod-prop 0 ∙ 0∸n≡0 (0 /q * q)

{-
q∸-mod : ∀ {x} → q ≥ x → ⌊ q ∸ x ⌋ ≡ q ∸ ⌊ x ⌋
q∸-mod p = modℕ-s∸ {!!} {!p!}
-}

-- q+-mod : ∀ {x} → ⌊ q + x ⌋ ≡ ⌊ x ⌋
-- q+-mod = {!!}

∸q-mod : ∀ {x} → x ≥ q → ⌊ x ∸ q ⌋ ≡ ⌊ x ⌋
∸q-mod = modℕ-∸s

∸-*q-mod : ∀ x y → x ≥ y * q → ⌊ x ∸ y * q ⌋ ≡ ⌊ x ⌋
∸-*q-mod x zero H = idp
∸-*q-mod x (suc y) H =
  ⌊ x ∸ (q + y * q) ⌋ ≡⟨ ap ⌊_⌋ (! ∸-assoc-+ x q _) ⟩
  ⌊ x ∸ q ∸ y * q ⌋ ≡⟨ ∸-*q-mod _ y (+≤→≤∸ q H) ⟩
  ⌊ x ∸ q ⌋ ≡⟨ ∸q-mod (+≤ q H) ⟩
  ⌊ x ⌋ ∎

mod-mod : ∀ x → ⌊ ⌊ x ⌋ ⌋ ≡ ⌊ x ⌋
mod-mod x = ⌊ ⌊ x ⌋ ⌋ ≡⟨ ap ⌊_⌋ (mod-prop x) ⟩
            ⌊ x ∸ x /q * q ⌋ ≡⟨ ∸-*q-mod x (x /q) (≥d*q x) ⟩
            ⌊ x ⌋ ∎

<-/q-0 : ∀ {x} → x < q → x /q ≡ 0
<-/q-0 = div<≡0

<-mod : ∀ x → x < q → ⌊ x ⌋ ≡ x
<-mod x x<q = mod-prop x ∙ ap (λ z → x ∸ z * q) (<-/q-0 x<q)

k+-mod : ∀ k {x} → ⌊ k + ⌊ x ⌋ ⌋ ≡ ⌊ k + x ⌋
k+-mod k {x} =
  ⌊ k + ⌊ x ⌋ ⌋ ≡⟨ ap (λ z → ⌊ k + z ⌋) (mod-prop _) ⟩
  ⌊ k + (x ∸ x /q * q) ⌋ ≡⟨ ap ⌊_⌋ (! +-∸-assoc k (≥d*q x)) ⟩
  ⌊ k + x ∸ x /q * q ⌋ ≡⟨ ∸-*q-mod (k + x) (x /q)
                           (let open ≤-Reasoning in
                            x /q * q ≤⟨ ≥d*q x ⟩
                            x ≤⟨ ≤-steps′ k ⟩
                            ℕ≤.reflexive (ℕ°.+-comm x k)) ⟩
  ⌊ k + x ⌋ ∎

+k-mod : ∀ {x} k → ⌊ ⌊ x ⌋ + k ⌋ ≡ ⌊ x + k ⌋
+k-mod {x} k =
  ⌊ ⌊ x ⌋ + k ⌋  ≡⟨ ap ⌊_⌋ (ℕ°.+-comm ⌊ x ⌋ k) ⟩
  ⌊ k + ⌊ x ⌋ ⌋  ≡⟨ k+-mod k ⟩
  ⌊ k + x ⌋      ≡⟨ ap ⌊_⌋ (ℕ°.+-comm k x) ⟩
  ⌊ x + k ⌋      ∎

+-mod : ∀ x y → ⌊ ⌊ x ⌋ + ⌊ y ⌋ ⌋ ≡ ⌊ x + y ⌋
+-mod x y = k+-mod ⌊ x ⌋ ∙ +k-mod y

suc-mod : ∀ x → ⌊ suc ⌊ x ⌋ ⌋ ≡ ⌊ suc x ⌋
suc-mod x = k+-mod 1

1-mod : ⌊ 1 ⌋ ≡ 1
1-mod = 1-modℕ {q} 1<q

k*-mod : ∀ k {x} → ⌊ k * ⌊ x ⌋ ⌋ ≡ ⌊ k * x ⌋
k*-mod zero = idp
k*-mod (suc k) {x} =
  ⌊ ⌊ x ⌋ +   k * ⌊ x ⌋   ⌋ ≡⟨ +k-mod (k * ⌊ x ⌋) ⟩
  ⌊   x   +   k * ⌊ x ⌋   ⌋ ≡⟨ ! k+-mod x ⟩
  ⌊   x   + ⌊ k * ⌊ x ⌋ ⌋ ⌋ ≡⟨ ap (λ z → ⌊ x + z ⌋) (k*-mod k {x}) ⟩
  ⌊   x   + ⌊ k *   x   ⌋ ⌋ ≡⟨ k+-mod x ⟩
  ⌊   x   +   k *   x     ⌋ ∎

*k-mod : ∀ {x} k → ⌊ ⌊ x ⌋ * k ⌋ ≡ ⌊ x * k ⌋
*k-mod {x} k =
  ⌊ ⌊ x ⌋ * k ⌋  ≡⟨ ap ⌊_⌋ (ℕ°.*-comm ⌊ x ⌋ k) ⟩
  ⌊ k * ⌊ x ⌋ ⌋  ≡⟨ k*-mod k ⟩
  ⌊ k * x ⌋      ≡⟨ ap ⌊_⌋ (ℕ°.*-comm k x) ⟩
  ⌊ x * k ⌋      ∎

*-mod : ∀ x y → ⌊ ⌊ x ⌋ * ⌊ y ⌋ ⌋ ≡ ⌊ x * y ⌋
*-mod x y = k*-mod ⌊ x ⌋ ∙ *k-mod y

nq-mod-q : ∀ n → ⌊ n * q ⌋ ≡ 0
nq-mod-q n =
  ⌊ n * q ⌋     ≡⟨ ! k*-mod n {q} ⟩
  ⌊ n * ⌊ q ⌋ ⌋ ≡⟨ ap (⌊_⌋ ∘ _*_ n) q-mod-q ⟩
  ⌊ n * 0     ⌋ ≡⟨ ap ⌊_⌋ (ℕ°.*-comm n 0) ⟩
  ⌊ 0 ⌋         ≡⟨ 0-mod ⟩
  0             ∎

+q-mod : ∀ x → ⌊ x + q ⌋ ≡ ⌊ x ⌋
+q-mod x =
  ⌊ x + q ⌋     ≡⟨ ! k+-mod x {q} ⟩
  ⌊ x + ⌊ q ⌋ ⌋ ≡⟨ ap (λ z → ⌊ x + z ⌋) q-mod-q ⟩
  ⌊ x + 0     ⌋ ≡⟨ ap ⌊_⌋ (ℕ°.+-comm x 0) ⟩
  ⌊ x ⌋         ∎

+nq-mod : ∀ x n → ⌊ x + n * q ⌋ ≡ ⌊ x ⌋
+nq-mod x n =
  ⌊ x + n * q ⌋     ≡⟨ ! k+-mod x {n * q} ⟩
  ⌊ x + ⌊ n * q ⌋ ⌋ ≡⟨ ap (λ z → ⌊ x + z ⌋) (nq-mod-q n) ⟩
  ⌊ x + 0         ⌋ ≡⟨ ap ⌊_⌋ (ℕ°.+-comm x 0) ⟩
  ⌊ x ⌋             ∎

{-
∸k-mod : ∀ k {x} → ⌊ ⌊ x ⌋ ∸ k ⌋ ≡ ⌊ x ∸ k ⌋
∸k-mod k {x} = {!!}

k∸-mod : ∀ k {x} → ⌊ k ∸ ⌊ x ⌋ ⌋ ≡ ⌊ k ∸ x ⌋
k∸-mod k {x} =
  ⌊ k ∸ ⌊ x ⌋ ⌋ ≡⟨ {!!} ⟩
  ⌊ k ∸ (x ∸ (x /q) * q) ⌋ ≡⟨ {!!} ⟩
  ⌊ k ∸ (x ∸ (x /q) * q) ⌋ ≡⟨ {!!} ⟩
  ⌊ k ∸ x     ⌋ ∎
-}

+-*q-mod : ∀ d y → ⌊ d + y * q ⌋ ≡ ⌊ d ⌋
+-*q-mod d y =
  ⌊ d + y * q ⌋
    ≡⟨ ! k+-mod d ⟩
  ⌊ d + ⌊ y * q ⌋ ⌋
    ≡⟨ ap (λ x → ⌊ d + x ⌋) (! k*-mod y) ⟩
  ⌊ d + ⌊ y * ⌊ q ⌋ ⌋ ⌋
    ≡⟨ ap (λ x → ⌊ d + ⌊ y * x ⌋ ⌋) q-mod-q ⟩
  ⌊ d + ⌊ y * 0 ⌋ ⌋
    ≡⟨ ap (λ x → ⌊ d + ⌊ x ⌋ ⌋) (ℕ°.*-comm y 0) ⟩
  ⌊ d + ⌊ 0 ⌋ ⌋
    ≡⟨ ap (λ x → ⌊ d + x ⌋) 0-mod ⟩
  ⌊ d + 0 ⌋
    ≡⟨ ap ⌊_⌋ (ℕ°.+-comm _ 0) ⟩
  ⌊ d ⌋ ∎

1/ : ℕ → ℕ
1/ n with Bézout.lemma q n
1/ n | Bézout.result d g (Bézout.+- x y eq) = STUCK q n x y where postulate STUCK : (q n x y : ℕ) → ℕ -- q ∸ y
1/ n | Bézout.result d g (Bézout.-+ x y eq) = y

gcd≢q : ∀ n q d → n ≢ 0 → n < q → GCD n q d → d ≢ q
gcd≢q zero      q  _ n≢0 n<q g _    = 𝟘-elim (n≢0 refl)
gcd≢q (suc n-1) q .q n≢0 n<q g refl = no-<-> n<q q<n
  where q<n = ∣≢→< q (suc n-1) _ (fst (GCD.commonDivisor g)) (<→≢ n<q ∘ !_)

blah' : ∀ x → suc x ∸ x ≡ 1
blah' zero = refl
blah' (suc x) = blah' x

blah : ∀ x → 0 < x → x ∸ (x ∸ 1) ≡ 1
blah zero ()
blah (suc x) p = blah' x

1<q+ : ∀ x → 1 < q + x
1<q+ x = ℕ≤.trans (prime-≥2 q-prime) (≤-steps′ {q} x)

{-
*q-∸-mod : ∀ x y → 0 < y → y < x * q → ⌊ x * q ∸ y ⌋ ≡ q ∸ ⌊ y ⌋
*q-∸-mod x y = modℕ-ns∸ {x} {y}
-}

{-
TODO remove n < q assumption

1/-prop : ∀ n → n ≢ 0 → n < q → ⌊ 1/ n * n ⌋ ≡ 1
1/-prop n n≢0 n<q with Bézout.lemma q n
1/-prop n n≢0 n<q | Bézout.result d g (Bézout.-+ x y eq) =
  ⌊ y * n     ⌋ ≡⟨ ap ⌊_⌋ (! eq) ⟩
  ⌊ d + x * q ⌋ ≡⟨ +-*q-mod d x ⟩
  ⌊ d         ⌋ ≡⟨ ap ⌊_⌋ (gcd≡1 n d (≢0⇒0< n n≢0) n<q (GCD.sym g)) ⟩
  ⌊ 1         ⌋ ≡⟨ 1-mod ⟩
  1 ∎
1/-prop n n≢0 n<q | Bézout.result d g (Bézout.+- zero y eq) = {!!}
1/-prop n n≢0 n<q | Bézout.result d g (Bézout.+- (suc x-1) y eq) =
  ⌊ (q ∸ y)   * n       ⌋ ≡⟨ ap ⌊_⌋ (*-distrib-∸ʳ n q y) ⟩
  ⌊ q * n ∸ y * n       ⌋ ≡⟨ ap ⌊_⌋ (ap (_∸_ (q * n)) (+-∸' d (y * n) (x * q) eq)) ⟩
  ⌊ q * n ∸ (x * q ∸ d) ⌋ ≡⟨ ap (λ z → ⌊ q * n ∸ (x * q ∸ z) ⌋) d≡1 ⟩
  ⌊ q * n ∸ (x * q ∸ 1) ⌋ ≡⟨ ap (λ z → ⌊ z ∸ (x * q ∸ 1) ⌋) (ℕ°.*-comm q n) ⟩
  ⌊ n * q ∸ (x * q ∸ 1) ⌋ ≡⟨ *q-∸-mod n _ {!!} xq∸1<nq ⟩
  q ∸ ⌊ x * q ∸ 1 ⌋ ≡⟨ ap (_∸_ q) (*q-∸-mod x _ (s≤s z≤n) (1<q+ (x-1 * q))) ⟩
  q ∸ (q ∸ ⌊ 1 ⌋) ≡⟨ ap (λ z → q ∸ (q ∸ z)) 1-mod ⟩
  q ∸ (q ∸ 1) ≡⟨ blah q 0<q ⟩
  {-
  ⌊ n * q ∸ (x * q ∸ 1) ⌋ ≡⟨ *q-∸-mod n _ {!+≤!} ⟩
  ⌊ x * q ∸ 1           ⌋ ≡⟨ *q-∸-mod x _ (+≤ 1 (ℕ≤.reflexive e)) ⟩
  ⌊ 1 ⌋                   ≡⟨ 1-mod ⟩
  -}
  1                       ∎
  where d≡1 = gcd≡1 n d (≢0⇒0< n n≢0) n<q (GCD.sym g)
        e   = ap₂ _+_ (! d≡1) idp ∙ eq
        x = suc x-1
        xq<nq+1 : x * q < n * q + 1
        xq<nq+1 = {!!}

        xq∸1<nq : x * q ∸ 1 < n * q
        xq∸1<nq = {!!}

1/-prop' : ∀ n → n ≢ 0 → n < q → ⌊ n * 1/ n ⌋ ≡ 1
1/-prop' n n≢0 n<q = ⌊ n * 1/ n ⌋ ≡⟨ ap ⌊_⌋ (ℕ°.*-comm n (1/ n)) ⟩
                     ⌊ 1/ n * n ⌋ ≡⟨ 1/-prop n n≢0 n<q ⟩
                     1            ∎
-}

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

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


A(nother) model of Containers

A(nother) model of Containers

{-# OPTIONS --type-in-type --no-termination-check
  #-}

module Containers where

  record Sigma (A : Set) (B : A -> Set) : Set where
    field fst : A
          snd : B fst

  open Sigma

  _*_ : (A B : Set) -> Set
  A * B = Sigma A \_ -> B

  data Zero : Set where

  record One : Set where

  data PROP : Set where
    Absu : PROP
    Triv : PROP
    _/\_ : PROP -> PROP -> PROP
    All : (S : Set) -> (S -> PROP) -> PROP

  Prf : PROP -> Set
  Prf Absu = Zero
  Prf Triv = One
  Prf (P /\ Q) = Prf P * Prf Q
  Prf (All S P) = (x : S) -> Prf (P x)

  _,_ : forall {A B} -> (a : A) -> B a -> Sigma A B
  a , b = record { fst = a ; snd = b }

  split : ∀ {A B} {C : Sigma A B -> Set} ->
    (f : (a : A) -> (b : B a) -> C (a , b)) -> (ab : Sigma A B) -> C ab
  split f ab = f (fst ab) (snd ab)

  data _+_ (A B : Set) : Set where
    l : A -> A + B
    r : B -> A + B

  cases : ∀ {A B} {C : A + B -> Set} ->
            ((a : A) -> C (l a)) -> ((b : B) -> C (r b)) ->
            (ab : A + B) -> C ab
  cases f g (l a) = f a
  cases f g (r b) = g b

  rearrange : ∀ {A B X} (C : A → Set) (D : B → Set) (f : Sigma A C → X) →
              Sigma (A + B) (cases C D) → X + Sigma B D
  rearrange {A} {B} {X} C D f = split {A + B} (cases (\a c → l (f (a , c))) (\b d → r (b , d)))

  data CON (I : Set) : Set where
    ?? : I -> CON I
    PrfC : PROP -> CON I
    _*C_ : CON I -> CON I -> CON I
    PiC : (S : Set) -> (S -> CON I) -> CON I
    SiC : (S : Set) -> (S -> CON I) -> CON I
    MuC : (O : Set) -> (O -> CON (I + O)) -> O -> CON I

  mutual

    data Mu {I : Set} (O : Set) (D : O -> CON (I + O))
            (X : I -> Set) : O -> Set where
      inm : {o : O} -> [| D o |] (cases X (Mu O D X)) ->  Mu O D X o

    [|_|]_ : {I : Set} -> (CON I) -> (I -> Set) -> Set
    [| ?? i |] X = X i
    [| PrfC p |] X = Prf p
    [| C *C D |] X = [| C |] X * [| D |] X
    [| PiC S C |] X = (s : S) -> [| C s |] X
    [| SiC S C |] X = Sigma S \s -> [| C s |] X
    [| MuC O C o |] X = Mu O C X o

  outm : {I O : Set} {D : O -> CON (I + O)} {X : I -> Set} {o : O} ->
    Mu O D X o -> [| D o |]  (cases X (Mu O D X))
  outm (inm x) = x

  Everywhere : {I : Set} -> (D : CON I) -> (J : I -> Set) -> (X : Set) ->
               (Sigma I J -> X) ->  [| D |] J -> CON X
  Everywhere (?? i) J X c t = ?? (c (i , t))
  Everywhere (PrfC p) J X c t = PrfC Triv
  Everywhere (C *C D) J X c t =
    Everywhere C J X c (fst t) *C Everywhere D J X c (snd t)
  Everywhere (PiC S C) J X c t = PiC S (\s -> Everywhere (C s) J X c (t s))
  Everywhere (SiC S C) J X c t = Everywhere (C (fst t)) J X c (snd t)
  Everywhere (MuC O C o) J X c t = MuC (Sigma O (Mu O C J)) (\ot' ->
        Everywhere (C (fst ot'))
                   (cases J (Mu O C J))
                   (X + (Sigma O (Mu O C J)))
                   (split (cases(\i j -> l (c (i , j)))
                                (\o'' t'' -> r (o'' , t''))))
                   (outm (snd ot')))
     (o , t)

  everywhere : {I : Set} -> (D : CON I) -> (J : I -> Set) -> (X : Set) ->
               (c : Sigma I J -> X) -> (Y : X -> Set) ->
               (f : (ij : Sigma I J) -> Y (c ij)) -> (t : [| D |] J) ->
               [| Everywhere D J X c t |] Y
  everywhere (?? i) J X c Y f t = f (i , t)
  everywhere (PrfC p) J X c Y f t = _
  everywhere (C *C D) J X c Y f t =
    everywhere C J X c Y f (fst t) , everywhere D J X c Y f (snd t)
  everywhere (PiC S C) J X c Y f t = \s -> everywhere (C s) J X c Y f (t s)
  everywhere (SiC S C) J X c Y f t = everywhere (C (fst t)) J X c Y f (snd t)
  everywhere (MuC O C o) J X c Y f (inm t) =
    inm (everywhere (C o) (cases J (Mu O C J)) (X + Sigma O (Mu O C J)) (
        (split (cases (\i j -> l (c (i , j))) (\o t -> r (o , t)))))
        (cases Y (split \o'' t'' -> [| Everywhere (MuC O C o'') J X c t'' |] Y))
        (split (cases (\i j -> f (i , j))
                      (\o'' t'' -> everywhere (MuC O C o'') J X c Y f t'')))
        t)

  induction : {I O : Set} (D : O -> CON (I + O)) (J : I -> Set) (X : Set)
              (c : Sigma I J -> X) (Y : X -> Set) (f : (ij : Sigma I J) -> Y (c ij))
              (P : Sigma O (Mu O D J) -> Set) ->
              ({o : O} (v : [| D o |] cases J (Mu O D J)) ->
               [| Everywhere (D o) _ (X + Sigma O (Mu O D J))
                             (split (cases (\i j -> l (c (i , j)))
                             (\o v -> r (o , v)))) v |] cases Y P ->
               P (o , inm v)) ->
              (o : O) (v : Mu O D J o) -> P (o , v)
  induction {I} {O} D J X c Y f P p o (inm v) =
    p v (everywhere {I + O} (D o)
                    (λ x -> cases {I} {O} {\_ -> Set} J
                    (Mu O D J) x) ((X + Sigma O (Mu O D J)))
                    (rearrange J (Mu O D J) c) (cases Y P)
                    (split {I + O} (cases (\i j -> f (i , j))
                    (\o v -> induction D J X c Y f P p o v))) v)

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


bit-guessing-game.agda

bit-guessing-game.agda

open import program-distance
open import flipbased-implem
open import Data.Bits
open import Data.Product
open import Relation.Nullary

module bit-guessing-game (prgDist : PrgDist) where
  open PrgDist prgDist

  GuessAdv : Coins → Set
  GuessAdv c = ↺ c Bit

  runGuess⅁ : ∀ {ca} (A : GuessAdv ca) (b : Bit) → ↺ ca Bit
  runGuess⅁ A _ = A

  -- An oracle: an adversary who can break the guessing game.
  Oracle : Coins → Set
  Oracle ca = ∃ (λ (A : GuessAdv ca) → breaks (runGuess⅁ A))

  -- Any adversary cannot do better than a random guess.
  GuessSec : Coins → Set
  GuessSec ca = ∀ (A : GuessAdv ca) → ¬(breaks (runGuess⅁ A))

error: pathspec 'bit-guessing-game.agda' did not match any file(s) known to git


start proving things for String Fiat Shamir

open import Type
open import Data.Maybe
open import Data.Two
open import Data.Product.NP
open import Relation.Nullary.Decidable
open import Relation.Nullary
open import Relation.Binary.PropositionalEquality

open import Control.Strategy

module ZK.Strong-Fiat-Shamir
  {W S : ★}{L : W → S → ★}{Prf : S → ★}
  {RP RV RS : ★}{SimState : ★}{Q : ★}{Resp :    ★}
  (L? : ∀ w Y → Dec (L w Y))(L-to-Prf : ∀ {w Y} → L w Y → Prf Y)
  where

Random-Oracle : ★
Random-Oracle = Q → Resp

State : (S A : ★) → ★
State S A = S → A × S

record Proof-System : ★ where
  field
    Prove : RP →  (w : W)(Y : S) → Prf Y
    Verify : RV → (Y : S)(π : Prf Y) → 𝟚

record Simulator (PF : Proof-System) : ★ where
  open Proof-System PF
  field
    init : RS → SimState
    H : Q → State SimState Resp
    Simulate : (Y : S) → State SimState (Prf Y)
    verify-sim-spec : (rv : RV)(Y : S)(s : SimState) → let π = proj₁ (Simulate Y s)
                     in Verify rv Y π ≡ 1₂

module Is-Zero-Knowledge
  (PF : Proof-System)
  (sim : Simulator PF)
  where

  open Simulator sim

  data Adversary-Query : ★ where
    query-H : (q : Q) → Adversary-Query
    query-create-proof : (w : W)(Y : S) → Adversary-Query

  Challenger-Resp : Adversary-Query → ★
  Challenger-Resp (query-H s) = Resp
  Challenger-Resp (query-create-proof w Y) = Maybe (Prf Y)

  Adversary : ★
  Adversary = Strategy Adversary-Query Challenger-Resp 𝟚

  simulated-Challenger : ∀ q → State SimState (Challenger-Resp q)
  simulated-Challenger (query-H q) s = H q s
  simulated-Challenger (query-create-proof w Y) s with L? w Y
  simulated-Challenger (query-create-proof w Y) s | yes p = first just (Simulate Y s)
  simulated-Challenger (query-create-proof w Y) s | no ¬p = nothing , s

  open StatefulRun
  simulated : SimState → Adversary → 𝟚
  simulated s adv = evalS simulated-Challenger adv s

  module _ (ro : Random-Oracle) where

    real-Challenger : ∀ q → Challenger-Resp q
    real-Challenger (query-H q) = ro q
    real-Challenger (query-create-proof w Y) with L? w Y
    ... | yes p = just (L-to-Prf p)
    ... | no  _ = nothing

    real : Adversary → 𝟚
    real adv = run real-Challenger adv

    Experiment : 𝟚 → RS → Adversary → 𝟚
    Experiment 0₂ rs = real
    Experiment 1₂ rs = simulated (init rs)

{-
-- there exists a simulator, such that for all adversaries they are clueless if
-- they are in the real or simulated Experiment
Zero-Knowledge : Proof-System → ★
Zero-Knowledge PF = Σ (Simulator PF) (λ sim → {!!})
-}

module Sigma-Protocol
  (Commitment Challenge : ★)
  (Σ-Prf : S → ★)
  {RΣP : ★}
  (PF : Proof-System)
  where
  open Proof-System PF

  record Σ-Prover : ★ where
    field
      A : RΣP → (Y : S) → Commitment
      f : RΣP → (Y : S) → (c : Challenge) → Σ-Prf Y

  Σ-Verifier : ★
  Σ-Verifier = (Y : S)(A : Commitment)(c : Challenge)
             → Σ-Prf Y → 𝟚

  Correct : Σ-Verifier → Σ-Prover → ★
  Correct v p = ∀ {Y w} → L w Y → (r : RΣP)(c : _) →
    let open Σ-Prover p
    in v Y (A r Y) c (f r Y c) ≡ 1₂

  module Special-Honest-Verifier-Zero-Knowledge
    where

    record shvzk : ★ where

module Simulation-Sound-Extractability
  (PF : Proof-System)
  (sim : Simulator PF)
  where

error: pathspec 'ZK/Strong-Fiat-Shamir.agda' did not match any file(s) known to git


schnorr.agda

schnorr.agda

open import Data.Bool using (Bool; true; false) -- ; if_then_else_; _∨_)
{-
open import Function
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 (_×_; _,_; proj₁; proj₂)

module schnorr
-- (q : ℕ) -- Prime q

(ℤq : Set)

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

(_⊟_  : ℤq → ℤq → ℤq)
(_⊠_  : ℤq → ℤq → ℤq)

(ℤq★ : Set) -- ℤq excluding 0
(weaken : ℤq★ → ℤq)

(_==_ : ℤq → ℤq → Bool)
-- (_==ᴳ_ : G → G → Bool)

(M : Set)
(ℋ⟨_∥_⟩ : G → M → ℤq)  -- I flipped the order of arguments to fit the
                        -- "random prefix" assumption
where

Sig : Set
Sig = ℤq × ℤq

-- Do not call directly this function, use Sign
Sign★ : (m : M) (x : ℤq) (k : ℤq) → Sig
Sign★ m x k = (s , e)

  where r = g ^ k
        e = ℋ⟨ r ∥ m ⟩
        s = k ⊟ (x ⊠ e)

Sign : (m : M) (x : ℤq★) (k : ℤq★) → Sig
Sign m x′ k′ = Sign★ m (weaken x′) (weaken k′)

-- 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ˣ (s , e) = eᵥ == e

  module Ver where rᵥ = (g ^ s) ∙ (gˣ ^ e)
                   eᵥ = ℋ⟨ rᵥ ∥ m ⟩

open import Relation.Binary.PropositionalEquality

_^′_ : G → ℤq★ → G
g ^′ x = g ^ weaken x

module Proof
  (^-⊟ : ∀ α x y → (α ^ (x ⊟ y)) ∙ (α ^ y) ≡ α ^ x)
  (^-⊠ : ∀ α x y → (α ^ x) ^ y ≡ α ^(x ⊠ y))
  (==-refl : ∀ {x} → x == x ≡ true)
  (m : M) (x k : ℤq) where

  gˣ  = g ^ x
  sig = Sign★ m x k
  s   = proj₁ sig
  e   = proj₂ sig

  r   = g ^ k

  pf1 : e ≡ ℋ⟨ r ∥ m ⟩
  pf1 = refl
  pf2 : s ≡ k ⊟ (x ⊠ e)
  pf2 = refl

  open Ver m gˣ s e

  rᵥ≡r : rᵥ ≡ r
  rᵥ≡r rewrite ^-⊠ g x e
             | ^-⊟ g k (x ⊠ e) = refl

  eᵥ≡e : eᵥ ≡ e
  eᵥ≡e rewrite rᵥ≡r = refl

  pf : Ver m gˣ (Sign★ m x k) ≡ true
  pf rewrite eᵥ≡e = ==-refl

module HashFunctionRequirements
    (Rd : Set)
    (Message : Set)
    (Hash : Set)
    (_==ᴴ_ : Hash → Hash → Bool)
    (ℋ⟨_∥_⟩ : Rd → Message → Hash)
    where

    RPPAdv : Set → Set
    RPPAdv Rₐ = (Rₐ → Hash)
              × (Rₐ → Rd → Message)

    RPP-advantage : ∀ {Rₐ} → RPPAdv Rₐ → (Rₐ × Rd) → Bool
    RPP-advantage (A₀ , A₁) (rₐ , rd) = ℋ⟨ rd ∥ m ⟩ ==ᴴ h
      where h = A₀ rₐ
            m = A₁ rₐ rd

    RPSPAdv : Set → Set
    RPSPAdv Rₐ = (Rₐ → Message)
               × (Rₐ → Rd → Message)

    RPSP-advantage : ∀ {Rₐ} → RPSPAdv Rₐ → (Rₐ × Rd) → Bool
    RPSP-advantage (A₀ , A₁) (rₐ , rd) = ℋ⟨ rd ∥ m₀ ⟩ ==ᴴ ℋ⟨ rd ∥ m₁ ⟩
      where m₀ = A₀ rₐ
            m₁ = A₁ rₐ rd

Rd = G
Message = M
Hash = ℤq
open HashFunctionRequirements Rd Message Hash _==_ ℋ⟨_∥_⟩

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


IMDesc: Agda model.

IMDesc: Agda model.

{-# OPTIONS --type-in-type
            --no-termination-check
            --no-positivity-check #-}

module IMDesc where

--********************************************
-- Prelude
--********************************************

-- Some preliminary stuffs, to avoid relying on the stdlib

--****************
-- Sigma and friends
--****************

data Sigma (A : Set)(B : A -> Set) : Set where
  _,_ : (x : A)(y : B x) -> Sigma A B

_*_ : (A B : Set) -> Set
A * B = Sigma A \_ -> B

fst : {A : Set}{B : A -> Set} -> Sigma A B -> A
fst (a , _) = a

snd : {A : Set}{B : A -> Set} (p : Sigma A B) -> B (fst p)
snd (a , b) = b

data Zero : Set where
record One : Set where

--****************
-- Sum and friends
--****************

data _+_ (A B : Set) : Set where
  l : A -> A + B
  r : B -> A + B

--****************
-- Prop
--****************

data EProp : Set where
  Trivial : EProp

Prf : EProp -> Set
Prf _ = {! !}

--****************
-- Enum
--****************

data EnumU : Set where

data EnumT (E : EnumU) : Set where

Branches : (E : EnumU) -> (P : EnumT E -> Set) -> Set
Branches  _ _ = {! !}

switch : (E : EnumU) -> (e : EnumT E) -> (P : EnumT E -> Set) -> Branches E P -> P e
switch = {! !}

--********************************************
-- IMDesc
--********************************************

--****************
-- Code
--****************

data IDesc (I : Set) : Set where
  iat      : (i : I) -> IDesc I
  ipi      : (S : Set)(T : S -> IDesc I) -> IDesc I
  isigma   : (S : Set)(T : S -> IDesc I) -> IDesc I
  iprf     : (Q : EProp) -> IDesc I
  iprod    : (D : IDesc I)(D : IDesc I) -> IDesc I
  ifsigma  : (E : EnumU)(f : Branches E (\ _ -> IDesc I)) -> IDesc I

--****************
-- Interpretation
--****************

desc : (I : Set)(D : IDesc I)(P : I -> Set) -> Set
desc I (iat i)        P = P i
desc I (ipi S T)      P = (s : S) -> desc I (T s) P
desc I (isigma S T)   P = Sigma S (\ s -> desc I (T s) P)
desc I (iprf q)       P = Prf q
desc I (iprod D D')   P = Sigma (desc I D P) (\ _ -> desc I D' P)
desc I (ifsigma E B)  P = Sigma (EnumT E) (\ e -> desc I (switch E e (\ _ -> IDesc I) B) P)

--****************
-- Curried and uncurried interpretations
--****************

curryD : (I : Set)(D : IDesc I)(P : I -> Set)(R : desc I D P -> Set) -> Set
curryD I (iat i) P R = (x : P i) -> R x
curryD I (ipi S T) P R = (f : (s : S) -> desc I (T s) P) -> R f
curryD I (isigma S T) P R = (s : S) -> curryD I (T s) P (\ d -> R (s , d))
curryD I (iprf Q) P R = (x : Prf Q) -> R x
curryD I (iprod D D') P R = curryD I D P (\ d ->
                             curryD I D' P (\ d' -> R (d , d')))
curryD I (ifsigma E B) P R = Branches E (\e -> curryD I (switch E e (\_ -> IDesc I) B) P (\d -> R (e , d)))

uncurryD : (I : Set)(D : IDesc I)(P : I -> Set)(R : desc I D P -> Set) ->
           curryD I D P R -> (xs : desc I D P) -> R xs
uncurryD I (iat i) P R f xs = f xs
uncurryD I (ipi S T) P R F f = F f
uncurryD I (isigma S T) P R f (s , d) =  uncurryD I (T s) P (\d -> R (s , d)) (f s) d
uncurryD I (iprf Q) P R f q = f q
uncurryD I (iprod D D') P R f (d , d') =  uncurryD I D' P ((\ d' → R (d , d')))
                                           (uncurryD I D P ((\ x → curryD I D' P (\ d0 → R (x , d0)))) f d) d'
uncurryD I (ifsigma E B) P R br (e , d) =  uncurryD I (switch E e (\ _ -> IDesc I) B) P
                                                      (\ d -> R ( e , d ))
                                                      (switch E e ( \ e -> R ( e , d)) br) d

--****************
-- Everywhere
--****************

box : (I : Set)(D : IDesc I)(P : I -> Set) -> desc I D P -> IDesc (Sigma I P)
box I (iat i)        P x         = iat (i , x)
box I (ipi S T)      P f         = ipi S (\ s -> box I (T s) P (f s))
box I (isigma S T)   P (s , d)   = box I (T s) P d
box I (iprf Q)       P q         = iprf Trivial
box I (iprod D D')   P (d , d')  = iprod (box I D P d) (box I D' P d')
box I (ifsigma E B)  P (e , d)   = box I (switch E e (\ _ -> IDesc I) B) P d

mapbox : (I : Set)(D : IDesc I)(Z : I -> Set)(P : Sigma I Z -> Set) ->
         ((x : Sigma I Z) -> P x) ->
         ( d : desc I D Z) -> desc (Sigma I Z) (box I D Z d) P
mapbox = {!!}

--****************
-- Fix-point
--****************

data IMu (I : Set)(D : I -> IDesc I)(i : I) : Set where
  Con : desc I (D i) (\ j -> IMu I D j) -> IMu I D i

--****************
-- Induction, curried
--****************

inductionC : (I : Set)(D : I -> IDesc I)(i : I)(v : IMu I D i)
             (P : Sigma I (IMu I D) -> Set)
             (m : (i : I) ->
                  curryD I (D i) (IMu I D) (\xs ->
                    curryD (Sigma I (IMu I D))
                           (box I (D i) (IMu I D) xs)
                           P
                           (\ _ -> P (i , Con xs)))) ->
             P ( i , v )
inductionC I D i (Con x) P m =
  let t = uncurryD  I
                    (D i)
                    (IMu I D)
                    (\xs ->
                    curryD (Sigma I (IMu I D))
                           (box I (D i) (IMu I D) xs)
                           P
                           (\ _ -> P (i , Con xs)))
                    (m i)
                    x
  in
  uncurryD (Sigma I (IMu I D))
           ( box I (D i) (IMu I D) x)
           P
           (\ _ -> P ( i , Con x))
           t
           (mapbox I ( D i) ( IMu I D) P ind x)
           where ind : (x' : Sigma I (IMu I D)) -> P x'
                 ind ( i , x) = inductionC I D i x P m

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


clean

clean

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/'


clean

clean


added Mutual

added Mutual

open import Data.Nat using (ℕ; zero; suc)
open import Data.Bool using (Bool; true; false)

data even : ℕ → Set
data odd : ℕ → Set

data even where
  zero : even zero
  suc : ∀ {n : ℕ} → odd n → even (suc n)
data odd where
  suc : ∀ {n : ℕ} → even n → odd (suc n)

mutual
  data even′ : ℕ → Set where
    zero : even′ zero
    suc : ∀ {n : ℕ} → odd′ n → even′ (suc n)
  data odd′ : ℕ → Set where
    suc : ∀ {n : ℕ} → even′ n → odd′ (suc n)

{-
/Users/wadler/sf/src/extra/Mutual.agda:3,6-10
Missing definition for even
-}

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


learn you an agda -- peano numbers

learn you an agda -- peano numbers

module peano where

data ℕ : Set where
  zero : ℕ
  suc  : ℕ → ℕ

_+_ : ℕ → ℕ → ℕ

zero + zero  = zero
zero + n     = n
(suc n) + n′ = suc (n + n′)

data _even : ℕ → Set where
  ZERO : zero even
  STEP : ∀ x → x even → (suc (suc x)) even

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


Agda by example: Simply Typed Lambda Calculus

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/jstolarek/sandbox.git/'


Algebra.DoubleAndAdd: Multplication in any monoid using "double and add"

open import Relation.Binary.PropositionalEquality.NP
open import Data.Two.Base
open import Data.List
open import Function
open import Algebra.FunctionProperties.Eq
open Implicits
open import Algebra.Monoid.Commutative
open import Algebra.Ring

module Algebra.DoubleAndAdd
  {𝔽 : Set} (𝔽-ring : Ring 𝔽)
  {ℙ : Set} (ℙ-monoid : Commutative-Monoid ℙ)
  where

open module 𝔽 = Ring 𝔽-ring

open module ⊕ = Commutative-Monoid ℙ-monoid
  renaming
    ( _∙_ to _⊕_
    ; ∙= to ⊕=
    ; ε∙-identity to ε⊕-identity
    ; ∙ε-identity to ⊕ε-identity
    ; _² to 2·_
    )

2·-⊕-distr : ∀ {P Q} → 2· (P ⊕ Q) ≡ 2· P ⊕ 2· Q
2·-⊕-distr = ⊕.interchange

2·-⊕ : ∀ {P Q R} → 2· P ⊕ (Q ⊕ R) ≡ (P ⊕ Q) ⊕ (P ⊕ R)
2·-⊕ = ⊕.interchange

-- NOT used yet
multiply-bin : List 𝟚 → ℙ → ℙ
multiply-bin scalar P = go scalar
  where
    go : List 𝟚 → ℙ
    go []       = P
    go (b ∷ bs) = [0: x₀ 1: x₁ ] b
      where x₀ = 2· go bs
            x₁ = P ⊕ x₀

{-
multiply : 𝔽 → ℙ → ℙ
multiply scalar P =
  -- if scalar == 0 or scalar >= N: raise Exception("Invalid Scalar/Private Key")
    multiply-bin (bin scalar) P

_·_ = multiply
infixr 8 _·_
-}

infixl 7 1+2*_
1+2*_ = λ x → 1+ 2* x

data Parity-View : 𝔽 → Set where
  zero⟨_⟩    : ∀ {n} → n ≡ 0# → Parity-View n
  even_by⟨_⟩ : ∀ {m n} → Parity-View m → n ≡ 2* m    → Parity-View n
  odd_by⟨_⟩  : ∀ {m n} → Parity-View m → n ≡ 1+ 2* m → Parity-View n

cast_by⟨_⟩ : ∀ {x y} → Parity-View x → y ≡ x → Parity-View y
cast zero⟨ xₑ ⟩       by⟨ yₑ ⟩ = zero⟨ yₑ ∙ xₑ ⟩
cast even xₚ by⟨ xₑ ⟩ by⟨ yₑ ⟩ = even xₚ by⟨ yₑ ∙ xₑ ⟩
cast odd  xₚ by⟨ xₑ ⟩ by⟨ yₑ ⟩ = odd  xₚ by⟨ yₑ ∙ xₑ ⟩

infixr 8 _·ₚ_
_·ₚ_ : ∀ {n} (p : Parity-View n) → ℙ → ℙ
zero⟨ e ⟩      ·ₚ P = ε
even p by⟨ e ⟩ ·ₚ P = 2· (p ·ₚ P)
odd  p by⟨ e ⟩ ·ₚ P = P ⊕ (2· (p ·ₚ P))

_+2*_ : 𝟚 → 𝔽 → 𝔽
0₂ +2* m =   2* m
1₂ +2* m = 1+2* m

{-
postulate
    bin-2* : ∀ {n} → bin (2* n) ≡ 0₂ ∷ bin n
    bin-1+2* : ∀ {n} → bin (1+2* n) ≡ 1₂ ∷ bin n

bin-+2* : (b : 𝟚)(n : 𝔽) → bin (b +2* n) ≡ b ∷ bin n
bin-+2* 1₂ n = bin-1+2*
bin-+2* 0₂ n = bin-2*
-}

-- (msb) most significant bit first
binₚ : ∀ {n} → Parity-View n → List 𝟚
binₚ zero⟨ e ⟩      = []
binₚ even p by⟨ e ⟩ = 0₂ ∷ binₚ p
binₚ odd  p by⟨ e ⟩ = 1₂ ∷ binₚ p

half : ∀ {n} → Parity-View n → 𝔽
half zero⟨ _ ⟩            = 0#
half (even_by⟨_⟩ {m} _ _) = m
half (odd_by⟨_⟩  {m} _ _) = m

{-
bin-parity : ∀ {n} (p : ParityView n) → bin n ≡ parity p ∷ bin (half p)
bin-parity (even n) = bin-2*
bin-parity (odd n)  = bin-1+2*
-}

infixl 6 1+ₚ_ _+ₚ_
1+ₚ_ : ∀ {x} → Parity-View x → Parity-View (1+ x)
1+ₚ zero⟨ e ⟩      = odd zero⟨ refl ⟩ by⟨ ap 1+_ (e ∙ ! 0+-identity) ⟩
1+ₚ even p by⟨ e ⟩ = odd p      by⟨ ap 1+_ e ⟩
1+ₚ odd  p by⟨ e ⟩ = even 1+ₚ p by⟨ ap 1+_ e ∙ ! +-assoc ∙ +-interchange ⟩

_+ₚ_ : ∀ {x y} → Parity-View x → Parity-View y → Parity-View (x + y)
zero⟨ xₑ ⟩       +ₚ yₚ        = cast yₚ by⟨ ap (λ z → z + _) xₑ ∙ 0+-identity ⟩
xₚ              +ₚ zero⟨ yₑ ⟩ = cast xₚ by⟨ ap (_+_ _) yₑ ∙ +-comm ∙ 0+-identity ⟩
even xₚ by⟨ xₑ ⟩ +ₚ even yₚ by⟨ yₑ ⟩ = even     xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-interchange ⟩
even xₚ by⟨ xₑ ⟩ +ₚ odd  yₚ by⟨ yₑ ⟩ = odd      xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-comm ∙ +-assoc ∙ ap 1+_ (+-comm ∙ +-interchange) ⟩
odd  xₚ by⟨ xₑ ⟩ +ₚ even yₚ by⟨ yₑ ⟩ = odd      xₚ +ₚ yₚ by⟨ += xₑ yₑ ∙ +-assoc ∙ ap 1+_ +-interchange ⟩
odd  xₚ by⟨ xₑ ⟩ +ₚ odd  yₚ by⟨ yₑ ⟩ = even 1+ₚ (xₚ +ₚ yₚ) by⟨ += xₑ yₑ ∙ +-on-sides refl +-interchange ⟩

infixl 7 2*ₚ_
2*ₚ_ : ∀ {x} → Parity-View x → Parity-View (2* x)
2*ₚ xₚ = xₚ +ₚ xₚ

open ≡-Reasoning

module _ {P Q} where
    ·ₚ-⊕-distr : ∀ {x} (xₚ : Parity-View x) → xₚ ·ₚ (P ⊕ Q) ≡ xₚ ·ₚ P ⊕ xₚ ·ₚ Q
    ·ₚ-⊕-distr zero⟨ xₑ ⟩       = ! ε⊕-identity
    ·ₚ-⊕-distr even xₚ by⟨ xₑ ⟩ = ap 2·_ (·ₚ-⊕-distr xₚ) ∙ 2·-⊕-distr
    ·ₚ-⊕-distr odd  xₚ by⟨ xₑ ⟩ = ap (λ z → P ⊕ Q ⊕ 2· z) (·ₚ-⊕-distr xₚ)
                               ∙ ap (λ z → P ⊕ Q ⊕ z) (! 2·-⊕)
                               ∙ ⊕.interchange

module _ {P} where
    cast-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₑ : y ≡ x) → cast xₚ by⟨ yₑ ⟩ ·ₚ P ≡ xₚ ·ₚ P
    cast-·ₚ-distr zero⟨ x₁ ⟩ yₑ = refl
    cast-·ₚ-distr even xₚ by⟨ x₁ ⟩ yₑ = refl
    cast-·ₚ-distr odd xₚ by⟨ x₁ ⟩ yₑ = refl

    1+ₚ-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → (1+ₚ xₚ) ·ₚ P ≡ P ⊕ xₚ ·ₚ P
    1+ₚ-·ₚ-distr zero⟨ xₑ ⟩       = ap (_⊕_ P) ε⊕-identity
    1+ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ = refl
    1+ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ = ap 2·_ (1+ₚ-·ₚ-distr xₚ) ∙ ⊕.interchange ∙ ⊕.assoc

    +ₚ-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₚ : Parity-View y)
                 → (xₚ +ₚ yₚ) ·ₚ P ≡ xₚ ·ₚ P ⊕ yₚ ·ₚ P
    +ₚ-·ₚ-distr zero⟨ xₑ ⟩ yₚ = cast-·ₚ-distr yₚ _ ∙ ! ε⊕-identity

    +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ⊕ε-identity
    +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ⊕ε-identity

    +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-⊕-distr
    +ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ = ap (_⊕_ P) (ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-⊕-distr) ∙ ⊕.assoc-comm
    +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap (_⊕_ P) (ap 2·_ (+ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-⊕-distr) ∙ ! ⊕.assoc
    +ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩
       = (odd xₚ by⟨ xₑ ⟩ +ₚ odd yₚ by⟨ yₑ ⟩) ·ₚ P
       ≡⟨by-definition⟩
         2·((1+ₚ (xₚ +ₚ yₚ)) ·ₚ P)
       ≡⟨ ap 2·_ helper ⟩
         2·(P ⊕ (xₚ ·ₚ P ⊕ yₚ ·ₚ P))
       ≡⟨ 2·-⊕-distr ⟩
         2· P ⊕ (2·(xₚ ·ₚ P ⊕ yₚ ·ₚ P))
       ≡⟨ ap (_⊕_ (2· P)) 2·-⊕-distr ⟩
         2· P ⊕ (2·(xₚ ·ₚ P) ⊕ 2·(yₚ ·ₚ P))
       ≡⟨ 2·-⊕ ⟩
         P ⊕ 2·(xₚ ·ₚ P) ⊕ (P ⊕ 2·(yₚ ·ₚ P))
       ≡⟨by-definition⟩
         odd xₚ by⟨ xₑ ⟩ ·ₚ P ⊕ odd yₚ by⟨ yₑ ⟩ ·ₚ P
       ∎
        where helper = (1+ₚ (xₚ +ₚ yₚ)) ·ₚ P
                     ≡⟨ 1+ₚ-·ₚ-distr (xₚ +ₚ yₚ) ⟩
                       P ⊕ ((xₚ +ₚ yₚ) ·ₚ P)
                     ≡⟨ ap (_⊕_ P) (+ₚ-·ₚ-distr xₚ yₚ) ⟩
                       P ⊕ (xₚ ·ₚ P ⊕ yₚ ·ₚ P)
                     ∎

*-1+-distr : ∀ {x y} → x * (1+ y) ≡ x + x * y
*-1+-distr = *-+-distrˡ ∙ += *1-identity refl

1+-*-distr : ∀ {x y} → (1+ x) * y ≡ y + x * y
1+-*-distr = *-+-distrʳ ∙ += 1*-identity refl

infixl 7 _*ₚ_
_*ₚ_ : ∀ {x y} → Parity-View x → Parity-View y → Parity-View (x * y)
zero⟨ xₑ ⟩       *ₚ yₚ              = zero⟨ *= xₑ refl ∙ 0*-zero ⟩
xₚ              *ₚ zero⟨ yₑ ⟩       = zero⟨ *= refl yₑ ∙ *0-zero ⟩
even xₚ by⟨ xₑ ⟩ *ₚ yₚ              = even (xₚ *ₚ yₚ) by⟨ *= xₑ refl ∙ *-+-distrʳ ⟩
xₚ              *ₚ even yₚ by⟨ yₑ ⟩ = even (xₚ *ₚ yₚ) by⟨ *= refl yₑ ∙ *-+-distrˡ ⟩
odd xₚ by⟨ xₑ ⟩  *ₚ odd yₚ by⟨ yₑ ⟩  = odd  (xₚ +ₚ yₚ +ₚ 2*ₚ (xₚ *ₚ yₚ)) by⟨ *= xₑ yₑ ∙ helper ⟩
   where
     x = _
     y = _
     helper = (1+2* x)*(1+2* y)
            ≡⟨ 1+-*-distr ⟩
              1+2* y + 2* x * 1+2* y
            ≡⟨ ap (λ z → 1+2* y + z)
                 (2* x * 1+2* y
                 ≡⟨ *-1+-distr ⟩
                 (2* x + 2* x * 2* y)
                 ≡⟨ += refl *-+-distrˡ ∙ +-interchange ⟩
                 (2* (x + 2* x * y))
                 ∎) ⟩
              1+2* y + 2* (x + 2* x * y)
            ≡⟨ +-assoc ∙ ap 1+_ +-interchange ⟩
              1+2*(y + (x + 2* x * y))
            ≡⟨ ap 1+2*_ (! +-assoc ∙ += +-comm refl) ⟩
              1+2*(x + y + 2* x * y)
            ≡⟨ ap (λ z → 1+2*(x + y + z)) *-+-distrʳ ⟩
              1+2*(x + y + 2* (x * y))
            ∎

module _ {P} where
    2·-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → 2·(xₚ ·ₚ P) ≡ xₚ ·ₚ 2· P
    2·-·ₚ-distr xₚ = ! ·ₚ-⊕-distr xₚ

    2*ₚ-·ₚ-distr : ∀ {x} (xₚ : Parity-View x) → (2*ₚ xₚ) ·ₚ P ≡ 2·(xₚ ·ₚ P)
    2*ₚ-·ₚ-distr xₚ = +ₚ-·ₚ-distr xₚ xₚ

·ₚ-ε : ∀ {x} (xₚ : Parity-View x) → xₚ ·ₚ ε ≡ ε
·ₚ-ε zero⟨ xₑ ⟩       = refl
·ₚ-ε even xₚ by⟨ xₑ ⟩ = ap 2·_ (·ₚ-ε xₚ) ∙ ε⊕-identity
·ₚ-ε odd xₚ by⟨ xₑ ⟩  = ε⊕-identity ∙ ap 2·_ (·ₚ-ε xₚ) ∙ ε⊕-identity

*ₚ-·ₚ-distr : ∀ {x y} (xₚ : Parity-View x) (yₚ : Parity-View y) {P} → (xₚ *ₚ yₚ) ·ₚ P ≡ xₚ ·ₚ yₚ ·ₚ P
*ₚ-·ₚ-distr zero⟨ xₑ ⟩ yₚ = refl
*ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ·ₚ-ε even xₚ by⟨ xₑ ⟩
*ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ zero⟨ yₑ ⟩ = ! ·ₚ-ε odd  xₚ by⟨ xₑ ⟩

*ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ = ap 2·_ (*ₚ-·ₚ-distr xₚ even yₚ by⟨ yₑ ⟩)
*ₚ-·ₚ-distr even xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ = ap 2·_ (*ₚ-·ₚ-distr xₚ odd  yₚ by⟨ yₑ ⟩)

*ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ even yₚ by⟨ yₑ ⟩ {P} =
   ap 2·_ (*ₚ-·ₚ-distr odd xₚ by⟨ xₑ ⟩ yₚ) ∙ 2·-⊕-distr ∙ ap (λ z → 2· (yₚ ·ₚ P) ⊕ 2· z) (2·-·ₚ-distr xₚ)
*ₚ-·ₚ-distr odd  xₚ by⟨ xₑ ⟩ odd  yₚ by⟨ yₑ ⟩ {P} =
   ap (_⊕_ P)
     (ap 2·_
        (+ₚ-·ₚ-distr (xₚ +ₚ yₚ) (2*ₚ (xₚ *ₚ yₚ))
        ∙ ⊕= (+ₚ-·ₚ-distr xₚ yₚ) (2*ₚ-·ₚ-distr (xₚ *ₚ yₚ))
        ∙ ⊕= ⊕.comm (ap 2·_ (*ₚ-·ₚ-distr xₚ yₚ) ∙ 2·-·ₚ-distr xₚ) ∙ ⊕.assoc
        ∙ ⊕= refl (! ·ₚ-⊕-distr xₚ) ) ∙ 2·-⊕-distr)
     ∙ ⊕.!assoc
-- -}
-- -}
-- -}
-- -}

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


Add Everything file

Add Everything file

module Everything where

import Holes.Prelude
import Holes.Term
import Holes.Cong.Limited
import Holes.Cong.General
import Holes.Cong.Propositional

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


scraps and a new file from some refactoring i forgot to check in. first cut at a slightly better readme for #15, although that will need to be updated before final submission. (i'll probably create more files and remove some, and some provisos will get dropped)

error: pathspec 'lemmas-subst-ta.agda' did not match any file(s) known to git


implementing rummy rules in types

implementing rummy rules in types

module rummy where

open import Data.Nat

-- The suit type
data Suit : Set where
  ♣ : Suit
  ♢ : Suit
  ♥ : Suit
  ♠ : Suit

-- A card consists of a value and a suite.
data Card : ℕ → Suit → Set where
  _of_ : (n : ℕ) (s : Suit) → Card n s

-- Common names for cards

A : ℕ; A = 1
K : ℕ; K = 13
Q : ℕ; Q = 12
J : ℕ; J = 11

--
-- The clubs suit
--

A♣  : Card A  ♣; A♣  = A  of ♣
2♣  : Card 2  ♣; 2♣  = 2  of ♣
3♣  : Card 3  ♣; 3♣  = 3  of ♣
4♣  : Card 4  ♣; 4♣  = 4  of ♣
5♣  : Card 5  ♣; 5♣  = 5  of ♣
6♣  : Card 6  ♣; 6♣  = 6  of ♣
7♣  : Card 7  ♣; 7♣  = 7  of ♣
8♣  : Card 8  ♣; 8♣  = 8  of ♣
9♣  : Card 9  ♣; 9♣  = 9  of ♣
10♣ : Card 10 ♣; 10♣ = 10 of ♣
J♣  : Card J  ♣; J♣  = J  of ♣
Q♣  : Card Q  ♣; Q♣  = Q  of ♣
K♣  : Card K  ♣; K♣  = K  of ♣

--
-- The diamond suit
--

A♢  : Card A  ♢; A♢  = A  of ♢
2♢  : Card 2  ♢; 2♢  = 2  of ♢
3♢  : Card 3  ♢; 3♢  = 3  of ♢
4♢  : Card 4  ♢; 4♢  = 4  of ♢
5♢  : Card 5  ♢; 5♢  = 5  of ♢
6♢  : Card 6  ♢; 6♢  = 6  of ♢
7♢  : Card 7  ♢; 7♢  = 7  of ♢
8♢  : Card 8  ♢; 8♢  = 8  of ♢
9♢  : Card 9  ♢; 9♢  = 9  of ♢
10♢ : Card 10 ♢; 10♢ = 10 of ♢
J♢  : Card J  ♢; J♢  = J  of ♢
Q♢  : Card Q  ♢; Q♢  = Q  of ♢
K♢  : Card K  ♢; K♢  = K  of ♢

--
-- The heart suit
--

A♥  : Card A  ♥; A♥  = A  of ♥
2♥  : Card 2  ♥; 2♥  = 2  of ♥
3♥  : Card 3  ♥; 3♥  = 3  of ♥
4♥  : Card 4  ♥; 4♥  = 4  of ♥
5♥  : Card 5  ♥; 5♥  = 5  of ♥
6♥  : Card 6  ♥; 6♥  = 6  of ♥
7♥  : Card 7  ♥; 7♥  = 7  of ♥
8♥  : Card 8  ♥; 8♥  = 8  of ♥
9♥  : Card 9  ♥; 9♥  = 9  of ♥
10♥ : Card 10 ♥; 10♥ = 10 of ♥
J♥  : Card J  ♥; J♥  = J  of ♥
Q♥  : Card Q  ♥; Q♥  = Q  of ♥
K♥  : Card K  ♥; K♥  = K  of ♥

--
-- The spade suit
--

A♠  : Card A  ♠; A♠  = A  of ♠
2♠  : Card 2  ♠; 2♠  = 2  of ♠
3♠  : Card 3  ♠; 3♠  = 3  of ♠
4♠  : Card 4  ♠; 4♠  = 4  of ♠
5♠  : Card 5  ♠; 5♠  = 5  of ♠
6♠  : Card 6  ♠; 6♠  = 6  of ♠
7♠  : Card 7  ♠; 7♠  = 7  of ♠
8♠  : Card 8  ♠; 8♠  = 8  of ♠
9♠  : Card 9  ♠; 9♠  = 9  of ♠
10♠ : Card 10 ♠; 10♠ = 10 of ♠
J♠  : Card J  ♠; J♠  = J  of ♠
Q♠  : Card Q  ♠; Q♠  = Q  of ♠
K♠  : Card K  ♠; K♠  = K  of ♠

-- A run should be at least of length 1.
data Run : Suit → (start : ℕ) → (length : ℕ) → Set where
  [] : {suit : Suit} {start : ℕ} → Run  suit  start 0

  _,_ : {suit : Suit} {n ℓ : ℕ}
       → Card n suit
       → Run    suit (1 + n)     ℓ
       → Run    suit    n     (1 + ℓ)

-- A group should be at least of size on.
data Group : (value ℓ : ℕ) → Set where
  [] : {value : ℕ} → Group value 0

  _,_ : {suit : Suit} {value ℓ : ℕ}
       → Card   value  suit
       → Group  value    ℓ
       → Group  value    (1 + ℓ)

-- Some pretty functions for creating runs. You can create a run as
-- follows:
-- myrun  = ⟨ A♣ , 2♣ , 3♣ ⟩
--

⟨_ : {suit : Suit} {n ℓ : ℕ} → Run suit n ℓ → Run suit n ℓ
⟨ r = r

_⟩ : {suit : Suit} {n : ℕ} → Card n suit → Run suit n 1
c ⟩ = c , []

-- Some pretty functions for creating groups. You can create a group
-- group as follows:
--
-- mygroup = ⟦ A♣ , A♥ , A♢ ⟧

⟦_ : {value ℓ : ℕ} → Group value ℓ → Group value ℓ
⟦ g = g

_⟧ : {suit : Suit} {n : ℕ} → Card n suit → Group n 1
c ⟧ = c , []

infixr 2 _⟩ _⟧ _,_
infixl 1 ⟨_ ⟦_

mygroup = ⟦ A♣ , A♣ , A♠ ⟧
myrun   = ⟨ A♣ , 2♣ , 3♣ ⟩

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


Added test for the Agda internal term Lam.

Ignore-this: 5070391dc904e0e9f9db84f3816717a2

darcs-hash:20120422152654-3bd4e-d4297b9ada9ca7421fbf78593aef650ede8867b3.gz

------------------------------------------------------------------------------
-- Testing Agda internal terms: Lam
------------------------------------------------------------------------------

-- The following conjecture uses the internal Agda term Lam.

module Test.Succeed.LamTerm where

postulate
  D : Set
  ∃ : (D → Set) → Set  -- The existential quantifier type on D.
  A : D → Set

postulate ∃-intro : (t : D) → A t → ∃ A
{-# ATP prove ∃-intro #-}

error: pathspec 'Test/Succeed/LamTerm.agda' did not match any file(s) known to git


2nd version of the example

2nd version of the example

{-

    Verified Koopa Troopa Movement
             Toon Nolten

-}

module koopa where
open import Data.Nat

data Color : Set where
  Green : Color
  Red : Color

data KoopaTroopa Color : Set where
  _KT : Color → KoopaTroopa Color

record Position : Set where
  constructor pos
  field
    x : ℕ
    y : ℕ

data _follows_ : Position → Position → Set where
  still : ∀ {p} → p follows p
  next  : ∀ {x y} → pos (suc x) y follows pos x y
  back  : ∀ {x y} → pos x y follows pos (suc x) y
  -- jump  : ∀ {x y} → pos x (suc y) follows pos x y
  fall  : ∀ {x y} → pos x y follows pos x (suc y)

data Path (Koopa : KoopaTroopa Color) : Position → Position → Set where
  []  : ∀ {p} → Path Koopa p p
  _↠[_]_ : {q r : Position} → (p : Position) → q follows p
           → (qs : Path Koopa q r) → Path Koopa p r

ex_path : Path (Red KT) (pos 0 0) (pos 0 0)
ex_path = pos 0 0 ↠[ next ] (pos 1 0 ↠[ back ] [])

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


module Level.NP where

import Level

open Level public renaming (zero to ₀; suc to ₛ)

₁ ₂ ₃ ₄ : Level
₁ = ₛ ₀
₂ = ₛ ₁
₃ = ₛ ₂
₄ = ₛ ₃

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


languages/test.agda

languages/test.agda

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/sharkspeed/dororis.git/'


add list of theorems

add list of theorems

Old-commit-hash: ae20c5bded5fecd55d9723e7870ba03979cd0880

module PLDI14-List-of-Theorems where

open import Function

-- List of theorems in PLDI submission
--
-- For hints about installation and execution, please refer
-- to README.agda.
--
-- Agda modules corresponding to definitions, lemmas and theorems
-- are listed here with the most important name. For example,
-- after this file type checks (C-C C-L), placing the cursor
-- on the purple "Base.Change.Algebra" and pressing M-. will
-- bring you to the file where change structures are defined.
-- The name for change structures in that file is
-- "ChangeAlgebra", given in the using-clause.

-- Definition 2.1 (Change structures)
-- (d) ChangeAlgebra.diff
-- (e) IsChangeAlgebra.update-diff
open import Base.Change.Algebra using (ChangeAlgebra)
---- Carrier in record ChangeAlgebra                        --(a)
open Base.Change.Algebra.ChangeAlgebra   using (Change)     --(b)
open Base.Change.Algebra.ChangeAlgebra   using (update)     --(c)
open Base.Change.Algebra.ChangeAlgebra   using (diff)       --(d)
open Base.Change.Algebra.IsChangeAlgebra using (update-diff)--(e)

-- Definition 2.2 (Nil change)
-- IsChangeAlgebra.nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Lemma 2.3 (Behavior of nil)
-- IsChangeAlgebra.update-nil
open Base.Change.Algebra using (IsChangeAlgebra)

-- Definition 2.4 (Derivatives)
open Base.Change.Algebra using (Derivative)

-- Definition 2.5 (Carrier set of function changes)
open Base.Change.Algebra.FunctionChanges

-- Definition 2.6 (Operations on function changes)
-- ChangeAlgebra.update FunctionChanges.changeAlgebra
-- ChangeAlgebra.diff   FunctionChanges.changeAlgebra
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Theorem 2.7 (Function changes form a change structure)
-- (In Agda, the proof of Theorem 2.7 has to be included in the
-- definition of function changes, here
-- FunctionChanges.changeAlgebra.)
open Base.Change.Algebra.FunctionChanges using (changeAlgebra)

-- Lemma 2.8 (Incrementalization)
open Base.Change.Algebra.FunctionChanges using (incrementalization)

-- Theorem 2.9 (Nil changes are derivatives)
open Base.Change.Algebra.FunctionChanges using (nil-is-derivative)

-- For each plugin requirement, we include its definition and
-- a concrete instantiation called "Popl14" with integers and
-- bags of integers as base types.

-- Plugin Requirement 3.1 (Domains of base types)
open import Parametric.Denotation.Value using (Structure)
open import     Popl14.Denotation.Value using (⟦_⟧Base)

-- Definition 3.2 (Domains)
open Parametric.Denotation.Value.Structure using (⟦_⟧Type)

-- Plugin Requirement 3.3 (Evaluation of constants)
open import Parametric.Denotation.Evaluation using (Structure)
open import     Popl14.Denotation.Evaluation using (⟦_⟧Const)

-- Definition 3.4 (Environments)
open import Base.Denotation.Environment using (⟦_⟧Context)

-- Definition 3.5 (Evaluation)
open Parametric.Denotation.Evaluation.Structure using (⟦_⟧Term)

-- Plugin Requirement 3.6 (Changes on base types)
open import Parametric.Change.Validity using (Structure)
open import     Popl14.Change.Validity using (change-algebra-base-family)

-- Definition 3.7 (Changes)
open Parametric.Change.Validity.Structure using (change-algebra)

-- Definition 3.8 (Change environments)
open Parametric.Change.Validity.Structure using (environment-changes)

-- Plugin Requirement 3.9 (Change semantics for constants)
open import Parametric.Change.Specification using (Structure)
open import     Popl14.Change.Specification using (specification-structure)

-- Definition 3.10 (Change semantics)
open Parametric.Change.Specification.Structure using (⟦_⟧Δ)

-- Lemma 3.11 (Change semantics is the derivative of semantics)
open Parametric.Change.Specification.Structure using (correctness)

-- Definition 3.12 (Erasure)
import Parametric.Change.Implementation
open Parametric.Change.Implementation.Structure using (_≈_)
open import Popl14.Change.Implementation using (implements-base)

-- Lemma 3.13 (The erased version of a change is almost the same)
open Parametric.Change.Implementation.Structure using (carry-over)

-- Lemma 3.14 (⟦ t ⟧Δ erases to Derive(t))
import Parametric.Change.Correctness
open Parametric.Change.Correctness.Structure using (main-theorem)

error: pathspec 'PLDI14-List-of-Theorems.agda' did not match any file(s) known to git


adding a stab at what complete preseration looks like

open import Nat
open import Prelude
open import List
open import core
open import contexts

module complete-preservation where
  complete-preservation : {Δ : hctx} {e : hexp} {d d' : dhexp} {τ : htyp} →
             ecomplete e →
             ∅ ⊢ e ⇒ τ ~> d ⊣ Δ →
             Δ ⊢ d ↦ d' →
             Δ , ∅ ⊢ d' :: τ
  complete-preservation = {!!}

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


backed up Preorder

backed up Preorder

open import Stlc hiding (⟹*-Preorder; _⟹*⟪_⟫_; example₀; example₁)
open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl)
open import Relation.Binary using (Preorder)
import Relation.Binary.PreorderReasoning as PreorderReasoning

⟹*-Preorder : Preorder _ _ _
⟹*-Preorder = record
  { Carrier    = Term
  ; _≈_        = _≡_
  ; _∼_        = _⟹*_
  ; isPreorder = record
    { isEquivalence = P.isEquivalence
    ; reflexive     = λ {refl → ⟨⟩}
    ; trans         = _>>_
    }
  }

open PreorderReasoning ⟹*-Preorder
     using (_IsRelatedTo_; begin_; _∎) renaming (_≈⟨_⟩_ to _≡⟨_⟩_; _∼⟨_⟩_ to _⟹*⟨_⟩_)

infixr 2 _⟹*⟪_⟫_

_⟹*⟪_⟫_ : ∀ x {y z} → x ⟹ y → y IsRelatedTo z → x IsRelatedTo z
x ⟹*⟪ x⟹y ⟫ yz  =  x ⟹*⟨ ⟨ x⟹y ⟩ ⟩ yz

example₀ : not · true ⟹* false
example₀ =
  begin
    not · true
  ⟹*⟪ β⇒ value-true ⟫
    if true then false else true
  ⟹*⟪ β𝔹₁ ⟫
    false
  ∎

example₁ : I² · I · (not · false) ⟹* true
example₁ =
  begin
    I² · I · (not · false)
  ⟹*⟪ γ⇒₁ (β⇒ value-λ) ⟫
    (λ[ x ∶ 𝔹 ] I · var x) · (not · false)
  ⟹*⟪ γ⇒₂ value-λ (β⇒ value-false) ⟫
    (λ[ x ∶ 𝔹 ] I · var x) · (if false then false else true)
  ⟹*⟪ γ⇒₂ value-λ β𝔹₂ ⟫
    (λ[ x ∶ 𝔹 ] I · var x) · true
  ⟹*⟪ β⇒ value-true ⟫
    I · true
  ⟹*⟪ β⇒ value-true ⟫
    true
  ∎

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


Define a change structure for products

Define a change structure for products

Derivatives of curried functions seem challenging.
Accessing nested records too, but seems easy to fix.

Old-commit-hash: d89e6171d447aae6292cc025dc6db95ce2370b88

module Base.Change.Products where

open import Relation.Binary.PropositionalEquality
open import Level

open import Base.Change.Algebra

open import Data.Product

-- Also try defining sectioned change structures on the positives halves of
-- groups? Or on arbitrary subsets?

-- Restriction: we pair sets on the same level (because right now everything
-- else would risk getting in the way).
module ProductChanges ℓ (A B : Set ℓ) {{CA : ChangeAlgebra ℓ A}} {{CB : ChangeAlgebra ℓ B}} where
  open ≡-Reasoning

  -- The simplest possible definition of changes for products.

  -- The following is probably bullshit:
  -- Does not handle products of functions - more accurately, writing the
  -- derivative of fst and snd for products of functions is hard: fst' p dp must return the change of fst p
  PChange : A × B → Set ℓ
  PChange (a , b) = Δ a × Δ b

  _⊕_ : (v : A × B) → PChange v → A × B
  _⊕_ (a , b) (da , db) = a ⊞ da , b ⊞ db
  _⊝_ : A × B → (v : A × B) → PChange v
  _⊝_ (aNew , bNew) (a , b) = aNew ⊟ a , bNew ⊟ b

  p-update-diff : (u v : A × B) → v ⊕ (u ⊝ v) ≡ u
  p-update-diff (ua , ub) (va , vb) =
    let u = (ua , ub)
        v = (va , vb)
    in
      begin
        v ⊕ (u ⊝ v)
      ≡⟨⟩
        (va ⊞ (ua ⊟ va) , vb ⊞ (ub ⊟ vb))
        --v ⊕ ((ua ⊟ va , ub ⊟ vb))
      ≡⟨ cong₂ _,_ (update-diff ua va) (update-diff ub vb)⟩
        (ua , ub)
      ≡⟨⟩
        u
      ∎

  changeAlgebra : ChangeAlgebra ℓ (A × B)
  changeAlgebra = record
    { Change = PChange
    ; update = _⊕_
    ; diff = _⊝_
    ; isChangeAlgebra = record
      { update-diff = p-update-diff
      }
    }

  proj₁′ : (v : A × B) → Δ v → Δ (proj₁ v)
  proj₁′ (a , b) (da , db) = da

  proj₁′Derivative : Derivative proj₁ proj₁′
  -- Implementation note: we do not need to pattern match on v and dv because
  -- they are records, hence Agda knows that pattern matching on records cannot
  -- fail. Technically, the required feature is the eta-rule on records.
  proj₁′Derivative v dv = refl

  -- An extended explanation.
  proj₁′Derivative₁ : Derivative proj₁ proj₁′
  proj₁′Derivative₁ (a , b) (da , db) =
    let v  = (a  , b)
        dv = (da , db)
    in
      begin
        proj₁ v ⊞ proj₁′ v dv
      ≡⟨⟩
        a ⊞ da
      ≡⟨⟩
        proj₁ (v ⊞ dv)
      ∎

  -- Same for the second extractor.
  proj₂′ : (v : A × B) → Δ v → Δ (proj₂ v)
  proj₂′ (a , b) (da , db) = db

  proj₂′Derivative : Derivative proj₂ proj₂′
  proj₂′Derivative v dv = refl

  -- We should do the same for uncurry instead.

  -- What one could wrongly expect to be the derivative of the constructor:
  _,_′ : (a : A) → (da : Δ a) → (b : B) → (db : Δ b) → Δ (a , b)
  _,_′ a da b db = da , db

  -- That has the correct behavior, in a sense, and it would be in the
  -- subset-based formalization in the paper.
  --
  -- But the above is not even a change, because it does not contain a proof of its own validity, and because after application it does not contain a proof

  -- As a consequence, proving that's a derivative seems too insanely hard. We
  -- might want to provide a proof schema for curried functions at once,
  -- starting from the right correctness equation.

  B→A×B = FunctionChanges.changeAlgebra {c = ℓ} {d = ℓ} B (A × B)
  A→B→A×B = FunctionChanges.changeAlgebra {c = ℓ} {d = ℓ} A (B → A × B) {{CA}} {{B→A×B}}
  module ΔBA×B = FunctionChanges B (A × B) {{CB}} {{changeAlgebra}}
  module ΔA→B→A×B = FunctionChanges A (B → A × B) {{CA}} {{B→A×B}}

  _,_′-real : Δ _,_
  _,_′-real = nil _,_
  module FCΔA→B→A×B = ΔA→B→A×B.FunctionChange
  _,_′-real-Derivative : Derivative {{CA}} {{B→A×B}} _,_ (FCΔA→B→A×B.apply _,_′-real)
  _,_′-real-Derivative =
    FunctionChanges.nil-is-derivative A (B → A × B) {{CA}} {{B→A×B}} _,_

  {-

  _,_′′ :  (a : A) → Δ a →
      Δ {{B→A×B}} (λ b → (a , b))
  _,_′′ a da = record
    { apply = _,_′ a da
    ; correct = λ b db →
      begin
        (a , b ⊞ db) ⊞ (_,_′ a da) (b ⊞ db) (nil (b ⊞ db))
      ≡⟨⟩
        a ⊞ da , b ⊞ db ⊞ (nil (b ⊞ db))
      ≡⟨ cong (λ □ →  a ⊞ da , □) (update-nil (b ⊞ db)) ⟩
        a ⊞ da , b ⊞ db
      ≡⟨⟩
        (a , b) ⊞ (_,_′ a da) b db
      ∎
    }

  _,_′′′ : Δ {{A→B→A×B}} _,_
  _,_′′′ = record
    { apply = _,_′′
    ; correct = λ a da →
      begin
        update
        (_,_ (a ⊞ da))
        (_,_′′ (a ⊞ da) (nil (a ⊞ da)))
      ≡⟨ {!!} ⟩
        update (_,_ a) (_,_′′ a da)
        --ChangeAlgebra.update B→A×B (_,_ a) (a , da ′′)
      ∎
    }
    where
      open ChangeAlgebra B→A×B hiding (nil)
{-
  {!
      begin
        (_,_ (a ⊞ da)) ⊞ _,_′′ (a ⊞ da) (nil (a ⊞ da))
      {- ≡⟨⟩
        a ⊞ da , b ⊞ db ⊞ (nil (b ⊞ db)) -}
      ≡⟨ ? ⟩
        {-a ⊞ da , b ⊞ db
      ≡⟨⟩-}
       (_,_ a) ⊞ (_,_′′ a da)
      ∎!}
    }
-}
  open import Postulate.Extensionality

  _,_′Derivative :
    Derivative {{CA}} {{B→A×B}} _,_  _,_′′
  _,_′Derivative a da =
    begin
      _⊞_ {{B→A×B}} (_,_ a) (_,_′′ a da)
    ≡⟨⟩
      (λ b → (a , b) ⊞ ΔBA×B.FunctionChange.apply (_,_′′ a da) b (nil b))
    --ext (λ b → cong (λ □ →  (a , b) ⊞ □) (update-nil {{?}} b))
    ≡⟨ {!!} ⟩
      (λ b → (a , b) ⊞ ΔBA×B.FunctionChange.apply (_,_′′ a da) b (nil b))
    ≡⟨ sym {!ΔA→B→A×B.incrementalization _,_ _,_′′′ a da!} ⟩
  --FunctionChanges.incrementalization A (B → A × B) {{CA}} {{{!B→A×B!}}} _,_ {!!} {!!} {!!}
       _,_ (a ⊞ da)
    ∎
    where
      --open FunctionChanges B (A × B) {{CB}} {{changeAlgebra}}
      module ΔBA×B = FunctionChanges B (A × B) {{CB}} {{changeAlgebra}}
      module ΔA→B→A×B = FunctionChanges A (B → A × B) {{CA}} {{B→A×B}}

  -}

error: pathspec 'Base/Change/Products.agda' did not match any file(s) known to git


import Level as L
open import Type hiding (★)
open import Function.NP
open import Category.Functor

module Category.Profunctor {ℓ} where

record Profunctor (_↝_ : ★ ℓ → ★ ℓ → ★ ℓ) : ★ (L.suc ℓ) where
  constructor _,_
  field
    lmap : ∀ {A B C} → (A → B) → B ↝ C → A ↝ C
    rmap : ∀ {A B C} → (B → C) → A ↝ B → A ↝ C

→Profunctor : Profunctor -→-
→Profunctor = flip _∘′_ , _∘′_

UpStar : (★ ℓ → ★ ℓ) → ★ ℓ → ★ ℓ → ★ ℓ
UpStar F D C = D → F C

upStarRawFunctor : ∀ {F A} → RawFunctor F → RawFunctor (UpStar F A)
upStarRawFunctor fun = record { _<$>_ = λ k f x → k <$> f x }
  where open RawFunctor fun

upStarProfunctor : ∀ {F} → RawFunctor F → Profunctor (UpStar F)
upStarProfunctor fun = flip _∘′_
                     , RawFunctor._<$>_ (upStarRawFunctor fun)

DownStar : (★ ℓ → ★ ℓ) → ★ ℓ → ★ ℓ → ★ ℓ
DownStar F D C = F D → C

downStarProfunctor : ∀ {F} → RawFunctor F → Profunctor (DownStar F)
downStarProfunctor fun = (λ f g x → g (f <$> x)) , _∘′_
  where open RawFunctor fun

downStarRawFunctor : ∀ {F A} → RawFunctor (DownStar F A)
downStarRawFunctor = record { _<$>_ = _∘′_ }

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


open import Function.NP
open import Data.Nat using (_+_)
import Level as L
import Function.Inverse.NP as FI
import Function.Related as FR
open FI using (_↔_; inverses; module Inverse) renaming (_$₁_ to to; _$₂_ to from)
open import Function.Related.TypeIsomorphisms.NP
open import Data.Product.NP
open import Data.Sum
open import Data.Fin using (Fin)
open import Search.Type
open import Search.Searchable

open import Relation.Binary.Sum
open import Relation.Binary.PropositionalEquality.NP using (_≡_ ; module ≡-Reasoning; cong)

module Search.Searchable.Sum where

infixr 4 _⊎-search_

_⊎-search_ : ∀ {m A B} → Search m A → Search m B → Search m (A ⊎ B)
(searchᴬ ⊎-search searchᴮ) _∙_ f = searchᴬ _∙_ (f ∘ inj₁) ∙ searchᴮ _∙_ (f ∘ inj₂)

_⊎-search-ind_ : ∀ {m p A B} {sᴬ : Search m A} {sᴮ : Search m B}
                 → SearchInd p sᴬ → SearchInd p sᴮ → SearchInd p (sᴬ ⊎-search sᴮ)
(Psᴬ ⊎-search-ind Psᴮ) P P∙ Pf
  = P∙ (Psᴬ (λ s → P (λ _ f → s _ (f ∘ inj₁))) P∙ (Pf ∘ inj₁))
       (Psᴮ (λ s → P (λ _ f → s _ (f ∘ inj₂))) P∙ (Pf ∘ inj₂))

infixr 4 _⊎-sum_

_⊎-sum_ : ∀ {A B} → Sum A → Sum B → Sum (A ⊎ B)
(sumᴬ ⊎-sum sumᴮ) f = sumᴬ (f ∘ inj₁) + sumᴮ (f ∘ inj₂)

module _ {A B} {sumᴬ : Sum A} {sumᴮ : Sum B} where

    sumᴬᴮ = sumᴬ ⊎-sum sumᴮ

    _⊎-adequate-sum_ : AdequateSum sumᴬ → AdequateSum sumᴮ → AdequateSum sumᴬᴮ
    (asumᴬ ⊎-adequate-sum asumᴮ) f = (Fin (sumᴬ (f ∘ inj₁) + sumᴮ (f ∘ inj₂)))
                                   ↔⟨ FI.sym (Fin-⊎-+ _ _) ⟩
                                     (Fin (sumᴬ (f ∘ inj₁)) ⊎ Fin (sumᴮ (f ∘ inj₂)))
                                   ↔⟨ asumᴬ (f ∘ inj₁) ⊎-cong asumᴮ (f ∘ inj₂) ⟩
                                     (Σ A (Fin ∘ f ∘ inj₁) ⊎ Σ B (Fin ∘ f ∘ inj₂))
                                   ↔⟨ FI.sym Σ⊎-distrib ⟩
                                     Σ (A ⊎ B) (Fin ∘ f)
                                   ∎
      where open FR.EquationalReasoning

_⊎-μ_ : ∀ {A B} → Searchable A → Searchable B → Searchable (A ⊎ B)
μA ⊎-μ μB = mk _ (search-ind μA ⊎-search-ind search-ind μB)
                 (adequate-sum μA ⊎-adequate-sum adequate-sum μB)

module _ {A B} {sᴬ : Search₁ A} {sᴮ : Search₁ B} where
  sᴬ⁺ᴮ = sᴬ ⊎-search sᴮ
  _⊎-focus_ : Focus sᴬ → Focus sᴮ → Focus sᴬ⁺ᴮ
  (fᴬ ⊎-focus fᴮ) (inj₁ x , y) = inj₁ (fᴬ (x , y))
  (fᴬ ⊎-focus fᴮ) (inj₂ x , y) = inj₂ (fᴮ (x , y))

  _⊎-unfocus_ : Unfocus sᴬ → Unfocus sᴮ → Unfocus sᴬ⁺ᴮ
  _⊎-unfocus_ fᴬ fᴮ (inj₁ x) = first inj₁ (fᴬ x)
  _⊎-unfocus_ fᴬ fᴮ (inj₂ y) = first inj₂ (fᴮ y)

  {-
  _⊎-focused_ : Focused sᴬ → Focused sᴮ → Focused {L.zero} sᴬ⁺ᴮ
  _⊎-focused_ fᴬ fᴮ {B} = inverses (to fᴬ ⊎-focus to fᴮ) (from fᴬ ⊎-unfocus from fᴮ) (⇒) (⇐)
      where
        ⇒ : (x : Σ (A ⊎ {!!}) {!!}) → _
        ⇒ (x , y) = {!!}
        ⇐ : (x : sᴬ _⊎_ (B ∘ inj₁) ⊎ sᴮ _⊎_ (B ∘ inj₂)) → _
        ⇐ (inj₁ x) = cong inj₁ {!!}
        ⇐ (inj₂ x) = cong inj₂ {!!}
  -}

  _⊎-lookup_ : Lookup sᴬ → Lookup sᴮ → Lookup (sᴬ ⊎-search sᴮ)
  (lookupᴬ ⊎-lookup lookupᴮ) (x , y) = [ lookupᴬ x , lookupᴮ y ]

  _⊎-reify_ : Reify sᴬ → Reify sᴮ → Reify (sᴬ ⊎-search sᴮ)
  (reifyᴬ ⊎-reify reifyᴮ) f = (reifyᴬ (f ∘ inj₁)) , (reifyᴮ (f ∘ inj₂))

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

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


elgamal.agda

elgamal.agda

{-# OPTIONS --copatterns #-}
open import Function
open import Data.Product
open import Data.Bool.NP as Bool
open import Data.Unit
open import Data.Maybe.NP
import Data.Fin.NP as Fin
open Fin using (Fin; zero; suc) renaming (#_ to ##_)
open import Data.Nat.NP hiding (_^_)
open import Data.Bits
import Data.Vec.NP as Vec
open Vec using (Vec; []; _∷_; _∷ʳ_; allFin; lookup) renaming (map to vmap)
--import Data.Vec.Properties as Vec
open import Algebra.FunctionProperties
open import Relation.Binary.PropositionalEquality as ≡

module elgamal where

★₁ : Set₂
★₁ = Set₁

★ : Set₁
★ = Set

[0→_,1→_] : ∀ {a} {A : Set a} → A → A → Bool → A
[0→ e₀ ,1→ e₁ ] b = if b then e₁ else e₀

case_0→_1→_ : ∀ {a} {A : Set a} → Bool → A → A → A
case b 0→ e₀ 1→ e₁ = if b then e₁ else e₀

sumBit : (Bit → ℕ) → ℕ
sumBit f = f 0b + f 1b

data `★ : ★ where
  `⊤   : `★
  `X   : `★
  _`×_ : `★ → `★ → `★
infixr 2 _`×_

module Univ (X : ★) where
    El : `★ → ★
    El `⊤         = ⊤
    El `X         = X
    El (u₀ `× u₁) = El u₀ × El u₁

    record ↺ (R : `★) (A : ★) : ★ where
      constructor mk
      field
        run↺ : El R → A
    open ↺ public

    EXP : (R : `★) → ★
    EXP R = ↺ R Bit

    Det : ★ → ★
    Det = ↺ `⊤

module ℤq-count
  (ℤq : ★)
  (_⊞_ : ℤq → ℤq → ℤq)
  (sumℤq : (ℤq → ℕ) → ℕ)
  (sumℤq-lem : ∀ f x → sumℤq (f ∘ _⊞_ x) ≡ sumℤq f)
  where

  open Univ ℤq
  open `★ public renaming (`X to `ℤq)

  sum : (u : `★) → (El u → ℕ) → ℕ
  sum `⊤         f = f _
  sum `X         f = sumℤq f
  sum (u₀ `× u₁) f = sum u₀ (λ x₀ →
                       sum u₁ (λ x₁ →
                         f (x₀ , x₁)))

  #_ : ∀ {u} → ↺ u Bit → ℕ
  #_ {u} f = sum u (Bool.toℕ ∘ run↺ f)

  ⁇ : ∀ R → ↺ R (El R)
  run↺ (⁇ _) = id

  pure↺ : ∀ {R A} → A → ↺ R A
  run↺ (pure↺ x) r = x -- turning r to _ produce an error

  ⟪_⟫ : ∀ {R A} → A → ↺ R A
  ⟪_⟫ = pure↺

  {-
  ⟪_⟫ᴰ : ∀ {a} {A : Set a} → A → Det A
  ⟪_⟫ᴰ = pureᴰ
  -}

  map↺ : ∀ {A B R} → (A → B) → ↺ R A → ↺ R B
  run↺ (map↺ f x) r = f (run↺ x r)

  infixl 4 _⊛_
  _⊛_ : ∀ {R S A B} → ↺ R (A → B) → ↺ S A → ↺ (R `× S) B
  run↺ (af ⊛ ax) rs = run↺ af (proj₁ rs) (run↺ ax (proj₂ rs))

  ⟪_·_⟫ : ∀ {A B R} → (A → B) → ↺ R A → ↺ R B
  ⟪ f · x ⟫ = map↺ f x

  ⟪_·_·_⟫ : ∀ {A B C} {R S} →
              (A → B → C) → ↺ R A → ↺ S B → ↺ (R `× S) C
  ⟪ f · x · y ⟫ = map↺ f x ⊛ y

  _⟨⊞⟩_ : ∀ {R S} → ↺ R ℤq → ↺ S ℤq → ↺ (R `× S) ℤq
  x ⟨⊞⟩ y = ⟪ _⊞_ · x · y ⟫

  ⟨_⊞⟩_ : ∀ {R} → ℤq → ↺ R ℤq → ↺ R ℤq
  ⟨ x ⊞⟩ y = ⟪ _⊞_ x · y ⟫

  infix 4 _≈↺_ _≈ᴬ_
  _≈↺_ : ∀ {R : `★} (f g : EXP R) → ★
  _≈↺_ = _≡_ on #_

  _≈ᴬ_ : ∀ {A R} (f g : ↺ R A) → Set _
  _≈ᴬ_ {A} f g = ∀ (Adv : A → Bit) → ⟪ Adv · f ⟫ ≈↺ ⟪ Adv · g ⟫

  lem : ∀ x → ⟨ x ⊞⟩ (⁇ `ℤq) ≈ᴬ ⁇ _
  lem x Adv = sumℤq-lem (Bool.toℕ ∘ Adv) x

  -- ∀ (A : ℤq → Bit) → # (A ⁇)

open Fin.Modulo renaming (sucmod to [suc])

{-
module ℤq-implem (q-2 : ℕ) where
  q : ℕ
  q = 2 + q-2

  ℤq : ★
  ℤq = Fin q

  [0] : ℤq
  [0] = zero

  [1] : ℤq
  [1] = suc zero
-}
module ℤq-implem (q : ℕ) ([0]' [1]' : Fin q) where
  ℤq : ★
  ℤq = Fin q

  [0] : ℤq
  [0] = [0]'

  [1] : ℤq
  [1] = [1]'

  _ℕ⊞_ : ℕ → ℤq → ℤq
  zero  ℕ⊞ n = n
  suc m ℕ⊞ n = m ℕ⊞ ([suc] n)
  {-
  zero  ℕ⊞ n = n
  suc m ℕ⊞ n = [suc] (m ℕ⊞ n)
  -}

  _⊞_ : ℤq → ℤq → ℤq
  m ⊞ n = Fin.toℕ m ℕ⊞ n

  _ℕ⊠_ : ℕ → ℤq → ℤq
  zero  ℕ⊠ n = [0]
  suc m ℕ⊠ n = n ⊞ (m ℕ⊠ n)

  _⊠_ : ℤq → ℤq → ℤq
  m ⊠ n = Fin.toℕ m ℕ⊠ n

  _[^]ℕ_ : ℤq → ℕ → ℤq
  m [^]ℕ zero  = [1]
  m [^]ℕ suc n = m ⊠ (m [^]ℕ n)

  _[^]_ : ℤq → ℤq → ℤq
  m [^] n = m [^]ℕ (Fin.toℕ n)

  allℤq : Vec ℤq q
  allℤq = allFin q

  sumℤq : (ℤq → ℕ) → ℕ
  sumℤq f = Vec.sum (vmap f allℤq)

  sumℤq-[suc]-lem : ∀ f → sumℤq (f ∘ [suc]) ≡ sumℤq f
  sumℤq-[suc]-lem f rewrite ≡.sym (Vec.sum-map-rot₁ f allℤq)
                          | Vec.map-∘ f [suc] allℤq
                          | rot₁-map-sucmod q
                          = refl

  --  comm-[suc]-ℕ⊞ : ∀ m n → [suc] (m ℕ⊞ n) ≡ m ℕ⊞ ([suc] n)

  sumℤq-ℕ⊞-lem : ∀ m f → sumℤq (f ∘ _ℕ⊞_ m) ≡ sumℤq f
  sumℤq-ℕ⊞-lem zero f = refl
  sumℤq-ℕ⊞-lem (suc m) f rewrite sumℤq-[suc]-lem (f ∘ _ℕ⊞_ m)
                               | sumℤq-ℕ⊞-lem m f = refl

  sumℤq-⊞-lem : ∀ m f → sumℤq (f ∘ _⊞_ m) ≡ sumℤq f
  sumℤq-⊞-lem = sumℤq-ℕ⊞-lem ∘ Fin.toℕ

module G-implem (p q : ℕ) (g' : Fin p) (0[p] 1[p] : Fin p) (0[q] 1[q] : Fin q) where
  open ℤq-implem q 0[q] 1[q] public
  open ℤq-implem p 0[p] 1[p] public using () renaming (ℤq to G; _⊠_ to _∙_; _[^]ℕ_ to _^[p]_)

  g : G
  g = g'

  _^_ : G → ℤq → G
  x ^ n = x ^[p] Fin.toℕ n

  g^_ : ℤq → G
  g^ n = g ^ n

  postulate
    g^-inj : ∀ m n → g^ m ≡ g^ n → m ≡ n

module G-count
  (ℤq : ★)
  (_⊞_ : ℤq → ℤq → ℤq)
  (sumℤq : (ℤq → ℕ) → ℕ)
  (sumℤq-lem : ∀ f x → sumℤq (f ∘ _⊞_ x) ≡ sumℤq f)
  (G : ★)
  (g : G)
  (_^_ : G → ℤq → G)
  where

  open Univ ℤq
  open ℤq-count ℤq _⊞_ sumℤq sumℤq-lem

  ⁇G : ↺ `ℤq G
  run↺ ⁇G x = g ^ x

module DDH
  (ℤq  : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G   : ★)
  (g^_ : ℤq → G)
  where
    DDHAdv : ★ → ★
    DDHAdv R = G → G → G → R → Bool

    ⅁₀ : ∀ {R} {_I : ★} → DDHAdv R → (ℤq × ℤq × _I × R) → Bool
    ⅁₀ D (x , y , _ , r) = D (g^ x) (g^ y) (g^ (x ⊠ y)) r

    ⅁₁ : ∀ {R} → DDHAdv R → (ℤq × ℤq × ℤq × R) → Bool
    ⅁₁ D (x , y , z , r) = D (g^ x) (g^ y) (g^ z) r

    ⅁ : ∀ {R} → DDHAdv R → Bool → (ℤq × ℤq × ℤq × R) → Bool
    ⅁ D b = (if b then ⅁₀ else ⅁₁) D

    ⅁′ : ∀ {R} → DDHAdv R → (Bool × ℤq × ℤq × ℤq × R) → Bool
    ⅁′ D (b , x , y , z , r) = ⅁ D b (x , y , z , r)

    module With↺ where
        open Univ ℤq
        open `★ public renaming (`X to `ℤq)
        DDHAdv↺ : `★ → ★
        DDHAdv↺ R = G → G → G → ↺ R Bool
        ⅁₀↺ : ∀ {R _I} → DDHAdv↺ R → ↺ (`ℤq `× `ℤq `× _I `× R) Bool
        run↺ (⅁₀↺ D) = ⅁₀ (λ a b c → run↺ (D a b c))

module El-Gamal-Generic
  (ℤq : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G : ★)
  (g : G)
  (_^_ : G → ℤq → G)
  (Message : ★)
  (_⊕_ : G → Message → Message)
  (_⊕⁻¹_ : G → Message → Message)
  where

    -- α is the pk
    -- α = g ^ x
    -- x is the sk

    PubKey = G
    SecKey = ℤq
    KeyPair = PubKey × SecKey
    CipherText = G × Message

    M = Message
    C = CipherText

    KeyGen : ℤq → KeyPair
    KeyGen x = (g ^ x , x)

    -- KeyGen↺ : ↺ ℤq KeyPair
    -- KeyGen↺ = mk KeyGen

    Enc : PubKey → Message → ℤq → CipherText
    Enc α m y = β , ζ where
      β = g ^ y
      δ = α ^ y
      ζ = δ ⊕ m

    -- Enc↺ : PubKey → Message → ↺ ℤq CipherText
    -- Enc↺ α m = mk (Enc α m)

    Dec : SecKey → CipherText → Message
    Dec x (β , ζ) = (β ^ x) ⊕⁻¹ ζ

    EncAdv : ★ → ★
    EncAdv R = PubKey → R → (Bool → M) × (C → Bool)

    Game0 : ∀ {R _I : Set} → EncAdv R → (Bool × ℤq × ℤq × _I × R) → Bool
    Game0 A (b , x , y , z , r) =
      let (pk , sk) = KeyGen x
          (m , D) = A pk r in
      D (Enc pk (m b) y)

    Game : (i : Bool) → ∀ {R} → EncAdv R → (Bool × ℤq × ℤq × ℤq × R) → Bool
    Game i A (b , x , y , z , r) =
      let (α , sk) = KeyGen x
          (m , D) = A α r
          β = g ^ y
          δ = α ^ case i 0→ y 1→ z
          ζ = δ ⊕ m b
      in {-b ==ᵇ-} D (β , ζ)

    Game-0b≡Game0 : ∀ {R} → Game 0b ≡ Game0 {R}
    Game-0b≡Game0 = refl

    open DDH ℤq _⊠_ G (_^_ g) public

    -- Game0 ≈ Game 0b
    -- Game1 = Game 1b

    -- Game0 ≤ ε
    -- Game1 ≡ 0

    -- ⁇ ⊕ x ≈ ⁇

    -- g ^ ⁇ ∙ x ≈ g ^ ⁇

module El-Gamal-Base
    (ℤq : ★)
    (_⊠_ : ℤq → ℤq → ℤq)
    (G : ★)
    (g : G)
    (_^_ : G → ℤq → G)
    (_⁻¹ : G → G)
    (_∙_ : G → G → G)
    where

    _/_ : G → G → G
    x / y = x ∙ (y ⁻¹)
    open El-Gamal-Generic ℤq _⊠_ G g _^_ G _∙_ (flip _/_) public

    TrA : ∀ {R} → Bool → EncAdv R → DDHAdv R
    TrA b A gˣ gʸ g? r = d (gʸ , g? ∙ m b)
       where m,d = A gˣ r
             m = proj₁ m,d
             d = proj₂ m,d

    module Proof
      -- (⊠-comm : Commutative _≡_ _⊠_)
      (dist-^-⊠ : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
      -- (^-comm : ∀ α x y → (α ^ x) ^ y ≡ (α ^ y) ^ x)
      where

        pf1 : ∀ {R} A r → Game 0b {R} A r ≡ ⅁′ (TrA 1b A) r
        pf1 A (true , x , y , z , r) rewrite dist-^-⊠ g x y = refl
        pf1 A (false , x , y , z , r) = {!!}

        pf2 : ∀ {R} A r → Game 1b {R} A r ≡ ⅁′ (TrA 0b A) r
        pf2 A (true , x , y , z , r)  = {!!}
        pf2 A (false , x , y , z , r) = {!!}

module El-Gamal-Hashed
    (ℤq : ★)
    (_⊠_ : ℤq → ℤq → ℤq)
    (G : ★)
    (g : G)
    (_^_ : G → ℤq → G)
    -- (HKey : ★)
    (|M| : ℕ)
    (ℋ : {-HKey →-} G → Bits |M|) where

    Message = Bits |M|

    ℋ⟨_⟩⊕_ : G → Message → Message
    ℋ⟨ δ ⟩⊕ m = ℋ δ ⊕ m

    open El-Gamal-Generic ℤq _⊠_ G g _^_ Message ℋ⟨_⟩⊕_

    module Proof
      -- (⊠-comm : Commutative _≡_ _⊠_)
      -- (^-lem : ∀ α x y → α ^ (x ⊠ y) ≡ (α ^ x) ^ y)
      (^-comm : ∀ α x y → (α ^ x) ^ y ≡ (α ^ y) ^ x)
      -- (x ∙ x ⁻¹ ≡ 0)
      (ℚ : ★)
      (dist : ℚ → ℚ → ℚ)
      (1/2 : ℚ)
      (_≤_ : ℚ → ℚ → ★)
      (ε-DDH : ℚ)
      where

        Pr[S_] : Bool → ℚ
        Pr[S b ] = {!!}

        -- SS
        -- SS = dist Pr[

        Pr[S₀] = Pr[S 0b ]
        Pr[S₁] = Pr[S 1b ]

        pf1 : Pr[S₁] ≡ 1/2
        pf1 = {!!}

        pf2 : dist Pr[S₀] 1/2 ≡ dist Pr[S₀] Pr[S₁]
        pf2 = {!!}

        pf3 : dist Pr[S₀] Pr[S₁] ≤ ε-DDH
        pf3 = {!!}

        pf4 : dist Pr[S₀] 1/2 ≤ ε-DDH
        pf4 = {!!}

module G11 = G-implem 11 10 (## 2) (## 0) (## 1) (## 0) (## 1)
open G11
module E11 = El-Gamal-Base _ _⊠_ G g _^_ {!!} _∙_
open E11
open Proof {!!}

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

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


Added code related to an Agda's unification question.

Ignore-this: 2627f8de779caf0c7e0a2ec10669323c

darcs-hash:20110805141522-3bd4e-4f91309c869eb37735f00141e803aa0c0a26983f.gz

module Draft.FOTC.Data.List.PostulatesVersusDataTypes where

data U : Set where
  _::_ : U → U → U

data ListU : U → Set where
  cons : ∀ x xs → ListU xs → ListU (x :: xs)

tailU : ∀ {x xs} → ListU (x :: xs) → ListU xs
tailU {x} {xs} (cons .x .xs xsL) = xsL

postulate
  D   : Set
  _∷_ : D → D → D

data List : D → Set where
  cons : ∀ x xs → List xs → List (x ∷ xs)

tail : ∀ {x xs} → List (x ∷ xs) → List xs
tail l = {!!}

error: pathspec 'Draft/FOTC/Data/List/PostulatesVersusDataTypes.agda' did not match any file(s) known to git


Added Asgy example on inequalities.

Added Asgy example on inequalities.

Ignore-this: 1a5138c14a5f7f363798e9cd3583bc16

darcs-hash:20110326142057-3bd4e-b341b9e2ff2ba1b0ac31beaffa922f67cc0f331e.gz

error: pathspec 'src/Agsy/McCarthy91/Arithmetic.agda' did not match any file(s) known to git


module Function.Inverse.NP where

open import Function.Inverse public
open import Function.Equality
open import Relation.Binary
open import Data.Product

_$₁_ : ∀ {f₁ f₂ t₁ t₂}
           {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
         → Inverse From To → Setoid.Carrier From → Setoid.Carrier To
iso $₁ x = Inverse.to iso ⟨$⟩ x

_$₂_ : ∀ {f₁ f₂ t₁ t₂}
           {From : Setoid f₁ f₂} {To : Setoid t₁ t₂}
         → Inverse From To → Setoid.Carrier To → Setoid.Carrier From
iso $₂ x = Inverse.from iso ⟨$⟩ x

_∈_ : ∀  {a₁ a₂}
         {A₁ A₂  : Setoid a₁ a₂}
         (xᵢ     : Setoid.Carrier A₁ × Setoid.Carrier A₂)
         (bij    : Inverse A₁ A₂)
      →  Set a₂
_∈_ {A₂ = A₂} (x₁ , x₂) iso = iso $₁ x₁ ≈ x₂
  where open Setoid A₂

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


open import Algebra
open import Type
open import Data.One
open import Data.Two
open import Data.Nat
open import Data.Sum.NP hiding ([_,_]′)
open import Data.Product.NP
open import Data.List
open import Data.List.Properties
open import HoTT
open import Function.NP
open import Function.Extensionality
open import Relation.Binary.PropositionalEquality.NP

open import Control.Protocol renaming (In to O; Out to J; dualᴵᴼ to O↔J)

module Control.Protocol.GameSemantics where

_∷=_ : ∀ {a}{A : ★_ a}{x y : A}{xs ys} → (x ≡ y) → (xs ≡ ys) → (x ∷ xs) ≡ (y ∷ ys)
_∷=_ e e' = ap₂ _∷_ e e'

data Move s : ★ where
  move : (ms : List (Move (O↔J s))) → Move s

Arena = List ∘ Move

move= : ∀ {s}{xs ys : Arena (O↔J s)} → xs ≡ ys → move xs ≡ move ys
move= = ap move

dualᴹ : ∀ {s} → Move s → Move (O↔J s)
dualᴬ : ∀ {s} → List (Move s) → List (Move (O↔J s))
dualᴹ (move ms) = move (dualᴬ ms)
dualᴬ []        = []
dualᴬ (m ∷ ms)  = dualᴹ m ∷ dualᴬ ms

-- 1-move : ∀ {s} → Move (O↔J s) → Move s
pattern 1-move m = move (m ∷ [])

-- 2-moves : ∀ {s}(a b : Move (O↔J s)) → Move s
pattern 2-moves a b = move (a ∷ b ∷ [])

⊤ᴬ : ∀ {s} → Arena s
⊤ᴬ = []

⊥ᴬ : ∀ {s} → Arena s
⊥ᴬ = move [] ∷ []

2ᴬ : ∀ {s} → Arena s
2ᴬ = move [] ∷ move [] ∷ []

2ᴬ' : ∀ {s} → Arena s
2ᴬ' = move 2ᴬ ∷ []

_×ᴬ_ : ∀ {s} → Arena s → Arena s → Arena s
a ×ᴬ b = a ++ b

_⅋ᴬ_ : ∀ {s} → Arena (O↔J s) → Arena s → Arena s
a ⅋ᴬ []             = []
a ⅋ᴬ (move ms ∷ bs) = move (a ×ᴬ ms) ∷ (a ⅋ᴬ bs)

infixr 4 _→ᴬ_
_→ᴬ_ : ∀ {s} → Arena s → Arena s → Arena s
a →ᴬ b = dualᴬ a ⅋ᴬ b

monoidᴬ : ∀ {s} → Monoid _ _
monoidᴬ {s} = monoid (Move s)
module Monoidᴬ {s} = Monoid (monoidᴬ {s})

Arenaᴰᴰ : ∀ {s} → Arena s ≡ Arena (O↔J (O↔J s))
Arenaᴰᴰ = ap Arena (! dualᴵᴼ-involutive _)

Moveᴰᴰ : ∀ {s} → Move s ≡ Move (O↔J (O↔J s))
Moveᴰᴰ = ap Move (! dualᴵᴼ-involutive _)

dualᴬ-involutive : ∀ {s}(a : Arena s) → dualᴬ (dualᴬ a) ≡ coe Arenaᴰᴰ a
dualᴹ-involutive : ∀ {s}(m : Move s)  → dualᴹ (dualᴹ m) ≡ coe Moveᴰᴰ  m

dualᴬ-involutive {O} [] = refl
dualᴬ-involutive {J} [] = refl
dualᴬ-involutive {O} (m ∷ a) = dualᴹ-involutive m ∷= dualᴬ-involutive a
dualᴬ-involutive {J} (m ∷ a) = dualᴹ-involutive m ∷= dualᴬ-involutive a

dualᴹ-involutive {O} (move ms) = move= (dualᴬ-involutive ms)
dualᴹ-involutive {J} (move ms) = move= (dualᴬ-involutive ms)

¬ᴬ_  : ∀ {s} → Arena s → Arena s
¬¬ᴬ_ : ∀ {s} → Arena s → Arena s

¬ᴬ  a = a →ᴬ ⊥ᴬ
¬¬ᴬ a = ¬ᴬ (¬ᴬ a)

¬-spec : ∀ {s} (a : Arena s) → a →ᴬ ⊥ᴬ ≡ move (dualᴬ a) ∷ []
¬-spec a = move= (snd Monoidᴬ.identity (dualᴬ a)) ∷= refl

¬¬-spec : ∀ {s} (a : Arena s) → (a →ᴬ ⊥ᴬ) →ᴬ ⊥ᴬ ≡ move (move (coe Arenaᴰᴰ a) ∷ []) ∷ []
¬¬-spec a = ¬-spec (a →ᴬ ⊥ᴬ) ∙ move= (move= (ap dualᴬ (snd Monoidᴬ.identity (dualᴬ a)) ∙ dualᴬ-involutive a) ∷= refl) ∷= refl

module Examples where
  a1 : Arena O
  a1 = move ⊥ᴬ ∷ 2-moves (move ⊥ᴬ) (move []) ∷ []

  a2 : Arena O
  a2 = move 2ᴬ ∷ 1-move (move ⊥ᴬ) ∷ []

  a1→a2 : Arena O
  a1→a2 = move (move ⊥ᴬ ∷
                2-moves (move ⊥ᴬ) (move []) ∷
                move [] ∷
                move [] ∷ [])
        ∷ move (move ⊥ᴬ ∷
                2-moves (move ⊥ᴬ) (move []) ∷
                move ⊥ᴬ ∷ []) ∷ []

  a1→a2-ok : a1→a2 ≡ (a1 →ᴬ a2)
  a1→a2-ok = refl

  2ᴬ≡⊥→⊥→⊥ : 2ᴬ' {O} ≡ ⊥ᴬ →ᴬ ⊥ᴬ →ᴬ ⊥ᴬ
  2ᴬ≡⊥→⊥→⊥ = refl

Ty' : ★
{-
data Ty' : ★ where
  `𝟚 : Ty'
  _`→_ : Ty' → Ty' → Ty'
  _`×_ : Ty' → Ty' → Ty'
-}

data Ty : ★ where
  `𝟚 : Ty
  {- _`→_ -}
  _`×_ : Ty → Ty → Ty
  _`→_ : Ty → Ty → Ty

Ty' = Ty

⟦_⟧Ty' : Ty' → ★
{-
⟦ `𝟚     ⟧Ty' = 𝟚
⟦ t `→ u ⟧Ty' = ⟦ t ⟧Ty' → ⟦ u ⟧Ty'
⟦ t `× u ⟧Ty' = ⟦ t ⟧Ty' × ⟦ u ⟧Ty'
-}

⟦_⟧Ty : Ty → ★
⟦ `𝟚     ⟧Ty = 𝟚
⟦ t `→ u ⟧Ty = ⟦ t ⟧Ty → ⟦ u ⟧Ty
⟦ t `× u ⟧Ty = ⟦ t ⟧Ty × ⟦ u ⟧Ty

⟦_⟧Ty' = ⟦_⟧Ty

replicateᴾ-send : ∀ n {A : ★}(f : ℕ → A) → ⟦ replicateᴾ n (send′ A end) ⟧
replicateᴾ-send zero    f = end
replicateᴾ-send (suc n) f = f n , replicateᴾ-send n f

module Steps n where
    P𝟚 = replicateᴾ n (send′ 𝟚 end)

    const-P𝟚 : 𝟚 → ⟦ P𝟚 ⟧
    const-P𝟚 b = replicateᴾ-send n (const b)

    ty'ᴾ : Ty' → Proto
    {-
    ty'ᴾ `𝟚       = P𝟚
    ty'ᴾ (t `→ u) = ty'ᴾ t ⊸ ty'ᴾ u
    ty'ᴾ (t `× u) = ty'ᴾ t ⊗ ty'ᴾ u
    -}

    tyᴾ : Ty → Proto
    tyᴾ `𝟚       = P𝟚
    tyᴾ (t `→ u) = ty'ᴾ t ⊸ tyᴾ u
    tyᴾ (t `× u) = tyᴾ t ⊗ tyᴾ u

    ty'ᴾ t = tyᴾ t

open Steps 1

module SingleRound where
    `_ : ★ → Proto
    ` A = recv′ 𝟙 (send′ A end)

    p-swap : ∀ {A B} → ⟦ (` A ⊗ ` B) ⊸ (` B ⊗ ` A) ⟧
    p-swap (inl 0₁) = inl (inl 0₁) , λ a → inl 0₁ , λ b → b , λ _ → a , end
    p-swap (inr 0₁) = inl (inr 0₁) , λ b → inl 0₁ , λ a → a , λ _ → b , end
                -- OR inl (inl 0₁) , λ a → inl 0₁ , λ b → a , λ _ → b , end

    p-dup : ∀ {A} → ⟦ (` A) ⊸ (` A ⊗ ` A) ⟧
    p-dup (inl 0₁) = inl 0₁ , λ a → a , λ _ → a , end
    p-dup (inr 0₁) = inl 0₁ , λ a → a , λ _ → a , end

    p-ap : ∀ {A B} → ⟦ ((` A ⊸ ` B) ⊗ ` A) ⊸ ` B ⟧
    p-ap 0₁ = inl (inl 0₁) , [inl: (λ _   → inl (inr 0₁) , λ a → inl a , λ b → b , end)
                             ,inr: (λ b _ → inl (inr 0₁) , λ a → inl a , b , end) ]
                             -- ,inr: (λ b _ → inr b , inr 0₁ , λ a → a , end) ]

                             {-
    is-not : ⟦ dual(` 𝟚 ⊸ ` 𝟚) ⅋ ` 𝟚 ⟧
    is-not 0₁ = inl 0₁ , [inl: const (inl 0₂ , [0: 0₂ , end 1: 1₂ , end ])
                         ,inr: [0: const (inr {!!} , {!!})
                                1: const {!!} ] ]
                                -}

module SingleSend where
    `_ : ★ → Proto
    ` A = send′ A end

    p-swap : ∀ {A B} → ⟦ (` A ⊗ ` B) ⊸ (` B ⊗ ` A) ⟧
    p-swap a b = b , a , end

    -- Why what we have is not about linearity!
    p-dup : ∀ {A} → ⟦ (` A) ⊸ (` A ⊗ ` A) ⟧
    p-dup a = a , a , end

    p-ap : ∀ {A B} → ⟦ ((` A ⊸ ` B) ⊗ ` A) ⊸ ` B ⟧
    p-ap a = inl a , λ b → b , end

    p-curry : ∀ {A B C} → ⟦ ((` A ⊗ ` B) ⊸ ` C) ⊸ (` A ⊸ ` B ⊸ ` C) ⟧
    p-curry a b = inl a , inl b , λ c → c , end

    p-arr : ∀ {A B} → (A → B) → ⟦ ` A ⊸ ` B ⟧
    p-arr f a = f a , end

    p-arr' : ∀ {A B C} → (A → B → C) → ⟦ (` A ⊗ ` B) ⊸ ` C ⟧
    p-arr' f a b = f a b , end

    p-arr'' : ∀ {A B C} → (A → B × C) → ⟦ ` A ⊸ (` B ⊗ ` C) ⟧
    p-arr'' f a = fst (f a) , snd (f a) , end

module _ {{_ : FunExt}}{{_ : UA}} where
{-
        opp : ∀ t → ⟦ tyᴾ t ⊥⟧
        opp `𝟚       = _
        opp (t `→ u) = {!!}
        opp (t `× u) = {!!}
-}

        {-
        embed : ∀ t → ⟦ t ⟧Ty → ⟦ tyᴾ t ⟧
        reify : ∀ t → ⟦ tyᴾ t ⟧ → ⟦ t ⟧Ty

        {-
        ⟦ dual (P ⊗ Q) ⅋ R ⟧
        ⟦ dual P ⅋ dual Q ⅋ R ⟧
        ⟦ dual P ⅋ (Q ⊸ R) ⟧
        -}
        embed→ : ∀ t u → (⟦ t ⟧Ty' → ⟦ tyᴾ u ⟧) → ⟦ tyᴾ (t `→ u) ⟧
        embed→ `𝟚        u f = f
        embed→ (t `→ t₁) u f = {!λ g → f (reify (t `→ t₁) g)!}
       --  [[A]⅋B]⅋C = ([[A]]⊗[B])⅋C = (A⊗[B])⅋C
        embed→ (t `× t₁) u f = coe (ap ⟦_⟧ Goal) (embed→ t (t₁ `→ u) (embed→ t₁ u ∘ curry f))
          where open ≡-Reasoning
                Goal = dual (ty'ᴾ t) ⅋ (ty'ᴾ t₁ ⊸ tyᴾ u)
                     ≡⟨ ⅋-assoc (dual (ty'ᴾ t)) _ _ ⟩
                       (dual (ty'ᴾ t) ⅋ dual (ty'ᴾ t₁)) ⅋ tyᴾ u
                     ≡⟨ ! ap (flip _⅋_ (tyᴾ u)) (dual-⊗ (ty'ᴾ t) (ty'ᴾ t₁)) ⟩
                       dual (ty'ᴾ t ⊗ ty'ᴾ t₁) ⅋ tyᴾ u
                     ∎

        embed `𝟚       b       = b , end
        embed (t `→ u) f       = embed→ t u (embed u ∘ f)
        embed (t `× u) (x , y) = ⊗-pair {tyᴾ t} {tyᴾ u} (embed t x) (embed u y)

        reify `𝟚       (b , end) = b
        reify (t `→ u) p = λ x → reify u (⊸-apply {tyᴾ t} {tyᴾ u} p (embed t x))
        reify (t `× u) p = reify t (⊗-fst (tyᴾ t) (tyᴾ u) p) , reify u (⊗-snd (tyᴾ t) (tyᴾ u) p)
        -}
-- -}
-- -}
-- -}
-- -}
-- -}

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


bintree.agda

bintree.agda

module bintree
  ([0,1] : Set)
where

open import Data.Nat
open import Data.Bits

data T : ℕ → Set where
  leaf : ∀ {n} → Bits n → T n
  fork : ∀ {n} (proba : [0,1]) (left right : T n) → T (1 + n)

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


Game/DDH.agda

Game/DDH.agda

open import Type
open import Data.Bits
open import Data.Product

-- Decisional Diffe-Hellman security game
module Game.DDH
  (ℤq  : ★)
  (_⊠_ : ℤq → ℤq → ℤq)
  (G   : ★)
  (g^_ : ℤq → G)
  (Rₐ  : ★) where

-- Decisional Diffe-Hellman smoothing adversary
Adv : ★
Adv = Rₐ → G → G → G → Bit

-- The randomness supply needed for the decisional
-- Diffe-Hellman games
R : ★
R = Rₐ × ℤq × ℤq × ℤq

-- Decisional Diffe-Hellman game:
--   * input: adversary and randomness supply
--   * output b: adversary claims we are in game ⅁ b
Game : ★
Game = Adv → R → Bit

-- The adversary is given correlated inputs
⅁₀ : Game
⅁₀ d (r , x , y , _) = d r (g^ x) (g^ y) (g^ (x ⊠ y))

-- The adversary is given independent inputs
⅁₁ : Game
⅁₁ d (r , x , y , z) = d r (g^ x) (g^ y) (g^ z)

-- Package ⅁₀ and ⅁₁
⅁ : Bit → Game
⅁ = proj (⅁₀ , ⅁₁)

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


3to2.agda

error: RPC failed; HTTP 403 curl 22 The requested URL returned error: 403
fatal: the remote end hung up unexpectedly


Add Language.Simple.Free

Add Language.Simple.Free

{-# OPTIONS --without-K --copatterns #-}
open import Level.NP
open import Function hiding (_$_)
open import Type
open import Algebra
open import Algebra.FunctionProperties
open import Algebra.Structures
open import Data.Nat using (ℕ; zero; suc; _+_; _≤?_)
open import Data.Fin using (Fin; zero; suc)
open import Data.Vec using (Vec; []; _∷_; _++_)
open import Data.One
open import Data.Two
open import Data.Product.NP
open import Relation.Nullary.Decidable
open import Relation.Binary.NP
open import Relation.Binary.PropositionalEquality.NP as ≡ using (_≡_; !_; _≗_; module ≡-Reasoning)
open import Category.Monad.NP
import Language.Simple.Abstract

module Language.Simple.Free where

module _ {Op : ℕ → ★} where

  open Language.Simple.Abstract Op renaming (E to T)

  data Ctx (X : ★) : ★ where
     hole : Ctx X
     op : ∀ {a b} → Op (a + (1 + b)) → Vec (T X) a → Ctx X → Vec (T X) b → Ctx  X

  module _ {X : ★} where
     η : ∀ {X} → X → T X
     η = var

     _·_ : Ctx X → T X → T X
     hole · e = e
     op o ts E us · e = op o (ts ++ E · e ∷ us)

  open WithEvalOp
  open Monad monad public renaming (liftM to map-T)
  module Unused
                 {X R : ★}
                 (⊢_≡_ : T X → T X → ★)
                 (eval-Op  : ∀ {n} → Op n → Vec R n → R)
                 (eval-X : X → R)
                 (t u : T X)
                 (⊢t≡u : ⊢ t ≡ u)
                 where
     ev = eval eval-Op eval-X
     ≈ = ev t ≡ ev u
  module ℛ {X : ★} (⊢_≡_ : T X → T X → ★) where

     {-
     data _≋*_ : ∀ {a} (ts us : Vec (T X) a) → ★
     data _≋_ : (t u : T X) → ★

     data _≋*_ where
       []    : [] ≋* []
       _∷_ : ∀ {t u a} {ts us : Vec _ a}
               → t ≋ u → ts ≋* us → (t ∷ ts) ≋* (u ∷ us)
     data _≋_ where
       η : ∀ {t u} → ⊢ t ≡ u → t ≋ u
       !η : ∀ {t u} → ⊢ t ≡ u → u ≋ t
       var : ∀ x → var x ≋ var x
       op : ∀ {a} (o : Op a) {ts us} → ts ≋* us → op o ts ≋ op o us
     -}

     module Unused2 where

        data Succ (X : ★) : ★ where
           old : X → Succ X
           new : Succ X

        infix 9 _$_

        _$_ : T (Succ X) → T X → T X
        E $ t = E >>= (λ { new → t ; (old x) → var x })

     infix 0 _≈_
     data _≈_   : (t u : T X) → ★ where
        refl    : Reflexive _≈_
        sym     : Symmetric _≈_
        trans   : Transitive _≈_
        η≡      : ∀ {t u} → ⊢ t ≡ u → t ≈ u
        congCtx : ∀ E {t u} → t ≈ u → E · t ≈ E · u

     ≈-isEquivalence : IsEquivalence _≈_
     ≈-isEquivalence = record { refl = refl ; sym = sym ; trans = trans }

module FreeSemigroup where

    U = Semigroup.Carrier
    record _→ₛ_ (X Y : Semigroup ₀ ₀) : ★ where
      open Semigroup X renaming (_∙_ to _∙x_)
      open Semigroup Y renaming (_∙_ to _∙y_)
      field
        to : U X → U Y
        to-∙-cong : ∀ t u → to (t ∙x u) ≡ to t ∙y to u
    open _→ₛ_ public

    idₛ : ∀ {S} → S →ₛ S
    to idₛ = id
    to-∙-cong idₛ _ _ = ≡.refl

    module _ {X Y Z} where
        _∘ₛ_ : (Y →ₛ Z) → (X →ₛ Y) → X →ₛ Z
        to (f ∘ₛ g) = to f ∘ to g
        to-∙-cong (f ∘ₛ g) t u
           = to (f ∘ₛ g) (t ∙x u)
           ≡⟨ ≡.cong (to f) (to-∙-cong g _ _) ⟩
              to f (to g t ∙y to g u)
           ≡⟨ to-∙-cong f _ _ ⟩
              to (f ∘ₛ g) t ∙z to (f ∘ₛ g) u
           ∎
          where
            open ≡-Reasoning
            open Semigroup X renaming (_∙_ to _∙x_)
            open Semigroup Y renaming (_∙_ to _∙y_)
            open Semigroup Z renaming (_∙_ to _∙z_)

    data Op : ℕ → ★ where
       `μ : Op 2
    open Language.Simple.Abstract Op renaming (E to T)
    open Monad monad

    module _ {X : ★} where
        _∙_ : T X → T X → T X
        t ∙ u = op `μ (t ∷ u ∷ [])

    module _ (X : ★) where
        infix 0 ⊢_≡_
        data ⊢_≡_ : T X → T X → ★ where
           ⊢-∙-assoc : ∀ x y z → ⊢ ((x ∙ y) ∙ z) ≡ (x ∙ (y ∙ z))

        open ℛ ⊢_≡_

        ∙-assoc : Associative _≈_ _∙_
        ∙-assoc x y z = η≡ (⊢-∙-assoc x y z)

        open Equivalence-Reasoning ≈-isEquivalence

        ∙-cong : _∙_ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_
        ∙-cong {x} {y} {u} {v} p q =
           x ∙ u
             ≈⟨ congCtx (op `μ (x ∷ []) hole []) q ⟩
           x ∙ v
             ≈⟨ congCtx (op `μ [] hole (v ∷ [])) p ⟩
           y ∙ v ∎

        T-IsSemigroup : IsSemigroup _≈_ _∙_
        T-IsSemigroup = record { isEquivalence = ≈-isEquivalence
                                              ; assoc = ∙-assoc
                                              ; ∙-cong = ∙-cong }

        T-Semigroup : Semigroup ₀ ₀
        T-Semigroup = record { Carrier = T X
                                           ; _≈_ = _≈_
                                           ; _∙_ = _∙_
                                           ; isSemigroup = T-IsSemigroup }

    map-T-∙-hom : ∀ {X Y : ★} (f : X → Y) t u
                           → map-T f (t ∙ u) ≡ map-T f t ∙ map-T f u
    map-T-∙-hom _ _ _ = ≡.refl

    Tₛ = T-Semigroup

    Tₛ-hom : ∀ {X Y} (f : X → Y) → Tₛ X →ₛ Tₛ Y
    to (Tₛ-hom f) = map-T f
    to-∙-cong (Tₛ-hom f) = map-T-∙-hom f

    module WithSemigroup (S : Semigroup ₀ ₀) where
       module S = Semigroup S
       open S renaming (Carrier to S₀; _∙_ to _∙ₛ_)
       eval-Op : ∀ {n} → Op n → Vec S₀ n → S₀
       eval-Op `μ (x ∷ y ∷ []) = x ∙ₛ y
       eval-T : T S₀ → S₀
       eval-T = WithEvalOp.eval eval-Op id

       eval-T-var : ∀ x → eval-T (var x) ≡ x
       eval-T-var x = ≡.refl

       eval-T-∙ : ∀ t u → eval-T (t ∙ u) ≡ eval-T t ∙ₛ eval-T u
       eval-T-∙ t u = ≡.refl

       eval-Tₛ : Tₛ S₀ →ₛ S
       to eval-Tₛ = eval-T
       to-∙-cong eval-Tₛ t u = ≡.refl

    {-
    Tₛ : Sets ⟶ Semigroups
    U : Semigroups ⟶ Sets
    Tₛ ⊣ U
    Semigroups(Tₛ X, Y) ≅ Sets(X, U Y)
    -}
    module _ {X : ★} {Y : Semigroup ₀ ₀} where
        open WithSemigroup Y
        open Semigroup Y renaming (Carrier to Y₀; _∙_ to _∙Y_)

        φ : (Tₛ X →ₛ Y) → X → U Y
        φ f = to f ∘ var
        -- var is the unit (η)

        ψ : (f : X → U Y) → Tₛ X →ₛ Y
        ψ f = eval-Tₛ ∘ₛ Tₛ-hom f
        -- eval-Tₛ is the co-unit (ε)

        φ-ψ : ∀ f → φ (ψ f) ≡ f
        φ-ψ f = ≡.refl

        ψ-φ : ∀ f t → to (ψ (φ f)) t ≡ to f t
        ψ-φ f (var x) = ≡.refl
        ψ-φ f (op `μ (t ∷ u ∷ []))
           = to (ψ (φ f)) (t ∙ u)
           ≡⟨ ≡.refl ⟩
               eval-T (map-T (φ f) (t ∙ u))
           ≡⟨ ≡.refl ⟩
               eval-T (map-T (φ f) t ∙ map-T (φ f) u)
           ≡⟨ ≡.refl ⟩
               eval-T (map-T (φ f) t) ∙Y eval-T (map-T (φ f) u)
           ≡⟨ ≡.refl ⟩
               to (ψ (φ f)) t ∙Y to (ψ (φ f)) u
           ≡⟨ ≡.cong₂ _∙Y_ (ψ-φ f t) (ψ-φ f u) ⟩
               to f t ∙Y to f u
           ≡⟨ ! (to-∙-cong f t u) ⟩
               to f (t ∙ u)
           ∎
           where open ≡-Reasoning

module FreeMonoid where
    data Op : ℕ → ★ where
       `ε : Op 0
       `μ : Op 2
    open Language.Simple.Abstract Op renaming (E to T)
    ε : ∀ {X} → T X
    ε = op `ε []
    _∙_ : ∀ {X} → T X → T X → T X
    t ∙ u = op `μ (t ∷ u ∷ [])

    infix 0 _⊢_≡_
    data _⊢_≡_ (X : ★) : T X → T X → ★ where
       ⊢-ε∙x : ∀ x → X ⊢ ε ∙ x ≡ x
       ⊢-x∙ε : ∀ x → X ⊢ x ∙ ε ≡ x
       ⊢-∙-assoc : ∀ x y z → X ⊢ ((x ∙ y) ∙ z) ≡ (x ∙ (y ∙ z))

    module _ (X : ★) where
        open ℛ (_⊢_≡_ X)

        {- TODO, share the proofs with FreeSemigroup above -}
        ∙-assoc : Associative _≈_ _∙_
        ∙-assoc x y z = η≡ (⊢-∙-assoc x y z)

        open Equivalence-Reasoning ≈-isEquivalence

        ∙-cong : _∙_ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_
        ∙-cong {x} {y} {u} {v} p q =
           x ∙ u
             ≈⟨ congCtx (op `μ (x ∷ []) hole []) q ⟩
           x ∙ v
             ≈⟨ congCtx (op `μ [] hole (v ∷ [])) p ⟩
           y ∙ v ∎

        monoid : Monoid ₀ ₀
        monoid = record { Carrier = T X ; _≈_ = _≈_ ; _∙_ = _∙_ ; ε = ε
                        ; isMonoid = record { isSemigroup = record { isEquivalence = ≈-isEquivalence
                                                                   ; assoc = ∙-assoc
                                                                   ; ∙-cong = ∙-cong }
                                            ; identity = (λ x → η≡ (⊢-ε∙x x))
                                                       , (λ x → η≡ (⊢-x∙ε x)) } }

   {-

   Free monoid as a functor F : Sets → Mon

   map-[]    : map f [] ≡ []
   map-++ : map f xs ++ map f ys = map f (xs ++ ys)

   F X = (List X , [] , _++_)
   F (f : Sets(X , Y))
      : Mon(F X , F Y)
      = (map f , map-[] , map-++)

   -}

module FreeGroup where
    data Op : ℕ → ★ where
       `ε : Op 0
       `i : Op 1
       `μ : Op 2
    open Language.Simple.Abstract Op renaming (E to T)
    ε : ∀ {X} → T X
    ε = op `ε []
    infix 9 −_
    −_ : ∀ {X} → T X → T X
    − t = op `i (t ∷ [])
    infixr 6 _∙_
    _∙_ : ∀ {X} → T X → T X → T X
    t ∙ u = op `μ (t ∷ u ∷ [])

    infix 0 _⊢_≡_
    data _⊢_≡_ (X : ★) : T X → T X → ★ where
       ε∙x : ∀ x → X ⊢ ε ∙ x ≡ x
       x∙ε : ∀ x → X ⊢ x ∙ ε ≡ x
       ∙-assoc : ∀ x y z → X ⊢ (x ∙ (y ∙ z)) ≡ ((x ∙ y) ∙ z)
       −∙-inv : ∀ x → X ⊢ − x ∙ x ≡ ε
       ∙−-inv : ∀ x → X ⊢ x ∙ − x ≡ ε

-- − (− t) ≡ t
-- − t ∙ − (− t) ≡ ε ≡ − t ∙ t

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

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


specify utf-8 encoding in default

specify utf-8 encoding in default

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/'