open import FRP.JS.Nat using ( ℕ ; _*_ )
open import FRP.JS.Bool using ( Bool )
open import FRP.JS.String using ( String )
open import FRP.JS.RSet using ( ⟦_⟧ ; ⟨_⟩ )
open import FRP.JS.Behaviour using ( Beh )
open import FRP.JS.Delay using ( Delay ) renaming
  ( _≟_ to _≟d_ ; _≠_ to _≠d_ ; _≤_ to _≤d_ ; _<_ to _<d_ ; _+_ to _+d_ ; _∸_ to _∸d_ )

module FRP.JS.Time where

open import FRP.JS.Time.Core public using ( Time ; epoch )

_≟_ : Time → Time → Bool
epoch t ≟ epoch u = t ≟d u

{-# COMPILED_JS _≟_ function(d) { return function(e) { return d === e; }; } #-}

_≠_ : Time → Time → Bool
epoch t ≠ epoch u = t ≠d u

{-# COMPILED_JS _≠_ function(d) { return function(e) { return d !== e; }; } #-}

_≤_ : Time → Time → Bool
epoch t ≤ epoch u = t ≤d u

{-# COMPILED_JS _≤_ function(d) { return function(e) { return d <= e; }; } #-}

_<_ : Time → Time → Bool
epoch t < epoch u = t <d u

{-# COMPILED_JS _<_ function(d) { return function(e) { return d < e; }; } #-}

_+_ : Time → Delay → Time
epoch t + d = epoch (t +d d)

{-# COMPILED_JS _+_ function(d) { return function(e) { return d + e; }; } #-}

_∸_ : Time → Time → Delay
epoch t ∸ epoch u = t ∸d u

{-# COMPILED_JS _∸_ function(d) { return function(e) { return Math.min(0, d - e); }; } #-}

postulate
  toUTCString : Time → String
  every : Delay → ⟦ Beh ⟨ Time ⟩ ⟧

{-# COMPILED_JS toUTCString function(t) { return require("agda.frp").date(t).toUTCString(); } #-}
{-# COMPILED_JS every function(d) { return function(t) { return require("agda.frp").every(d); }; } #-}


{-# OPTIONS --safe --without-K #-}

module Literals.Number where

open import Agda.Builtin.FromNat public

open Number ⦃ ... ⦄ public


module StratSigma where

data Sigma0 (A : Set0) (B : A -> Set0) : Set0 where
    _,_ : (x : A) (y : B x) -> Sigma0 A B

_*0_ : (A : Set0)(B : Set0) -> Set0
A *0 B = Sigma0 A \_ -> B

fst0 : {A : Set0}{B : A -> Set0} -> Sigma0 A B -> A
fst0 (a , _) = a

snd0 : {A : Set0}{B : A -> Set0} (p : Sigma0 A B) -> B (fst0 p)
snd0 (a , b) = b

data Zero0 : Set0 where

data Unit0 : Set0 where
    Void : Unit0

data Sigma1 (A : Set1) (B : A -> Set1) : Set1 where
    _,_ : (x : A) (y : B x) -> Sigma1 A B

_*1_ : (A : Set1)(B : Set1) -> Set1
A *1 B = Sigma1 A \_ -> B

fst1 : {A : Set1}{B : A -> Set1} -> Sigma1 A B -> A
fst1 (a , _) = a

snd1 : {A : Set1}{B : A -> Set1} (p : Sigma1 A B) -> B (fst1 p)
snd1 (a , b) = b

data Zero1 : Set1 where

data Unit1 : Set1 where
    Void : Unit1

data Sigma2 (A : Set2) (B : A -> Set2) : Set2 where
    _,_ : (x : A) (y : B x) -> Sigma2 A B

_*2_ : (A : Set2)(B : Set2) -> Set2
A *2 B = Sigma2 A \_ -> B

fst2 : {A : Set2}{B : A -> Set2} -> Sigma2 A B -> A
fst2 (a , _) = a

snd2 : {A : Set2}{B : A -> Set2} (p : Sigma2 A B) -> B (fst2 p)
snd2 (a , b) = b

data Zero2 : Set2 where

data Unit2 : Set2 where
    Void : Unit2

data Sigma3 (A : Set3) (B : A -> Set3) : Set3 where
    _,_ : (x : A) (y : B x) -> Sigma3 A B

_*3_ : (A : Set3)(B : Set3) -> Set3
A *3 B = Sigma3 A \_ -> B

fst3 : {A : Set3}{B : A -> Set3} -> Sigma3 A B -> A
fst3 (a , _) = a

snd3 : {A : Set3}{B : A -> Set3} (p : Sigma3 A B) -> B (fst3 p)
snd3 (a , b) = b

data Zero3 : Set3 where

data Unit3 : Set3 where
    Void : Unit3

data Sigma4 (A : Set4) (B : A -> Set4) : Set4 where
    _,_ : (x : A) (y : B x) -> Sigma4 A B

_*4_ : (A : Set4)(B : Set4) -> Set4
A *4 B = Sigma4 A \_ -> B

fst4 : {A : Set4}{B : A -> Set4} -> Sigma4 A B -> A
fst4 (a , _) = a

snd4 : {A : Set4}{B : A -> Set4} (p : Sigma4 A B) -> B (fst4 p)
snd4 (a , b) = b

data Zero4 : Set4 where

data Unit4 : Set4 where
    Void : Unit4

data Sigma5 (A : Set5) (B : A -> Set5) : Set5 where
    _,_ : (x : A) (y : B x) -> Sigma5 A B

_*5_ : (A : Set5)(B : Set5) -> Set5
A *5 B = Sigma5 A \_ -> B

fst5 : {A : Set5}{B : A -> Set5} -> Sigma5 A B -> A
fst5 (a , _) = a

snd5 : {A : Set5}{B : A -> Set5} (p : Sigma5 A B) -> B (fst5 p)
snd5 (a , b) = b

data Zero5 : Set5 where

data Unit5 : Set5 where
    Void : Unit5

data Sigma6 (A : Set6) (B : A -> Set6) : Set6 where
    _,_ : (x : A) (y : B x) -> Sigma6 A B

_*6_ : (A : Set6)(B : Set6) -> Set6
A *6 B = Sigma6 A \_ -> B

fst6 : {A : Set6}{B : A -> Set6} -> Sigma6 A B -> A
fst6 (a , _) = a

snd6 : {A : Set6}{B : A -> Set6} (p : Sigma6 A B) -> B (fst6 p)
snd6 (a , b) = b

data Zero6 : Set6 where

data Unit6 : Set6 where
    Void : Unit6

data Sigma7 (A : Set7) (B : A -> Set7) : Set7 where
    _,_ : (x : A) (y : B x) -> Sigma7 A B

_*7_ : (A : Set7)(B : Set7) -> Set7
A *7 B = Sigma7 A \_ -> B

fst7 : {A : Set7}{B : A -> Set7} -> Sigma7 A B -> A
fst7 (a , _) = a

snd7 : {A : Set7}{B : A -> Set7} (p : Sigma7 A B) -> B (fst7 p)
snd7 (a , b) = b

data Zero7 : Set7 where

data Unit7 : Set7 where
    Void : Unit7

data Sigma8 (A : Set8) (B : A -> Set8) : Set8 where
    _,_ : (x : A) (y : B x) -> Sigma8 A B

_*8_ : (A : Set8)(B : Set8) -> Set8
A *8 B = Sigma8 A \_ -> B

fst8 : {A : Set8}{B : A -> Set8} -> Sigma8 A B -> A
fst8 (a , _) = a

snd8 : {A : Set8}{B : A -> Set8} (p : Sigma8 A B) -> B (fst8 p)
snd8 (a , b) = b

data Zero8 : Set8 where

data Unit8 : Set8 where
    Void : Unit8

data Sigma9 (A : Set9) (B : A -> Set9) : Set9 where
    _,_ : (x : A) (y : B x) -> Sigma9 A B

_*9_ : (A : Set9)(B : Set9) -> Set9
A *9 B = Sigma9 A \_ -> B

fst9 : {A : Set9}{B : A -> Set9} -> Sigma9 A B -> A
fst9 (a , _) = a

snd9 : {A : Set9}{B : A -> Set9} (p : Sigma9 A B) -> B (fst9 p)
snd9 (a , b) = b

data Zero9 : Set9 where

data Unit9 : Set9 where
    Void : Unit9

data Sigma10 (A : Set10) (B : A -> Set10) : Set10 where
    _,_ : (x : A) (y : B x) -> Sigma10 A B

_*10_ : (A : Set10)(B : Set10) -> Set10
A *10 B = Sigma10 A \_ -> B

fst10 : {A : Set10}{B : A -> Set10} -> Sigma10 A B -> A
fst10 (a , _) = a

snd10 : {A : Set10}{B : A -> Set10} (p : Sigma10 A B) -> B (fst10 p)
snd10 (a , b) = b

data Zero10 : Set10 where

data Unit10 : Set10 where
    Void : Unit10

data Sigma11 (A : Set11) (B : A -> Set11) : Set11 where
    _,_ : (x : A) (y : B x) -> Sigma11 A B

_*11_ : (A : Set11)(B : Set11) -> Set11
A *11 B = Sigma11 A \_ -> B

fst11 : {A : Set11}{B : A -> Set11} -> Sigma11 A B -> A
fst11 (a , _) = a

snd11 : {A : Set11}{B : A -> Set11} (p : Sigma11 A B) -> B (fst11 p)
snd11 (a , b) = b

data Zero11 : Set11 where

data Unit11 : Set11 where
    Void : Unit11

data Sigma12 (A : Set12) (B : A -> Set12) : Set12 where
    _,_ : (x : A) (y : B x) -> Sigma12 A B

_*12_ : (A : Set12)(B : Set12) -> Set12
A *12 B = Sigma12 A \_ -> B

fst12 : {A : Set12}{B : A -> Set12} -> Sigma12 A B -> A
fst12 (a , _) = a

snd12 : {A : Set12}{B : A -> Set12} (p : Sigma12 A B) -> B (fst12 p)
snd12 (a , b) = b

data Zero12 : Set12 where

data Unit12 : Set12 where
    Void : Unit12

data Sigma13 (A : Set13) (B : A -> Set13) : Set13 where
    _,_ : (x : A) (y : B x) -> Sigma13 A B

_*13_ : (A : Set13)(B : Set13) -> Set13
A *13 B = Sigma13 A \_ -> B

fst13 : {A : Set13}{B : A -> Set13} -> Sigma13 A B -> A
fst13 (a , _) = a

snd13 : {A : Set13}{B : A -> Set13} (p : Sigma13 A B) -> B (fst13 p)
snd13 (a , b) = b

data Zero13 : Set13 where

data Unit13 : Set13 where
    Void : Unit13

data Sigma14 (A : Set14) (B : A -> Set14) : Set14 where
    _,_ : (x : A) (y : B x) -> Sigma14 A B

_*14_ : (A : Set14)(B : Set14) -> Set14
A *14 B = Sigma14 A \_ -> B

fst14 : {A : Set14}{B : A -> Set14} -> Sigma14 A B -> A
fst14 (a , _) = a

snd14 : {A : Set14}{B : A -> Set14} (p : Sigma14 A B) -> B (fst14 p)
snd14 (a , b) = b

data Zero14 : Set14 where

data Unit14 : Set14 where
    Void : Unit14

data Sigma15 (A : Set15) (B : A -> Set15) : Set15 where
    _,_ : (x : A) (y : B x) -> Sigma15 A B

_*15_ : (A : Set15)(B : Set15) -> Set15
A *15 B = Sigma15 A \_ -> B

fst15 : {A : Set15}{B : A -> Set15} -> Sigma15 A B -> A
fst15 (a , _) = a

snd15 : {A : Set15}{B : A -> Set15} (p : Sigma15 A B) -> B (fst15 p)
snd15 (a , b) = b

data Zero15 : Set15 where

data Unit15 : Set15 where
    Void : Unit15

data Sigma16 (A : Set16) (B : A -> Set16) : Set16 where
    _,_ : (x : A) (y : B x) -> Sigma16 A B

_*16_ : (A : Set16)(B : Set16) -> Set16
A *16 B = Sigma16 A \_ -> B

fst16 : {A : Set16}{B : A -> Set16} -> Sigma16 A B -> A
fst16 (a , _) = a

snd16 : {A : Set16}{B : A -> Set16} (p : Sigma16 A B) -> B (fst16 p)
snd16 (a , b) = b

data Zero16 : Set16 where

data Unit16 : Set16 where
    Void : Unit16

data Sigma17 (A : Set17) (B : A -> Set17) : Set17 where
    _,_ : (x : A) (y : B x) -> Sigma17 A B

_*17_ : (A : Set17)(B : Set17) -> Set17
A *17 B = Sigma17 A \_ -> B

fst17 : {A : Set17}{B : A -> Set17} -> Sigma17 A B -> A
fst17 (a , _) = a

snd17 : {A : Set17}{B : A -> Set17} (p : Sigma17 A B) -> B (fst17 p)
snd17 (a , b) = b

data Zero17 : Set17 where

data Unit17 : Set17 where
    Void : Unit17

data Sigma18 (A : Set18) (B : A -> Set18) : Set18 where
    _,_ : (x : A) (y : B x) -> Sigma18 A B

_*18_ : (A : Set18)(B : Set18) -> Set18
A *18 B = Sigma18 A \_ -> B

fst18 : {A : Set18}{B : A -> Set18} -> Sigma18 A B -> A
fst18 (a , _) = a

snd18 : {A : Set18}{B : A -> Set18} (p : Sigma18 A B) -> B (fst18 p)
snd18 (a , b) = b

data Zero18 : Set18 where

data Unit18 : Set18 where
    Void : Unit18

data Sigma19 (A : Set19) (B : A -> Set19) : Set19 where
    _,_ : (x : A) (y : B x) -> Sigma19 A B

_*19_ : (A : Set19)(B : Set19) -> Set19
A *19 B = Sigma19 A \_ -> B

fst19 : {A : Set19}{B : A -> Set19} -> Sigma19 A B -> A
fst19 (a , _) = a

snd19 : {A : Set19}{B : A -> Set19} (p : Sigma19 A B) -> B (fst19 p)
snd19 (a , b) = b

data Zero19 : Set19 where

data Unit19 : Set19 where
    Void : Unit19

data Sigma20 (A : Set20) (B : A -> Set20) : Set20 where
    _,_ : (x : A) (y : B x) -> Sigma20 A B

_*20_ : (A : Set20)(B : Set20) -> Set20
A *20 B = Sigma20 A \_ -> B

fst20 : {A : Set20}{B : A -> Set20} -> Sigma20 A B -> A
fst20 (a , _) = a

snd20 : {A : Set20}{B : A -> Set20} (p : Sigma20 A B) -> B (fst20 p)
snd20 (a , b) = b

data Zero20 : Set20 where

data Unit20 : Set20 where
    Void : Unit20

data Sigma21 (A : Set21) (B : A -> Set21) : Set21 where
    _,_ : (x : A) (y : B x) -> Sigma21 A B

_*21_ : (A : Set21)(B : Set21) -> Set21
A *21 B = Sigma21 A \_ -> B

fst21 : {A : Set21}{B : A -> Set21} -> Sigma21 A B -> A
fst21 (a , _) = a

snd21 : {A : Set21}{B : A -> Set21} (p : Sigma21 A B) -> B (fst21 p)
snd21 (a , b) = b

data Zero21 : Set21 where

data Unit21 : Set21 where
    Void : Unit21

data Sigma22 (A : Set22) (B : A -> Set22) : Set22 where
    _,_ : (x : A) (y : B x) -> Sigma22 A B

_*22_ : (A : Set22)(B : Set22) -> Set22
A *22 B = Sigma22 A \_ -> B

fst22 : {A : Set22}{B : A -> Set22} -> Sigma22 A B -> A
fst22 (a , _) = a

snd22 : {A : Set22}{B : A -> Set22} (p : Sigma22 A B) -> B (fst22 p)
snd22 (a , b) = b

data Zero22 : Set22 where

data Unit22 : Set22 where
    Void : Unit22

data Sigma23 (A : Set23) (B : A -> Set23) : Set23 where
    _,_ : (x : A) (y : B x) -> Sigma23 A B

_*23_ : (A : Set23)(B : Set23) -> Set23
A *23 B = Sigma23 A \_ -> B

fst23 : {A : Set23}{B : A -> Set23} -> Sigma23 A B -> A
fst23 (a , _) = a

snd23 : {A : Set23}{B : A -> Set23} (p : Sigma23 A B) -> B (fst23 p)
snd23 (a , b) = b

data Zero23 : Set23 where

data Unit23 : Set23 where
    Void : Unit23

data Sigma24 (A : Set24) (B : A -> Set24) : Set24 where
    _,_ : (x : A) (y : B x) -> Sigma24 A B

_*24_ : (A : Set24)(B : Set24) -> Set24
A *24 B = Sigma24 A \_ -> B

fst24 : {A : Set24}{B : A -> Set24} -> Sigma24 A B -> A
fst24 (a , _) = a

snd24 : {A : Set24}{B : A -> Set24} (p : Sigma24 A B) -> B (fst24 p)
snd24 (a , b) = b

data Zero24 : Set24 where

data Unit24 : Set24 where
    Void : Unit24

data Sigma25 (A : Set25) (B : A -> Set25) : Set25 where
    _,_ : (x : A) (y : B x) -> Sigma25 A B

_*25_ : (A : Set25)(B : Set25) -> Set25
A *25 B = Sigma25 A \_ -> B

fst25 : {A : Set25}{B : A -> Set25} -> Sigma25 A B -> A
fst25 (a , _) = a

snd25 : {A : Set25}{B : A -> Set25} (p : Sigma25 A B) -> B (fst25 p)
snd25 (a , b) = b

data Zero25 : Set25 where

data Unit25 : Set25 where
    Void : Unit25

data Sigma26 (A : Set26) (B : A -> Set26) : Set26 where
    _,_ : (x : A) (y : B x) -> Sigma26 A B

_*26_ : (A : Set26)(B : Set26) -> Set26
A *26 B = Sigma26 A \_ -> B

fst26 : {A : Set26}{B : A -> Set26} -> Sigma26 A B -> A
fst26 (a , _) = a

snd26 : {A : Set26}{B : A -> Set26} (p : Sigma26 A B) -> B (fst26 p)
snd26 (a , b) = b

data Zero26 : Set26 where

data Unit26 : Set26 where
    Void : Unit26

data Sigma27 (A : Set27) (B : A -> Set27) : Set27 where
    _,_ : (x : A) (y : B x) -> Sigma27 A B

_*27_ : (A : Set27)(B : Set27) -> Set27
A *27 B = Sigma27 A \_ -> B

fst27 : {A : Set27}{B : A -> Set27} -> Sigma27 A B -> A
fst27 (a , _) = a

snd27 : {A : Set27}{B : A -> Set27} (p : Sigma27 A B) -> B (fst27 p)
snd27 (a , b) = b

data Zero27 : Set27 where

data Unit27 : Set27 where
    Void : Unit27

data Sigma28 (A : Set28) (B : A -> Set28) : Set28 where
    _,_ : (x : A) (y : B x) -> Sigma28 A B

_*28_ : (A : Set28)(B : Set28) -> Set28
A *28 B = Sigma28 A \_ -> B

fst28 : {A : Set28}{B : A -> Set28} -> Sigma28 A B -> A
fst28 (a , _) = a

snd28 : {A : Set28}{B : A -> Set28} (p : Sigma28 A B) -> B (fst28 p)
snd28 (a , b) = b

data Zero28 : Set28 where

data Unit28 : Set28 where
    Void : Unit28

data Sigma29 (A : Set29) (B : A -> Set29) : Set29 where
    _,_ : (x : A) (y : B x) -> Sigma29 A B

_*29_ : (A : Set29)(B : Set29) -> Set29
A *29 B = Sigma29 A \_ -> B

fst29 : {A : Set29}{B : A -> Set29} -> Sigma29 A B -> A
fst29 (a , _) = a

snd29 : {A : Set29}{B : A -> Set29} (p : Sigma29 A B) -> B (fst29 p)
snd29 (a , b) = b

data Zero29 : Set29 where

data Unit29 : Set29 where
    Void : Unit29

data Sigma30 (A : Set30) (B : A -> Set30) : Set30 where
    _,_ : (x : A) (y : B x) -> Sigma30 A B

_*30_ : (A : Set30)(B : Set30) -> Set30
A *30 B = Sigma30 A \_ -> B

fst30 : {A : Set30}{B : A -> Set30} -> Sigma30 A B -> A
fst30 (a , _) = a

snd30 : {A : Set30}{B : A -> Set30} (p : Sigma30 A B) -> B (fst30 p)
snd30 (a , b) = b

data Zero30 : Set30 where

data Unit30 : Set30 where
    Void : Unit30

data Sigma31 (A : Set31) (B : A -> Set31) : Set31 where
    _,_ : (x : A) (y : B x) -> Sigma31 A B

_*31_ : (A : Set31)(B : Set31) -> Set31
A *31 B = Sigma31 A \_ -> B

fst31 : {A : Set31}{B : A -> Set31} -> Sigma31 A B -> A
fst31 (a , _) = a

snd31 : {A : Set31}{B : A -> Set31} (p : Sigma31 A B) -> B (fst31 p)
snd31 (a , b) = b

data Zero31 : Set31 where

data Unit31 : Set31 where
    Void : Unit31

data Sigma32 (A : Set32) (B : A -> Set32) : Set32 where
    _,_ : (x : A) (y : B x) -> Sigma32 A B

_*32_ : (A : Set32)(B : Set32) -> Set32
A *32 B = Sigma32 A \_ -> B

fst32 : {A : Set32}{B : A -> Set32} -> Sigma32 A B -> A
fst32 (a , _) = a

snd32 : {A : Set32}{B : A -> Set32} (p : Sigma32 A B) -> B (fst32 p)
snd32 (a , b) = b

data Zero32 : Set32 where

data Unit32 : Set32 where
    Void : Unit32

data Sigma33 (A : Set33) (B : A -> Set33) : Set33 where
    _,_ : (x : A) (y : B x) -> Sigma33 A B

_*33_ : (A : Set33)(B : Set33) -> Set33
A *33 B = Sigma33 A \_ -> B

fst33 : {A : Set33}{B : A -> Set33} -> Sigma33 A B -> A
fst33 (a , _) = a

snd33 : {A : Set33}{B : A -> Set33} (p : Sigma33 A B) -> B (fst33 p)
snd33 (a , b) = b

data Zero33 : Set33 where

data Unit33 : Set33 where
    Void : Unit33

data Sigma34 (A : Set34) (B : A -> Set34) : Set34 where
    _,_ : (x : A) (y : B x) -> Sigma34 A B

_*34_ : (A : Set34)(B : Set34) -> Set34
A *34 B = Sigma34 A \_ -> B

fst34 : {A : Set34}{B : A -> Set34} -> Sigma34 A B -> A
fst34 (a , _) = a

snd34 : {A : Set34}{B : A -> Set34} (p : Sigma34 A B) -> B (fst34 p)
snd34 (a , b) = b

data Zero34 : Set34 where

data Unit34 : Set34 where
    Void : Unit34

data Sigma35 (A : Set35) (B : A -> Set35) : Set35 where
    _,_ : (x : A) (y : B x) -> Sigma35 A B

_*35_ : (A : Set35)(B : Set35) -> Set35
A *35 B = Sigma35 A \_ -> B

fst35 : {A : Set35}{B : A -> Set35} -> Sigma35 A B -> A
fst35 (a , _) = a

snd35 : {A : Set35}{B : A -> Set35} (p : Sigma35 A B) -> B (fst35 p)
snd35 (a , b) = b

data Zero35 : Set35 where

data Unit35 : Set35 where
    Void : Unit35

data Sigma36 (A : Set36) (B : A -> Set36) : Set36 where
    _,_ : (x : A) (y : B x) -> Sigma36 A B

_*36_ : (A : Set36)(B : Set36) -> Set36
A *36 B = Sigma36 A \_ -> B

fst36 : {A : Set36}{B : A -> Set36} -> Sigma36 A B -> A
fst36 (a , _) = a

snd36 : {A : Set36}{B : A -> Set36} (p : Sigma36 A B) -> B (fst36 p)
snd36 (a , b) = b

data Zero36 : Set36 where

data Unit36 : Set36 where
    Void : Unit36

data Sigma37 (A : Set37) (B : A -> Set37) : Set37 where
    _,_ : (x : A) (y : B x) -> Sigma37 A B

_*37_ : (A : Set37)(B : Set37) -> Set37
A *37 B = Sigma37 A \_ -> B

fst37 : {A : Set37}{B : A -> Set37} -> Sigma37 A B -> A
fst37 (a , _) = a

snd37 : {A : Set37}{B : A -> Set37} (p : Sigma37 A B) -> B (fst37 p)
snd37 (a , b) = b

data Zero37 : Set37 where

data Unit37 : Set37 where
    Void : Unit37

data Sigma38 (A : Set38) (B : A -> Set38) : Set38 where
    _,_ : (x : A) (y : B x) -> Sigma38 A B

_*38_ : (A : Set38)(B : Set38) -> Set38
A *38 B = Sigma38 A \_ -> B

fst38 : {A : Set38}{B : A -> Set38} -> Sigma38 A B -> A
fst38 (a , _) = a

snd38 : {A : Set38}{B : A -> Set38} (p : Sigma38 A B) -> B (fst38 p)
snd38 (a , b) = b

data Zero38 : Set38 where

data Unit38 : Set38 where
    Void : Unit38

data Sigma39 (A : Set39) (B : A -> Set39) : Set39 where
    _,_ : (x : A) (y : B x) -> Sigma39 A B

_*39_ : (A : Set39)(B : Set39) -> Set39
A *39 B = Sigma39 A \_ -> B

fst39 : {A : Set39}{B : A -> Set39} -> Sigma39 A B -> A
fst39 (a , _) = a

snd39 : {A : Set39}{B : A -> Set39} (p : Sigma39 A B) -> B (fst39 p)
snd39 (a , b) = b

data Zero39 : Set39 where

data Unit39 : Set39 where
    Void : Unit39

data Sigma40 (A : Set40) (B : A -> Set40) : Set40 where
    _,_ : (x : A) (y : B x) -> Sigma40 A B

_*40_ : (A : Set40)(B : Set40) -> Set40
A *40 B = Sigma40 A \_ -> B

fst40 : {A : Set40}{B : A -> Set40} -> Sigma40 A B -> A
fst40 (a , _) = a

snd40 : {A : Set40}{B : A -> Set40} (p : Sigma40 A B) -> B (fst40 p)
snd40 (a , b) = b

data Zero40 : Set40 where

data Unit40 : Set40 where
    Void : Unit40

data Sigma41 (A : Set41) (B : A -> Set41) : Set41 where
    _,_ : (x : A) (y : B x) -> Sigma41 A B

_*41_ : (A : Set41)(B : Set41) -> Set41
A *41 B = Sigma41 A \_ -> B

fst41 : {A : Set41}{B : A -> Set41} -> Sigma41 A B -> A
fst41 (a , _) = a

snd41 : {A : Set41}{B : A -> Set41} (p : Sigma41 A B) -> B (fst41 p)
snd41 (a , b) = b

data Zero41 : Set41 where

data Unit41 : Set41 where
    Void : Unit41

data Sigma42 (A : Set42) (B : A -> Set42) : Set42 where
    _,_ : (x : A) (y : B x) -> Sigma42 A B

_*42_ : (A : Set42)(B : Set42) -> Set42
A *42 B = Sigma42 A \_ -> B

fst42 : {A : Set42}{B : A -> Set42} -> Sigma42 A B -> A
fst42 (a , _) = a

snd42 : {A : Set42}{B : A -> Set42} (p : Sigma42 A B) -> B (fst42 p)
snd42 (a , b) = b

data Zero42 : Set42 where

data Unit42 : Set42 where
    Void : Unit42


module Categories.Support.Experimental where

open import Relation.Binary.PropositionalEquality.TrustMe

open import Categories.Support.PropositionalEquality

≣-relevant : ∀ {l} {A : Set l} {X Y : A} -> .(X ≣ Y) -> X ≣ Y
≣-relevant _ = trustMe

private
  ≣-coe : ∀ {a} {A B : Set a} → (A ≣ B) -> A -> B
  ≣-coe ≣-refl a = a

≣-subst′ : ∀ {a p} {A : Set a} → (P : A -> Set p) -> {x y : A} -> .(x ≣ y) -> P x -> P y
≣-subst′ P eq Px = ≣-coe (≣-relevant (≣-cong P eq)) Px


------------------------------------------------------------------------------
-- Conversion rules for the Collatz function
------------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

module FOT.FOTC.Program.Collatz.ConversionRulesATP where

open import FOT.FOTC.Program.Collatz.CollatzConditionals

open import FOTC.Base
open import FOTC.Data.Nat
open import FOTC.Data.Nat.UnaryNumbers
open import FOTC.Program.Collatz.Data.Nat

------------------------------------------------------------------------------
-- Conversion rules for the Collatz function.
postulate
  collatz-0       : collatz 0' ≡ 1'
  collatz-1       : collatz 1' ≡ 1'
  collatz-even    : ∀ {n} → Even (succ₁ (succ₁ n)) →
                    collatz (succ₁ (succ₁ n)) ≡
                    collatz (div (succ₁ (succ₁ n)) 2')
  collatz-noteven : ∀ {n} → NotEven (succ₁ (succ₁ n)) →
                    collatz (succ₁ (succ₁ n)) ≡
                    collatz (3' * (succ₁ (succ₁ n)) + 1')
{-# ATP prove collatz-0 #-}
{-# ATP prove collatz-1 #-}
{-# ATP prove collatz-even #-}
{-# ATP prove collatz-noteven #-}


module Bootstrap.SimpleInductive where

open import Data.List using (applyUpTo)

open import Prelude

data ConstrData' : Set where
  Self : ConstrData'
  Other : String → ConstrData'

ConstrData = String × List ConstrData'
InductiveData = String × List ConstrData

private
  ℕ⊎Sshow : ℕ ⊎ String → String
  ℕ⊎Sshow (inj₁ x) = show x
  ℕ⊎Sshow (inj₂ y) = y

  ℕ⊎Ssuc : ℕ ⊎ String → ℕ ⊎ String
  ℕ⊎Ssuc (inj₁ x) = inj₁ (suc x)
  ℕ⊎Ssuc (inj₂ y) = inj₂ y

  constrDataToPrefix : (ℕ ⊎ String → String) → ℕ ⊎ String → Char → ConstrData → String
  constrDataToPrefix term n _ (_    , [])         = term n
  constrDataToPrefix term n c (name , x ∷ constr) =
    show c <+> "_ :" <+> (case x of λ { Self → ℕ⊎Sshow n ; (Other y) → y }) <+>
    constrDataToPrefix term (ℕ⊎Ssuc n) c (name , constr)

  constrDataToConstrPrefix : ℕ ⊎ String → Char → ConstrData → String
  constrDataToConstrPrefix = constrDataToPrefix (λ _ → "")

  constrDataToTypeAnn : ℕ ⊎ String → Char → ConstrData → String
  constrDataToTypeAnn = constrDataToPrefix ℕ⊎Sshow

  kthConstr : ℕ → InductiveData → String
  kthConstr k (name , constrs) with lookupMaybe k constrs
  ... | Maybe.just c@(_ , constr) =
    constrDataToConstrPrefix (inj₂ name) 'λ' c <+> -- constructor arguments
    "Λ _ : *" <+>
    unwords (flip mapWithIndex constrs -- abstract arguments
      (λ k constr → "λ _ :" <+> constrDataToTypeAnn (inj₁ k) 'Π' constr)) <+>
    -- apply all abstract arguments to self constructors and leave the others alone
    -- then pass the results to the k-th abstract constructor
    applyTo currentConstr
      (zipWith
        (λ where
          i Self → applyTo
            ("<" + show i <+> show (length constrs) + ">")
            abstractConstrs
          i (Other x) → show i)
        (applyUpTo ((length constrs + length constr) ∸_) $ length constr) constr)
    where
      currentConstr = show (length constrs ∸ k ∸ 1)

      abstractConstrs : List String
      abstractConstrs = reverse $ applyUpTo show $ length constrs

      applyTo : String → List String → String
      applyTo f fs = foldl (λ s l → "[" + s <+> l + "]") f fs
  kthConstr k constrs | nothing = "Error: no such constructor"

  kthConstrType : String → ℕ → List ConstrData → String
  kthConstrType name k constrs with lookupMaybe k constrs
  ... | just x = constrDataToTypeAnn (inj₂ name) 'Π' x
  ... | nothing = "Error: no such constructor"

  typeDecl : String → List ConstrData → String
  typeDecl name constrs =
    "∀ _ : *" <+>
    unwords (flip mapWithIndex constrs (λ k constr →
      "Π _ :" <+> constrDataToTypeAnn (inj₁ k) 'Π' constr)) <+>
    show (length constrs)

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

simpleInductive : InductiveData → String
simpleInductive d@(name , constrs) =
  "let" <+> name <+> ":=" <+> typeDecl name constrs + "." +
  unwords (flip mapWithIndex constrs
    (λ k constr →
      "let" <+> proj₁ constr <+> ":=" <+> kthConstr k d <+> ":" <+>
      kthConstrType name k constrs + "."))


open import Everything

module Test.Test4
  {𝔵} {𝔛 : Ø 𝔵}
  {𝔞} {𝔒₁ : 𝔛 → Ø 𝔞}
  {𝔟} {𝔒₂ : 𝔛 → Ø 𝔟}
  {ℓ : Ł}
  ⦃ _ : Transitivity.class (Arrow 𝔒₁ 𝔒₂) ⦄
  -- ⦃ _ : [𝓢urjectivity] (Arrow 𝔒₁ 𝔒₂) (Extension $ ArrowṖroperty ℓ 𝔒₁ 𝔒₂) ⦄
  where
  test[∙] : ∀ {x y} → ArrowṖroperty ℓ 𝔒₁ 𝔒₂ x → Arrow 𝔒₁ 𝔒₂ x y → ArrowṖroperty ℓ 𝔒₁ 𝔒₂ y
  test[∙] P f .π₀ g = (f ◃ P) .π₀ g


open import Data.Product using ( _×_ ; _,_ ; swap )
open import Relation.Nullary using ( ¬_ )
open import Web.Semantic.DL.ABox using ( ABox ; ε ; _,_ ; _∼_ ; _∈₁_ ; _∈₂_ )
open import Web.Semantic.DL.ABox.Model using ( _⊨a_ )
open import Web.Semantic.DL.Concept using
  ( Concept ; ⟨_⟩ ; ¬⟨_⟩ ; ⊤ ; ⊥ ; _⊔_ ; _⊓_ ; ∀[_]_ ; ∃⟨_⟩_ ; ≤1 ; >1 ; neg )
open import Web.Semantic.DL.KB using ( KB ; tbox ; abox )
open import Web.Semantic.DL.KB.Model using ( _⊨_ )
open import Web.Semantic.DL.Role using ( Role ; ⟨_⟩ ; ⟨_⟩⁻¹ )
open import Web.Semantic.DL.Signature using ( Signature )
open import Web.Semantic.DL.TBox using
  ( TBox ; ε ; _,_ ; _⊑₁_ ; _⊑₂_ ; Dis ; Ref ; Irr ; Tra )

module Web.Semantic.DL.Integrity.Closed.Alternate
  {Σ : Signature} {X : Set} where

-- An alternate definition of closed-world integrity.

infixr 4 _,_
infix 2 _⊫_∈₂_ _⊫_∈₁_ _⊫a_ _⊫t_

data _⊫_∼_ (K : KB Σ X) (x y : X) : Set₁ where
  eq : (∀ I → (I ⊨ K) → (I ⊨a x ∼ y)) → (K ⊫ x ∼ y)

data _⊫_∈₂_ (K : KB Σ X) (xy : X × X) : Role Σ → Set₁ where
  rel : ∀ {r} → (∀ I → (I ⊨ K) → (I ⊨a xy ∈₂ r)) → (K ⊫ xy ∈₂ ⟨ r ⟩)
  rev : ∀ {r} → (∀ I → (I ⊨ K) → (I ⊨a swap xy ∈₂ r)) → (K ⊫ xy ∈₂ ⟨ r ⟩⁻¹)

data _⊫_∈₁_ (K : KB Σ X) (x : X) : Concept Σ → Set₁ where
  +atom : ∀ {c} → (∀ I → (I ⊨ K) → (I ⊨a x ∈₁ c)) → (K ⊫ x ∈₁ ⟨ c ⟩)
  -atom : ∀ {c} → ¬(∀ I → (I ⊨ K) → (I ⊨a x ∈₁ c)) → (K ⊫ x ∈₁ ¬⟨ c ⟩)
  top : (K ⊫ x ∈₁ ⊤)
  inj₁ : ∀ {C D} → (K ⊫ x ∈₁ C) → (K ⊫ x ∈₁ C ⊔ D)
  inj₂ : ∀ {C D} → (K ⊫ x ∈₁ D) → (K ⊫ x ∈₁ C ⊔ D)
  _,_ : ∀ {C D} → (K ⊫ x ∈₁ C) → (K ⊫ x ∈₁ D) → (K ⊫ x ∈₁ C ⊓ D)
  all : ∀ {R C} → (∀ y → (K ⊫ (x , y) ∈₂ R) → (K ⊫ y ∈₁ C)) → (K ⊫ x ∈₁ ∀[ R ] C)
  ex : ∀ {R C} y → (K ⊫ (x , y) ∈₂ R) → (K ⊫ y ∈₁ C) → (K ⊫ x ∈₁ ∃⟨ R ⟩ C)
  uniq : ∀ {R} → (∀ y z → (K ⊫ (x , y) ∈₂ R) → (K ⊫ (x , z) ∈₂ R) → (K ⊫ y ∼ z)) → (K ⊫ x ∈₁ ≤1 R)
  ¬uniq : ∀ {R} y z → (K ⊫ (x , y) ∈₂ R) → (K ⊫ (x , z) ∈₂ R) → ¬(K ⊫ y ∼ z) → (K ⊫ x ∈₁ >1 R)

data _⊫a_ (K : KB Σ X) : ABox Σ X → Set₁ where
  ε : (K ⊫a ε)
  _,_ : ∀ {A B} → (K ⊫a A) → (K ⊫a B) → (K ⊫a A , B)
  eq : ∀ x y → (K ⊫ x ∼ y) → (K ⊫a x ∼ y)
  rl : ∀ xy r → (K ⊫ xy ∈₂ ⟨ r ⟩) → (K ⊫a xy ∈₂ r)
  cn : ∀ x c → (K ⊫ x ∈₁ ⟨ c ⟩) → (K ⊫a x ∈₁ c)

data _⊫t_ (K : KB Σ X) : TBox Σ → Set₁ where
  ε : (K ⊫t ε)
  _,_ : ∀ {T U} → (K ⊫t T) → (K ⊫t U) → (K ⊫t T , U)
  rl : ∀ Q R → (∀ xy → (K ⊫ xy ∈₂ Q) → (K ⊫ xy ∈₂ R)) → (K ⊫t Q ⊑₂ R)
  cn : ∀ C D → (∀ x → (K ⊫ x ∈₁ neg C ⊔ D)) → (K ⊫t C ⊑₁ D)
  dis : ∀ Q R → (∀ xy → (K ⊫ xy ∈₂ Q) → ¬(K ⊫ xy ∈₂ R)) → (K ⊫t Dis Q R)
  ref : ∀ R → (∀ x → (K ⊫ (x , x) ∈₂ R)) → (K ⊫t Ref R)
  irr : ∀ R → (∀ x → ¬(K ⊫ (x , x) ∈₂ R)) → (K ⊫t Irr R)
  tra : ∀ R → (∀ x y z → (K ⊫ (x , y) ∈₂ R) → (K ⊫ (y , z) ∈₂ R) → (K ⊫ (x , z) ∈₂ R)) → (K ⊫t Tra R)

data _⊫k_ (K L : KB Σ X) : Set₁ where
  _,_ : (K ⊫t tbox L) → (K ⊫a abox L) → (K ⊫k L)


open import Agda.Builtin.Equality
open import Agda.Builtin.Nat

data ⊤ : Set where
  tt : ⊤

foo : Nat → ⊤ → ⊤
foo 0 tt = tt
foo (suc n) tt = foo n tt -- NB tail-recursive

test : foo 100000 tt ≡ tt
test = refl -- memory blows up here


{-# OPTIONS --safe --no-guardedness #-}

record Stream (A : Set) : Set where
  coinductive
  field
    head : A
    tail : Stream A

open Stream

repeat : ∀ {A} → A → Stream A
repeat x .head = x
repeat x .tail = repeat x


module Dave.Functions where

    _∘_ : ∀ {A B C : Set} → (B → C) → (A → B) → (A → C)
    (g ∘ f) a = g (f a)

    _∘´_ : ∀ {A B C : Set} → (B → C) → (A → B) → (A → C)
    (g ∘´ f) = λ x → g (f x)


------------------------------------------------------------------------
-- The two definitions of substitutions are isomorphic (assuming
-- extensionality)
------------------------------------------------------------------------

open import Data.Universe.Indexed

module deBruijn.Substitution.Isomorphic
  {i u e} {Uni : IndexedUniverse i u e} where

import Axiom.Extensionality.Propositional as E
import deBruijn.Context; open deBruijn.Context Uni
open import deBruijn.Substitution.Data.Basics as D using (ε; _▻_; [_])
open import deBruijn.Substitution.Function.Basics as F
  using (ε⇨; _▻⇨_) renaming (_▻⇨[_]_ to _▻⇨[_]F_)
open import Function using (_$_)
open import Function.Inverse using (Inverse)
open import Level using (_⊔_)
import Relation.Binary.PropositionalEquality as P

open P.≡-Reasoning

isomorphic :
  ∀ {t} {T : Term-like t} →
  E.Extensionality (i ⊔ u ⊔ e) (i ⊔ u ⊔ e ⊔ t) →
  ∀ {Γ Δ} {ρ̂ : Γ ⇨̂ Δ} →
  Inverse ([ Var ⟶ T ]-setoid ρ̂) (P.setoid $ D.Sub T ρ̂)
isomorphic {T = T} ext = record
  { to         = record { _⟨$⟩_ = to _
                        ; cong  = λ ρ₁≅ρ₂ → D.≅-⇨-⇒-≡ $ to-cong ρ₁≅ρ₂
                        }
  ; from       = P.→-to-⟶ from
  ; inverse-of = record
    { left-inverse-of  = from∘to _
    ; right-inverse-of = λ ρ → D.≅-⇨-⇒-≡ $ to∘from ρ
    }
  }
  where
  to : ∀ Γ {Δ} {ρ̂ : Γ ⇨̂ Δ} → F.Sub T ρ̂ → D.Sub T ρ̂
  to ε               ρ = ε
  to (Γ ▻ σ) {ρ̂ = ρ̂} ρ =
    P.subst (λ v → D.Sub T (t̂ail ρ̂ ▻̂ v))
            (≅-Value-⇒-≡ $ P.sym $ F.head-lemma ρ)
            (to Γ (F.tail ρ) ▻ F.head ρ)

  from : ∀ {Γ Δ} {ρ̂ : Γ ⇨̂ Δ} → D.Sub T ρ̂ → F.Sub T ρ̂
  from ε       = ε⇨
  from (ρ ▻ t) = from ρ ▻⇨ t

  to-▻ : ∀ {Γ Δ σ} {ρ̂ : Γ ▻ σ ⇨̂ Δ} (ρ : F.Sub T ρ̂) →
         D._≅-⇨_ (to (Γ ▻ σ) ρ) (to Γ (F.tail ρ) ▻ F.head ρ)
  to-▻ {ρ̂ = ρ̂} ρ =
    D.drop-subst-Sub (λ v → t̂ail ρ̂ ▻̂ v)
                     (≅-Value-⇒-≡ $ P.sym $ F.head-lemma ρ)

  abstract

    to-cong : ∀ {Γ₁ Δ₁} {ρ̂₁ : Γ₁ ⇨̂ Δ₁} {ρ₁ : F.Sub T ρ̂₁}
                {Γ₂ Δ₂} {ρ̂₂ : Γ₂ ⇨̂ Δ₂} {ρ₂ : F.Sub T ρ̂₂} →
              F._≅-⇨_ ρ₁ ρ₂ → D._≅-⇨_ (to Γ₁ ρ₁) (to Γ₂ ρ₂)
    to-cong {Γ₁ = ε}     {ρ₁ = _ , _} {ρ₂ = ._ , _}     [ P.refl ] = P.refl
    to-cong {Γ₁ = Γ ▻ σ} {ρ₁ = ρ₁}    {ρ₂ = ._ , corr₂} [ P.refl ] =
      let ρ₂ = [_⟶_].function ρ₁ , corr₂ in begin
       [ to (Γ ▻ σ) ρ₁                ]  ≡⟨ to-▻ ρ₁ ⟩
       [ to Γ (F.tail ρ₁) ▻ F.head ρ₁ ]  ≡⟨ D.▻⇨-cong P.refl (to-cong [ P.refl ]) P.refl ⟩
       [ to Γ (F.tail ρ₂) ▻ F.head ρ₂ ]  ≡⟨ P.sym $ to-▻ ρ₂ ⟩
       [ to (Γ ▻ σ) ρ₂                ]  ∎

  from-cong : ∀ {Γ₁ Δ₁} {ρ̂₁ : Γ₁ ⇨̂ Δ₁} {ρ₁ : D.Sub T ρ̂₁}
                {Γ₂ Δ₂} {ρ̂₂ : Γ₂ ⇨̂ Δ₂} {ρ₂ : D.Sub T ρ̂₂} →
              D._≅-⇨_ ρ₁ ρ₂ → F._≅-⇨_ (from ρ₁) (from ρ₂)
  from-cong P.refl = [ P.refl ]

  abstract

    from∘to : ∀ Γ {Δ} {ρ̂ : Γ ⇨̂ Δ} (ρ : F.Sub T ρ̂) →
              F._≅-⇨_ (from (to Γ ρ)) ρ
    from∘to ε ρ =
      ε⇨  ≅-⟶⟨ sym-⟶ $ F.ηε ext ρ ⟩
      ρ   ∎-⟶
    from∘to (Γ ▻ σ) {ρ̂ = ρ̂} ρ =
      from (to (Γ ▻ σ) ρ)                 ≅-⟶⟨ from-cong $ to-▻ ρ ⟩
      from (to Γ (F.tail ρ) ▻ F.head ρ)   ≅-⟶⟨ _ ∎-⟶ ⟩
      from (to Γ (F.tail ρ)) ▻⇨ F.head ρ  ≅-⟶⟨ F.▻⇨-cong P.refl (from∘to Γ (F.tail ρ)) P.refl ⟩
      F.tail ρ ▻⇨ F.head ρ                ≅-⟶⟨ sym-⟶ $ F.η▻ ext ρ ⟩
      ρ                                   ∎-⟶

    to∘from : ∀ {Γ Δ} {ρ̂ : Γ ⇨̂ Δ} (ρ : D.Sub T ρ̂) →
              D._≅-⇨_ (to Γ (from ρ)) ρ
    to∘from ε                 = P.refl
    to∘from (_▻_ {σ = σ} ρ t) = begin
      [ to (_ ▻ _) (from ρ ▻⇨ t)            ]  ≡⟨ to-▻ (from ρ ▻⇨ t) ⟩
      [ to _ (F.tail (from ρ ▻⇨[ σ ]F t)) ▻
        F.head (from ρ ▻⇨[ σ ]F t)          ]  ≡⟨ D.▻⇨-cong P.refl (to-cong [ P.refl ]) P.refl ⟩
      [ to _ (from ρ) ▻ t                   ]  ≡⟨ D.▻⇨-cong P.refl (to∘from ρ) P.refl ⟩
      [ ρ ▻ t                               ]  ∎


---------------------------------------
-- Pairs of sets
---------------------------------------

{-# OPTIONS --allow-unsolved-meta #-}

module sv20.assign2.SetTheory.Pairs where

-- Everything involving pairs, be them unordered
-- or ordered pairs. Also the definition of power set
-- and cartesian product between sets.

open import sv20.assign2.SetTheory.Logic
open import sv20.assign2.SetTheory.Algebra
open import sv20.assign2.SetTheory.Subset
open import sv20.assign2.SetTheory.ZAxioms

-- Pairs, justified by the pair axiom

_ₚ_ : 𝓢 → 𝓢 → 𝓢
x ₚ y = proj₁ (pair x y)

pair-d : (x y : 𝓢) → ∀ {z} → z ∈ x ₚ y ⇔ (z ≡ x ∨ z ≡ y)
pair-d x y = proj₂ _ (pair x y)

-- Both ∧-projections
pair-d₁ : (x y : 𝓢) → ∀ {z} → z ∈ x ₚ y → (z ≡ x ∨ z ≡ y)
pair-d₁ x y = ∧-proj₁ (pair-d x y)

pair-d₂ : (x y : 𝓢) → ∀ {z} → (z ≡ x ∨ z ≡ y) → z ∈ x ₚ y
pair-d₂ x y = ∧-proj₂ (pair-d x y)

pair-p₁ : (x y : 𝓢) → x ₚ y ≡ y ₚ x
pair-p₁ x y = equalitySubset (x ₚ y) (y ₚ x) (p₁ , p₂)
  where
  p₁ : (z : 𝓢) → z ∈ x ₚ y → z ∈ y ₚ x
  p₁ z z∈x,y = pair-d₂ y x (∨-sym _ _ (pair-d₁ x y z∈x,y))

  p₂ : (z : 𝓢) → z ∈ y ₚ x → z ∈ x ₚ y
  p₂ z z∈y,x = pair-d₂ x y (∨-sym _ _ (pair-d₁ y x z∈y,x))

singleton : 𝓢 → 𝓢
singleton x = x ₚ x

singletonp : (x : 𝓢) → ∀ {z} → z ∈ singleton x → z ≡ x
singletonp x x₁ = ∨-idem _ (pair-d₁ x x x₁)

singletonp₂ : (x : 𝓢) → x ∈ singleton x
singletonp₂ x = pair-d₂ x x (inj₁ refl)

singletonp₃ : (x : 𝓢) → ∀ {y} → x ≡ y → x ∈ singleton y
singletonp₃ x x≡y = pair-d₂ _ _ (inj₁ x≡y)

singletonp₄ : (x y : 𝓢) → x ∈ singleton y → x ∩ singleton y ≡ ∅
singletonp₄ x y h = {!!}
  where
  p₁ : x ≡ y
  p₁ = singletonp _ h

  p₂ : x ∩ singleton x ≡ ∅
  p₂ = {!!}

pair-prop-helper₁ : {a b c : 𝓢} → a ≡ b ∨ a ≡ c → a ≢ b → a ≡ c
pair-prop-helper₁ (inj₁ a≡b) h = ⊥-elim (h a≡b)
pair-prop-helper₁ (inj₂ refl) _ = refl

pair-prop-helper₂ : {a b : 𝓢} → a ≢ b → b ≢ a
pair-prop-helper₂ h b≡a = h (sym _ _ b≡a)

-- Theorem 44, p. 31 (Suppes, 1972).
pair-prop : (x y u v : 𝓢) → x ₚ y ≡ u ₚ v → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
pair-prop x y u v eq = ∨-e _ _ _ (pem (x ≡ y)) h-x≡y h-x≢y
  where
  u∈u,v : u ∈ (u ₚ v)
  u∈u,v = ∨-prop₁ (pair-d₂ u v) refl

  u∈x,y : u ∈ (x ₚ y)
  u∈x,y = memberEq u (u ₚ v) (x ₚ y) (u∈u,v , (sym _ _ eq))

  disj₁ : u ≡ x ∨ u ≡ y
  disj₁ = pair-d₁ _ _ u∈x,y

  v∈u,v : v ∈ (u ₚ v)
  v∈u,v = ∨-prop₂ (pair-d₂ u v) refl

  v∈x,y : v ∈ (x ₚ y)
  v∈x,y = memberEq v (u ₚ v) (x ₚ y) (v∈u,v , (sym _ _ eq))

  disj₂ : v ≡ x ∨ v ≡ y
  disj₂ = pair-d₁ _ _ v∈x,y

  x∈x,y : x ∈ (x ₚ y)
  x∈x,y = ∨-prop₁ (pair-d₂ x y) refl

  x∈u,v : x ∈ (u ₚ v)
  x∈u,v = memberEq x (x ₚ y) (u ₚ v) (x∈x,y , eq)

  disj₃ : x ≡ u ∨ x ≡ v
  disj₃ = pair-d₁ _ _ x∈u,v

  y∈x,y : y ∈ (x ₚ y)
  y∈x,y = ∨-prop₂ (pair-d₂ x y) refl

  y∈u,v : y ∈ (u ₚ v)
  y∈u,v = memberEq y (x ₚ y) (u ₚ v) (y∈x,y , eq)

  disj₄ : y ≡ u ∨ y ≡ v
  disj₄ = pair-d₁ _ _ y∈u,v

  h-x≡y : x ≡ y → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
  h-x≡y eq₂ = inj₁ (x≡u , v≡y)
    where
    x≡u : u ≡ x
    x≡u = ∨-idem _ disj-aux
      where
      disj-aux : u ≡ x ∨ u ≡ x
      disj-aux = subs _ (sym _ _ eq₂) disj₁

    v≡y : v ≡ y
    v≡y = ∨-idem _ disj-aux
      where
      disj-aux : v ≡ y ∨ v ≡ y
      disj-aux = subs _ eq₂ disj₂

  h-x≢y : x ≢ y → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
  h-x≢y ¬eq = ∨-e _ _ _ (pem (x ≡ u)) h₁ h₂
    where
    h₁ : x ≡ u → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
    h₁ x≡u = ∨-e _ _ _ (pem (y ≡ u)) h₁₁ h₁₂
      where
      h₁₁ : y ≡ u → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
      h₁₁ y≡u = ⊥-elim (¬eq (trans x≡u (sym _ _ y≡u)))

      h₁₂ : y ≢ u → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
      h₁₂ h = inj₁ (sym _ _ x≡u , sym _ _ (pair-prop-helper₁ disj₄ h))

    h₂ : x ≢ u → (u ≡ x ∧ v ≡ y) ∨ (v ≡ x ∧ u ≡ y)
    h₂ h = inj₂ (sym _ _ (pair-prop-helper₁ disj₃ h)
                ,
                (pair-prop-helper₁ disj₁ (pair-prop-helper₂ h)))

-- Theorem 45, p. 32 (Suppes 1960).
singleton-eq : (x y : 𝓢) → singleton x ≡ singleton y → x ≡ y
singleton-eq x y eq = sym _ _ (∧-proj₁ (∨-idem _ aux))
  where
  aux : ((y ≡ x) ∧ (y ≡ x)) ∨ ((y ≡ x) ∧ (y ≡ x))
  aux = pair-prop x x y y eq

singleton-⊆ : (x A : 𝓢) → x ∈ A → singleton x ⊆ A
singleton-⊆ x A x∈A t t∈xₛ = subs _ (sym _ _ (singletonp _ t∈xₛ)) x∈A

prop-p₂ : (y z : 𝓢) → y ₚ z ≡ singleton y ∪ singleton z
prop-p₂ y z = equalitySubset _ _ (p₁ , p₂)
  where
  p₁ : (x : 𝓢) → x ∈ y ₚ z → x ∈ singleton y ∪ singleton z
  p₁ _ h = ∪-d₂ _ _ (∨-prop₅ (pair-d₁ _ _ h) (singletonp₃ _) (singletonp₃ _))

  p₂ : (x : 𝓢) → x ∈ singleton y ∪ singleton z → x ∈ y ₚ z
  p₂ x h = pair-d₂ _ _ (∨-prop₅ (∪-d₁ _ _ h) (singletonp _) (singletonp _))

-- Ordered pairs

_ₒ_ : 𝓢 → 𝓢 → 𝓢
x ₒ y = singleton x ₚ (x ₚ y)

-- Just an abvreviation for next theorem
abv₁ : 𝓢 → 𝓢 → 𝓢 → 𝓢 → Set
abv₁ u x v y = (u ₚ u ≡ x ₚ x ∧ u ₚ v ≡ x ₚ y) ∨ (u ₚ v ≡ x ₚ x ∧ u ₚ u ≡ x ₚ y)

-- Theorem 46, p. 32 (Suppes).
ord-p : (x y u v : 𝓢) → x ₒ y ≡ u ₒ v → x ≡ u ∧ y ≡ v
ord-p x y u v eq = ∨-e _ _ _ aux a→c b→c
  where
  aux : (singleton u ≡ singleton x ∧ (u ₚ v) ≡ (x ₚ y)) ∨
          ((u ₚ v) ≡ singleton x ∧ singleton u ≡ (x ₚ y))
  aux = pair-prop _ _ _ _ eq

  a→c : singleton u ≡ singleton x ∧ u ₚ v ≡ x ₚ y → x ≡ u ∧ y ≡ v
  a→c (eqₚ , eqₛ) = x≡u , y≡v
    where
    x≡u : x ≡ u
    x≡u = singleton-eq _ _ (sym _ _ eqₚ)

    p₁ : (x ≡ u ∧ y ≡ v) ∨ (y ≡ u ∧ x ≡ v)
    p₁ = pair-prop _ _ _ _ eqₛ

    p₂ : x ≡ u ∧ y ≡ v → y ≡ v
    p₂ (h₁ , h₂) = h₂

    p₃ : y ≡ u ∧ x ≡ v → y ≡ v
    p₃ (h₁ , h₂) = subs (λ w → w ≡ v) x≡y h₂
      where
      x≡y : x ≡ y
      x≡y = subs (λ w → x ≡ w) (sym y u h₁) x≡u

    y≡v : y ≡ v
    y≡v = ∨-e _ _ _ p₁ p₂ p₃
  b→c : u ₚ v ≡ singleton x ∧ singleton u ≡ x ₚ y → x ≡ u ∧ y ≡ v
  b→c (h₁ , h₂) = p₃ , subs (λ w → w ≡ v) p₈ p₄
    where
    p₁ : (x ≡ u ∧ x ≡ v) ∨ (x ≡ u ∧ x ≡ v)
    p₁ = pair-prop _ _ _ _ h₁

    p₂ : x ≡ u ∧ x ≡ v
    p₂ = ∨-idem _ p₁

    p₃ : x ≡ u
    p₃ = ∧-proj₁ p₂

    p₄ : x ≡ v
    p₄ = ∧-proj₂ p₂

    p₅ : (x ≡ u ∧ y ≡ u) ∨ (y ≡ u ∧ x ≡ u)
    p₅ = pair-prop _ _ _ _ h₂

    p₆ : x ≡ u ∧ y ≡ u
    p₆ = ∨-∧ p₅

    p₇ : y ≡ u
    p₇ = ∧-proj₂ p₆

    p₈ : x ≡ y
    p₈ = subs (λ w → w ≡ y) (sym _ _ p₃) (sym _ _ p₇)

-- Power sets

𝓟_ : 𝓢 → 𝓢
𝓟 x = proj₁ (pow x)

-- Theorem 86, p. 47 (Suppes 1960)
𝓟-d : (x : 𝓢) → ∀ {z} → z ∈ (𝓟 x) ⇔ z ⊆ x
𝓟-d x = proj₂ _ (pow x)

-- Both projections.
𝓟-d₁ : (x : 𝓢) → ∀ {z} → z ∈ (𝓟 x) → z ⊆ x
𝓟-d₁ _ = ∧-proj₁ (𝓟-d _)

𝓟-d₂ : (x : 𝓢) → ∀ {z} → z ⊆ x → z ∈ (𝓟 x)
𝓟-d₂ _ = ∧-proj₂ (𝓟-d _)

-- Theorem 87, p. 47 (Suppes 1960).
A∈𝓟A : (A : 𝓢) → A ∈ 𝓟 A
A∈𝓟A A = 𝓟-d₂ A subsetOfItself

-- Theorem 91, p. 48 (Suppes 1960).
⊆𝓟 : (A B : 𝓢) → A ⊆ B ⇔ 𝓟 A ⊆ 𝓟 B
⊆𝓟 A B = iₗ , iᵣ
  where
  iₗ : A ⊆ B → 𝓟 A ⊆ 𝓟 B
  iₗ A⊆B t t∈𝓟A = 𝓟-d₂ _ t⊆B
    where
     t⊆A : t ⊆ A
     t⊆A = 𝓟-d₁ A t∈𝓟A

     t⊆B : t ⊆ B
     t⊆B = trans-⊆ _ _ _ (t⊆A , A⊆B)
  iᵣ : 𝓟 A ⊆ 𝓟 B → A ⊆ B
  iᵣ 𝓟A⊆𝓟B t t∈A = 𝓟-d₁ _ A∈𝓟B _ t∈A
    where
    A∈𝓟B : A ∈ 𝓟 B
    A∈𝓟B = 𝓟A⊆𝓟B _ (A∈𝓟A _)

-- Theorem 92, p. 48 (Suppes 1960).
𝓟∪ : (A B : 𝓢) → (𝓟 A) ∪ (𝓟 B) ⊆ 𝓟 (A ∪ B)
𝓟∪ A B t t∈𝓟A∪𝓟B = 𝓟-d₂ _ t⊆A∪B
  where
  ∪₁ : t ∈ 𝓟 A ∨ t ∈ 𝓟 B
  ∪₁ = ∪-d₁ _ _ t∈𝓟A∪𝓟B

  p : t ⊆ A ∨ t ⊆ B
  p = ∨-prop₄ aux₁ (𝓟-d₁ _)
    where
    aux₁ : t ⊆ A ∨ t ∈ 𝓟 B
    aux₁ = ∨-prop₃ ∪₁ (𝓟-d₁ _)
  t⊆A∪B : t ⊆ A ∪ B
  t⊆A∪B = ∪-prop₂ _ _ _ p

-- Cartesian Product. First we have to prove some things using
-- the subset axiom in order to be able to define cartesian products.

-- Two abvreviations to make sub₄ shorter.

abv₂ : 𝓢 → 𝓢 → 𝓢 → Set
abv₂ z A B = z ∈ 𝓟 (𝓟 (A ∪ B))

abv₃ : 𝓢 → 𝓢 → 𝓢 → Set
abv₃ z A B = ∃ (λ y → ∃ (λ w → (y ∈ A ∧ w ∈ B) ∧ z ≡ y ₒ w))

--Instance of the subset axiom.
sub₄ : (A B : 𝓢) → ∃ (λ C → {z : 𝓢} → z ∈ C ⇔ abv₂ z A B ∧ abv₃ z A B)
sub₄ A B = sub (λ x → abv₃ x A B) (𝓟 (𝓟 (A ∪ B)))

-- Proved inside theorem 95, p. 49 (Suppes 1960)
prop₁ : (A B x : 𝓢) → abv₃ x A B → abv₂ x A B
prop₁ A B x (y , (z , ((y∈A , z∈B) , eqo))) = subs _ (sym _ _ eqo)  yₒz∈𝓟𝓟A∪B
  where
  yₛ⊆A : singleton y ⊆ A
  yₛ⊆A = singleton-⊆ _ _ y∈A

  yₛ⊆A∪B : singleton y ⊆ A ∪ B
  yₛ⊆A∪B t t∈yₛ = trans-⊆ _ _ _ (yₛ⊆A , (∪-prop _ _)) _ t∈yₛ

  zₛ⊆B : singleton z ⊆ B
  zₛ⊆B = singleton-⊆ _ _ z∈B

  zₛ⊆A∪B : singleton z ⊆ A ∪ B
  zₛ⊆A∪B t t∈zₛ = trans-⊆ _ _ _ (zₛ⊆B , ∪-prop₃ _ _) _ t∈zₛ

  y,z⊆A∪B : y ₚ z ⊆ A ∪ B
  y,z⊆A∪B t t∈y,z = ∪-prop₄ _ _ _ yₛ⊆A∪B zₛ⊆A∪B _ p
    where
    p : t ∈ singleton y ∪ singleton z
    p = subs (λ w → t ∈ w) (prop-p₂ y z) t∈y,z
  yₛ∈𝓟A∪B : singleton y ∈ 𝓟 (A ∪ B)
  yₛ∈𝓟A∪B = 𝓟-d₂ _ yₛ⊆A∪B

  y,z∈𝓟A∪B : y ₚ z ∈ 𝓟 (A ∪ B)
  y,z∈𝓟A∪B = 𝓟-d₂ _ y,z⊆A∪B

  yₒz⊆𝓟A∪B : y ₒ z ⊆ 𝓟 (A ∪ B)
  yₒz⊆𝓟A∪B t t∈o = ∨-e _ _ _ (pair-d₁ _ _ t∈o) i₁ i₂
    where
    i₁ : t ≡ singleton y → t ∈ 𝓟 (A ∪ B)
    i₁ eq = subs _ (sym t (singleton y) eq) yₛ∈𝓟A∪B

    i₂ : t ≡ y ₚ z → t ∈ 𝓟 (A ∪ B)
    i₂ eq = subs _ (sym t (y ₚ z) eq) y,z∈𝓟A∪B
  yₒz∈𝓟𝓟A∪B : y ₒ z ∈ 𝓟 (𝓟 (A ∪ B))
  yₒz∈𝓟𝓟A∪B = 𝓟-d₂ _ yₒz⊆𝓟A∪B

Aᵤ : 𝓢 → 𝓢 → 𝓢
Aᵤ A B = proj₁ (sub₄ A B)

-- Theorem 95, p 49 (Suppes 1960).
pAᵤ : (A B : 𝓢) → {z : 𝓢} → z ∈ (Aᵤ A B) ⇔ abv₂ z A B ∧ abv₃ z A B
pAᵤ A B = proj₂ _ (sub₄ A B)

crts : (A B : 𝓢) → ∃ (λ C → (z : 𝓢) → z ∈ C ⇔ abv₃ z A B)
crts A B  = (Aᵤ A B) , (λ w → ⇔-p₂ w (pAᵤ A B) (prop₁ A B w))

_X_ : 𝓢 → 𝓢 → 𝓢
A X B = proj₁ (crts A B)

-- Theorem 97, p. 50 (Suppes 1960).
crts-p : (A B x : 𝓢) → x ∈ A X B ⇔ abv₃ x A B
crts-p A B x = proj₂ _ (crts A B) x

-- Both projections
crts-p₁ : (A B x : 𝓢) →  x ∈ A X B → abv₃ x A B
crts-p₁ A B x = ∧-proj₁ (crts-p A B x)

crts-p₂ : (A B x : 𝓢) → abv₃ x A B → x ∈ A X B
crts-p₂ A B x = ∧-proj₂ (crts-p A B x)

crts-d₁ : (x y A B : 𝓢) → x ₒ y ∈ A X B → x ∈ A ∧ y ∈ B
crts-d₁ x y A B h = (subs (λ w → w ∈ A) (sym _ _ eq₁) aux∈A)
                         ,
                         subs (λ w → w ∈ B) (sym _ _ eq₂) aux₂∈B
  where
  foo : ∃ (λ z → ∃ (λ w → (z ∈ A ∧ w ∈ B) ∧ (x ₒ y) ≡ (z ₒ w)))
  foo = crts-p₁ A B (x ₒ y) h

  aux : 𝓢
  aux = proj₁ foo

  aux-p : ∃ (λ w → (aux ∈ A ∧ w ∈ B) ∧ (x ₒ y) ≡ (aux ₒ w))
  aux-p = proj₂ _ foo

  aux₂ : 𝓢
  aux₂ = proj₁ aux-p

  aux₂-p : (aux ∈ A ∧ aux₂ ∈ B) ∧ (x ₒ y) ≡ (aux ₒ aux₂)
  aux₂-p = proj₂ _ aux-p

  aux∈A : aux ∈ A
  aux∈A = ∧-proj₁ (∧-proj₁ aux₂-p)

  aux₂∈B : aux₂ ∈ B
  aux₂∈B = ∧-proj₂ (∧-proj₁ aux₂-p)

  eq : x ₒ y ≡ aux ₒ aux₂
  eq = ∧-proj₂ aux₂-p

  eqs : x ≡ aux ∧ y ≡ aux₂
  eqs = ord-p _ _ _ _ eq

  eq₁ : x ≡ aux
  eq₁ = ∧-proj₁ eqs

  eq₂ : y ≡ aux₂
  eq₂ = ∧-proj₂ eqs

-- References
--
-- Suppes, Patrick (1960). Axiomatic Set Theory.
-- The University Series in Undergraduate Mathematics.
-- D. Van Nostrand Company, inc.
--
-- Enderton, Herbert B. (1977). Elements of Set Theory.
-- Academic Press Inc.


module examplesPaperJFP.IOExampleConsole where

open import examplesPaperJFP.BasicIO hiding (main)
open import examplesPaperJFP.Console hiding (main)
open import examplesPaperJFP.NativeIOSafe
open import examplesPaperJFP.CatTerm

main : NativeIO Unit
main = translateIOConsole cat


{-
  Copyright 2019 Lisandra Silva

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

open import Prelude
open import Data.Bool renaming (_≟_ to _B≟_)
open import Data.Fin renaming (_≟_ to _F≟_)
open import Agda.Builtin.Sigma
open import Relation.Nullary.Negation using (contradiction ; contraposition)

open import StateMachineModel

{-
             PROCESS 0                   ||             PROCESS 1

    repeat                               ||    repeat
      s₀: thinking₀ = false;             ||      r₀: thinking₁ = false;
      s₁: turn = 1;                      ||      r₁: turn = 0;
      s₂: await thinking₁ ∨ turn ≡ 0;    ||      r₂: await thinking₀ ∨ turn ≡ 1;
            “critical section”;          ||            “critical section”;
      s₃: thinking₀ = true;              ||      r₃: thinking₁ = true;
    forever                              ||    forever

-}
module Examples.Peterson where

  {- Because of the atomicity assumptions, we can view a concurrent program as a
     state transition system. Simply associate with each process a control
     variable that indicates the atomic statement to be executed next by the
     process.
     The state of the program is defined by the values of the data variables and
     control variables.
  -}
  record State : Set where
    field
      -- Data variables : updated in assignemnt statements
      thinking₀ thinking₁ : Bool
      turn : Fin 2
      -- Control varibales : updated acording to the control flow of the program
      control₀ control₁ : Fin 4
  open State

  -- Events : corresponding to the atomic statements
  data MyEvent : Set where
    es₀ es₁ es₂₁ es₂₂ es₃ er₀ er₁ er₂₁ er₂₂ er₃ : MyEvent

  {- Enabled conditions : predicate on the state variables.
     In any state, an atomic statement can be executed if and only if it is
     pointed to by a control variable and is enabled.
  -}
  MyEnabled : MyEvent → State → Set
  MyEnabled es₀  st = control₀ st ≡ 0F
  MyEnabled es₁  st = control₀ st ≡ 1F
  MyEnabled es₂₁ st = control₀ st ≡ 2F × thinking₁ st ≡ true
  MyEnabled es₂₂ st = control₀ st ≡ 2F × turn st ≡ 0F
  MyEnabled es₃  st = control₀ st ≡ 3F
  MyEnabled er₀  st = control₁ st ≡ 0F
  MyEnabled er₁  st = control₁ st ≡ 1F
  MyEnabled er₂₁ st = control₁ st ≡ 2F × thinking₀ st ≡ true
  MyEnabled er₂₂ st = control₁ st ≡ 2F × turn st ≡ 1F
  MyEnabled er₃  st = control₁ st ≡ 3F

  {- Actions : executing the statement results in a new state.
     Thus each statement execution corresponds to a state transition.
  -}
  MyAction : ∀ {preState} {event} → MyEnabled event preState → State
  -- Process 1
  MyAction {ps} {es₀} x = record ps { thinking₀ = false -- want to access CS
                                    ; control₀  = 1F }  -- next statement

  MyAction {ps} {es₁} x = record ps { turn      = 1F    -- gives turn to other proc
                                    ; control₀  = 2F }  -- next stmt

  MyAction {ps} {es₂₁} x = record ps { control₀  = 3F }  -- next stmt

  MyAction {ps} {es₂₂} x = record ps { control₀  = 3F }  -- next stmt

  MyAction {ps} {es₃} x = record ps { thinking₀ = true  -- releases the CS
                                    ; control₀  = 0F }  -- loop
  -- Proccess 2
  MyAction {ps} {er₀} x = record ps { thinking₁ = false
                                    ; control₁  = 1F }

  MyAction {ps} {er₁} x = record ps { turn      = 0F
                                    ; control₁  = 2F }

  MyAction {ps} {er₂₁} x = record ps { control₁  = 3F }

  MyAction {ps} {er₂₂} x = record ps { control₁  = 3F }

  MyAction {ps} {er₃} x = record ps { thinking₁ = true
                                    ; control₁  = 0F }

  initialState : State
  initialState = record
                   { thinking₀ = true
                   ; thinking₁ = true
                   ; turn      = 0F
                   ; control₀  = 0F
                   ; control₁  = 0F
                   }

  MyStateMachine : StateMachine State MyEvent
  MyStateMachine = record
                     { initial = _≡ initialState
                     ; enabled = MyEnabled
                     ; action  = MyAction
                     }

  -- Each process has its own EventSet with its statements
  Proc0-EvSet : EventSet {Event = MyEvent}
  Proc0-EvSet ev = ev ≡ es₁ ⊎ ev ≡ es₂₁ ⊎ ev ≡ es₂₂ ⊎ ev ≡ es₃

  Proc1-EvSet : EventSet {Event = MyEvent}
  Proc1-EvSet ev = ev ≡ er₁ ⊎ ev ≡ er₂₁ ⊎ ev ≡ er₂₂ ⊎ ev ≡ er₃

  -- And both EventSets have weak-fairness
  data MyWeakFairness : EventSet → Set where
    wf-p0 : MyWeakFairness Proc0-EvSet
    wf-p1 : MyWeakFairness Proc1-EvSet

  MySystem : System State MyEvent
  MySystem = record
             { stateMachine = MyStateMachine
             ; weakFairness = MyWeakFairness
             }

   -----------------------------------------------------------------------------
   -- PROOFS
   -----------------------------------------------------------------------------

  open LeadsTo State MyEvent MySystem

  inv-c₁≡[0-4] : Invariant MyStateMachine λ st → ∃[ f ] (control₁ st ≡ f)-- ([∃ f ∶ (_≡ f) ∘ control₁ ])
  inv-c₁≡[0-4] (init refl) = 0F , refl
  inv-c₁≡[0-4] (step {event = es₀}  rs enEv) = inv-c₁≡[0-4] rs
  inv-c₁≡[0-4] (step {event = es₁}  rs enEv) = inv-c₁≡[0-4] rs
  inv-c₁≡[0-4] (step {event = es₂₁} rs enEv) = inv-c₁≡[0-4] rs
  inv-c₁≡[0-4] (step {event = es₂₂} rs enEv) = inv-c₁≡[0-4] rs
  inv-c₁≡[0-4] (step {event = es₃}  rs enEv) = inv-c₁≡[0-4] rs
  inv-c₁≡[0-4] (step {event = er₀}  rs enEv) = 1F , refl
  inv-c₁≡[0-4] (step {event = er₁}  rs enEv) = 2F , refl
  inv-c₁≡[0-4] (step {event = er₂₁} rs enEv) = 3F , refl
  inv-c₁≡[0-4] (step {event = er₂₂} rs enEv) = 3F , refl
  inv-c₁≡[0-4] (step {event = er₃}  rs enEv) = 0F , refl

  inv-¬think₁ : Invariant
                  MyStateMachine
                  λ st → control₀ st ≡ 1F ⊎ control₀ st ≡ 2F ⊎ control₀ st ≡ 3F
                       → thinking₀ st ≡ false
  inv-¬think₁ (init refl) (inj₂ (inj₁ ()))
  inv-¬think₁ (init refl) (inj₂ (inj₂ ()))
  inv-¬think₁ (step {event = es₀}  rs enEv) x = refl
  inv-¬think₁ (step {event = es₁}  rs enEv) x = inv-¬think₁ rs (inj₁ enEv)
  inv-¬think₁ (step {event = es₂₁} rs enEv) x = inv-¬think₁ rs (inj₂ (inj₁ (fst enEv)))
  inv-¬think₁ (step {event = es₂₂} rs enEv) x = inv-¬think₁ rs (inj₂ (inj₁ (fst enEv)))
  inv-¬think₁ (step {event = es₃}  rs enEv) (inj₂ (inj₁ ()))
  inv-¬think₁ (step {event = es₃}  rs enEv) (inj₂ (inj₂ ()))
  inv-¬think₁ (step {event = er₀}  rs enEv) x = inv-¬think₁ rs x
  inv-¬think₁ (step {event = er₁}  rs enEv) x = inv-¬think₁ rs x
  inv-¬think₁ (step {event = er₂₁} rs enEv) x = inv-¬think₁ rs x
  inv-¬think₁ (step {event = er₂₂} rs enEv) x = inv-¬think₁ rs x
  inv-¬think₁ (step {event = er₃}  rs enEv) x = inv-¬think₁ rs x

  inv-think₂ : Invariant
                  MyStateMachine
                  λ st → control₁  st ≡ 0F
                       → thinking₁ st ≡ true
  inv-think₂ (init refl) x = refl
  inv-think₂ (step {event = es₀}  rs enEv) x = inv-think₂ rs x
  inv-think₂ (step {event = es₁}  rs enEv) x = inv-think₂ rs x
  inv-think₂ (step {event = es₂₁} rs enEv) x = inv-think₂ rs x
  inv-think₂ (step {event = es₂₂} rs enEv) x = inv-think₂ rs x
  inv-think₂ (step {event = es₃}  rs enEv) x = inv-think₂ rs x
  inv-think₂ (step {event = er₃}  rs enEv) x = refl

  inv-¬think₂ : Invariant
                  MyStateMachine
                  λ st → control₁ st ≡ 1F ⊎ control₁ st ≡ 2F ⊎ control₁ st ≡ 3F
                       → thinking₁ st ≡ false
  inv-¬think₂ (init refl) (inj₂ (inj₁ ()))
  inv-¬think₂ (init refl) (inj₂ (inj₂ ()))
  inv-¬think₂ (step {event = es₀}  rs enEv) x = inv-¬think₂ rs x
  inv-¬think₂ (step {event = es₁}  rs enEv) x = inv-¬think₂ rs x
  inv-¬think₂ (step {event = es₂₁} rs enEv) x = inv-¬think₂ rs x
  inv-¬think₂ (step {event = es₂₂} rs enEv) x = inv-¬think₂ rs x
  inv-¬think₂ (step {event = es₃}  rs enEv) x = inv-¬think₂ rs x
  inv-¬think₂ (step {event = er₀}  rs enEv) x = refl
  inv-¬think₂ (step {event = er₁}  rs enEv) x = inv-¬think₂ rs (inj₁ enEv)
  inv-¬think₂ (step {event = er₂₁} rs enEv) x = inv-¬think₂ rs (inj₂ (inj₁ (fst enEv)))
  inv-¬think₂ (step {event = er₂₂} rs enEv) x = inv-¬think₂ rs (inj₂ (inj₁ (fst enEv)))
  inv-¬think₂ (step {event = er₃}  rs enEv) (inj₂ (inj₁ ()))
  inv-¬think₂ (step {event = er₃}  rs enEv) (inj₂ (inj₂ ()))

  proc0-1-l-t-2 : (_≡ 1F) ∘ control₀ l-t (_≡ 2F) ∘ control₀
  proc0-1-l-t-2 = viaEvSet
                    Proc0-EvSet
                    wf-p0
                    (λ { es₁  (inj₁ refl)               → hoare λ { _ _ → refl }
                       ; es₂₁ (inj₂ (inj₁ refl))        → hoare λ { refl () }
                       ; es₂₂ (inj₂ (inj₂ (inj₁ refl))) → hoare λ { refl () }
                       ; es₃  (inj₂ (inj₂ (inj₂ refl))) → hoare λ { refl () }
                       })
                    (λ { es₀  _ → hoare λ { () refl }
                       ; es₁  x → ⊥-elim (x (inj₁ refl))
                       ; es₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
                       ; es₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
                       ; es₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl))))
                       ; er₀  _ → hoare λ z _ → inj₁ z
                       ; er₁  _ → hoare λ z _ → inj₁ z
                       ; er₂₁ _ → hoare λ z _ → inj₁ z
                       ; er₂₂ _ → hoare λ z _ → inj₁ z
                       ; er₃  _ → hoare λ z _ → inj₁ z
                       })
                    λ _ x → es₁ , inj₁ refl , x

  P⊆P₀⊎P₁ : ∀ {ℓ} {A : Set ℓ} (x : Fin 2)
            → A → A × x ≡ 0F ⊎ A × x ≡ 1F
  P⊆P₀⊎P₁ 0F a = inj₁ (a , refl)
  P⊆P₀⊎P₁ 1F a = inj₂ (a , refl)

  -- y4

  turn≡0-l-t-Q : ((_≡ 2F) ∘ control₀ ∩ (_≡ 0F) ∘ turn ) l-t (_≡ 3F) ∘ control₀
  turn≡0-l-t-Q =
    viaEvSet
      Proc0-EvSet
      wf-p0
      (λ { es₁  (inj₁ refl)               → hoare λ { () refl }
         ; es₂₁ (inj₂ (inj₁ refl))        → hoare λ _ _ → refl
         ; es₂₂ (inj₂ (inj₂ (inj₁ refl))) → hoare λ _ _ → refl
         ; es₃  (inj₂ (inj₂ (inj₂ refl))) → hoare λ { () refl } })
      ( λ { es₀  _ → hoare λ { () refl }
          ; es₁  x → ⊥-elim (x (inj₁ refl))
          ; es₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
          ; es₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
          ; es₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl))))
          ; er₀  _ → hoare (λ z _ → inj₁ z)
          ; er₁  _ → hoare (λ z _ → inj₁ ((fst z) , refl) )
          ; er₂₁ _ → hoare (λ z _ → inj₁ z)
          ; er₂₂ _ → hoare (λ z _ → inj₁ z)
          ; er₃  _ → hoare (λ z _ → inj₁ z)
          } )
      λ { _ (c₀≡2 , tu≡0) → es₂₂ , inj₂ (inj₂ (inj₁ refl)) , c₀≡2 , tu≡0 }

  -- I think I could prove this with the Proc1EvSet

  Pl-tQ∨c₁≡1 : (λ preSt → ( control₀ preSt ≡ 2F × turn preSt ≡ 1F )
                  × control₁ preSt ≡ 0F)
       l-t
        λ posSt →   control₀ posSt ≡ 3F
                  ⊎ (( control₀ posSt ≡ 2F × turn posSt ≡ 1F )
                     × control₁ posSt ≡ 1F )
  Pl-tQ∨c₁≡1 =
    viaEvSet
      Proc0-EvSet
      wf-p0
      (λ { es₁  (inj₁ refl)               → hoare λ { () refl }
         ; es₂₁ (inj₂ (inj₁ refl))        → hoare λ { _ _ → inj₁ refl }
         ; es₂₂ (inj₂ (inj₂ (inj₁ refl))) → hoare λ { _ _ → inj₁ refl }
         ; es₃  (inj₂ (inj₂ (inj₂ refl))) → hoare λ { () refl } })
      ( λ { es₀  _ → hoare λ { () refl }
          ; es₁  x → ⊥-elim (x (inj₁ refl))
          ; es₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
          ; es₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
          ; es₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl))))
          ; er₀  _ → hoare λ { x₁ enEv → inj₂ (inj₂ (fst x₁ , refl)) }
          ; er₁  _ → hoare λ { () refl }
          ; er₂₁ _ → hoare λ { () (refl , _) }
          ; er₂₂ _ → hoare λ { () (refl , _) }
          ; er₃  _ → hoare λ { () refl }
          })
      λ { rs ((c₀≡2 , _) , c₁≡0)
             → es₂₁ , inj₂ (inj₁ refl) , c₀≡2 , inv-think₂ rs c₁≡0 }

  l-t-turn≡0 : ((_≡ 2F) ∘ control₀ ∩ (_≡ 1F) ∘ turn) ∩ (_≡ 1F) ∘ control₁
               l-t
               (_≡ 2F) ∘ control₀ ∩  (_≡ 0F) ∘ turn
  l-t-turn≡0 =
    viaUseInv
      inv-¬think₂
      ( viaEvSet
          Proc1-EvSet
          wf-p1
          ( λ { er₁  (inj₁ refl) → hoare λ { ((x , _) , _) _ _ → fst x , refl  }
              ; er₂₁ (inj₂ (inj₁ refl)) → hoare λ { () (refl , _) _ }
              ; er₂₂ (inj₂ (inj₂ (inj₁ refl))) → hoare λ { () (refl , _) _ }
              ; er₃  (inj₂ (inj₂ (inj₂ refl))) → hoare λ { () refl _ }
              }
          )
          ( λ { es₀  _ → hoare λ { () refl }
              ; es₁  _ → hoare λ { () refl }
              ; es₂₁ _ → hoare λ { ((_ , c₂≡2) , x) (_ , refl)
                                   → contradiction (x (inj₁ c₂≡2)) λ () }
              ; es₂₂ _ → hoare λ { () (_ , refl) }
              ; es₃  _ → hoare λ { () refl }
              ; er₀  _ → hoare λ { () refl }
              ; er₁  x → ⊥-elim (x (inj₁ refl))
              ; er₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
              ; er₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
              ; er₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl)))) }
          )
          λ _ x → er₁ , inj₁ refl , (snd ∘ fst) x
      )

  l-t-c₁≡3 : (λ preSt → ( control₀ preSt ≡ 2F × turn preSt ≡ 1F )
                  × control₁ preSt ≡ 2F)
       l-t
       (λ posSt → ( control₀ posSt ≡ 2F
                  × turn posSt ≡ 1F )
                  × control₁ posSt ≡ 3F)
  l-t-c₁≡3 =
    viaUseInv
      inv-¬think₂
      ( viaEvSet
          Proc1-EvSet
          wf-p1
          ( λ { er₁  (inj₁ refl) → hoare λ { () refl _ }
              ; er₂₁ (inj₂ (inj₁ refl))
                     → hoare λ { ((x , _) , _) _ _ → x , refl }
              ; er₂₂ (inj₂ (inj₂ (inj₁ refl)))
                     → hoare λ { ((x , _) , _) _ _ → x , refl }
              ; er₃  (inj₂ (inj₂ (inj₂ refl))) → hoare λ { () refl _ }
              }
          )
          ( λ { es₀  _ → hoare λ { () refl }
              ; es₁  _ → hoare λ { () refl }
              ; es₂₁ _ → hoare λ { ((_ , c₂≡3) , x) (_ , refl)
                                   → contradiction (x (inj₂ (inj₁ c₂≡3))) λ () }
              ; es₂₂ _ → hoare λ { () (_ , refl) }
              ; es₃  _ → hoare λ { () refl }
              ; er₀  _ → hoare λ { () refl }
              ; er₁  x → ⊥-elim (x (inj₁ refl))
              ; er₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
              ; er₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
              ; er₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl))))
              }
          )
          λ _ x → er₂₂ , inj₂ (inj₂ (inj₁ refl)) , (snd ∘ fst) x , (snd ∘ fst ∘ fst) x
      )

  l-t-c₁≡0 : (λ preSt → ( control₀ preSt ≡ 2F × turn preSt ≡ 1F )
                  × control₁ preSt ≡ 3F)
       l-t
       (λ posSt → ( control₀ posSt ≡ 2F × turn posSt ≡ 1F )
                  × control₁ posSt ≡ 0F)
  l-t-c₁≡0 =
    viaUseInv
      inv-¬think₂
      ( viaEvSet
          Proc1-EvSet
          wf-p1
          ( λ { er₁  (inj₁ refl)        → hoare λ { () refl _ }
              ; er₂₁ (inj₂ (inj₁ refl)) → hoare λ { () (refl , _) _ }
              ; er₂₂ (inj₂ (inj₂ (inj₁ refl))) → hoare λ { () (refl , _) _ }
              ; er₃  (inj₂ (inj₂ (inj₂ refl)))
                     → hoare λ { x _ _ → (fst ∘ fst) x , refl }
              }
          )
          ( λ { es₀  _ → hoare λ { () refl }
              ; es₁  _ → hoare λ { () refl }
              ; es₂₁ _ → hoare λ { ((_ , c₂≡4) , x) (_ , refl)
                                  → contradiction (x (inj₂ (inj₂ c₂≡4))) λ () }
              ; es₂₂ _ → hoare λ { () (_ , refl) }
              ; es₃  _ → hoare λ { () refl }
              ; er₀  _ → hoare λ { () refl }
              ; er₁  x → ⊥-elim (x (inj₁ refl))
              ; er₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
              ; er₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
              ; er₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl))))
              }
          )
          λ _ x → er₃ , inj₂ (inj₂ (inj₂ refl)) , (snd ∘ fst) x
      )

  P∧c₁≡1⇒Q : ((_≡ 2F) ∘ control₀ ∩ (_≡ 1F) ∘ turn) ∩ (_≡ 1F) ∘ control₁
             l-t
             (_≡ 3F) ∘ control₀
  P∧c₁≡1⇒Q = viaTrans l-t-turn≡0 turn≡0-l-t-Q

  P∧c₁≡0⇒Q : ((_≡ 2F) ∘ control₀ ∩ (_≡ 1F) ∘ turn) ∩ (_≡ 0F) ∘ control₁
             l-t
             (_≡ 3F) ∘ control₀
  P∧c₁≡0⇒Q = viaTrans2 Pl-tQ∨c₁≡1 P∧c₁≡1⇒Q

  P∧c₁≡3⇒Q : ((_≡ 2F) ∘ control₀ ∩ (_≡ 1F) ∘ turn) ∩ (_≡ 3F) ∘ control₁
             l-t
             (_≡ 3F) ∘ control₀
  P∧c₁≡3⇒Q = viaTrans l-t-c₁≡0 P∧c₁≡0⇒Q

  P∧c₁≡2⇒Q : ((_≡ 2F) ∘ control₀ ∩ (_≡ 1F) ∘ turn) ∩ (_≡ 2F) ∘ control₁
             l-t
             (_≡ 3F) ∘ control₀
  P∧c₁≡2⇒Q = viaTrans l-t-c₁≡3 P∧c₁≡3⇒Q

  P⊆c₂≡0⊎c₂≢0 : ∀ {ℓ} {A : Set ℓ} (x : Fin 4) → A
                  → A × x ≡ 0F ⊎ A × x ≢ 0F
  P⊆c₂≡0⊎c₂≢0 0F a = inj₁ (a , refl)
  P⊆c₂≡0⊎c₂≢0 (suc x) a = inj₂ (a , (λ ()))

  P⊆c₂≡1⊎c₂≢1 : ∀ {ℓ} {A : Set ℓ} (x : Fin 4) → A × x ≢ 0F
                  → A × x ≡ 1F ⊎ A × x ≢ 0F × x ≢ 1F
  P⊆c₂≡1⊎c₂≢1 0F (a , x≢0) = ⊥-elim (x≢0 refl)
  P⊆c₂≡1⊎c₂≢1 1F (a , x≢0) = inj₁ (a , refl)
  P⊆c₂≡1⊎c₂≢1 (suc (suc x)) (a , x≢0) = inj₂ (a , x≢0 , λ ())

  P⊆c₂≡2⊎c₂≡3 : ∀ {ℓ} {A : Set ℓ} (x : Fin 4) → A × x ≢ 0F × x ≢ 1F
                  → A × x ≡ 2F ⊎ A × x ≡ 3F
  P⊆c₂≡2⊎c₂≡3 0F (a , x≢0 , x≢1) = ⊥-elim (x≢0 refl)
  P⊆c₂≡2⊎c₂≡3 1F (a , x≢0 , x≢1) = ⊥-elim (x≢1 refl)
  P⊆c₂≡2⊎c₂≡3 2F (a , x≢0 , x≢1) = inj₁ (a , refl)
  P⊆c₂≡2⊎c₂≡3 3F (a , x≢0 , x≢1) = inj₂ (a , refl)

  turn≡1-l-t-Q :  ((_≡ 2F) ∘ control₀ ∩ (_≡ 1F) ∘ turn ) l-t (_≡ 3F) ∘ control₀
  turn≡1-l-t-Q = viaAllVal
                   inv-c₁≡[0-4]
                   λ { 0F → P∧c₁≡0⇒Q
                     ; 1F → P∧c₁≡1⇒Q
                     ; 2F → P∧c₁≡2⇒Q
                     ; 3F → P∧c₁≡3⇒Q }

  proc0-2-l-t-3 :  (_≡ 2F) ∘ control₀ l-t (_≡ 3F) ∘ control₀
  proc0-2-l-t-3 = viaDisj
                    (λ {st} c₀≡2 → P⊆P₀⊎P₁ (turn st) c₀≡2 )
                    turn≡0-l-t-Q
                    turn≡1-l-t-Q

  proc1-1-l-t-2 : (λ preSt → control₁ preSt ≡ 1F)
                  l-t
                  λ posSt →   control₁ posSt ≡ 2F
  proc1-1-l-t-2 =
    viaEvSet
      Proc1-EvSet
      wf-p1
      ( λ { er₁  (inj₁ refl) → hoare λ { x enEv → refl }
          ; er₂₁ (inj₂ (inj₁ refl)) → hoare λ { refl () }
          ; er₂₂ (inj₂ (inj₂ (inj₁ refl))) → hoare λ { refl () }
          ; er₃  (inj₂ (inj₂ (inj₂ refl))) → hoare λ { refl () }
          }
      )
      ( λ { es₀  _ → hoare λ z _ → inj₁ z
          ; es₁  _ → hoare λ z _ → inj₁ z
          ; es₂₁ _ → hoare λ z _ → inj₁ z
          ; es₂₂ _ → hoare λ z _ → inj₁ z
          ; es₃  _ → hoare λ z _ → inj₁ z
          ; er₀  _ → hoare λ _ _ → inj₁ refl
          ; er₁  x → ⊥-elim (x (inj₁ refl))
          ; er₂₁ x → ⊥-elim (x (inj₂ (inj₁ refl)))
          ; er₂₂ x → ⊥-elim (x (inj₂ (inj₂ (inj₁ refl))))
          ; er₃  x → ⊥-elim (x (inj₂ (inj₂ (inj₂ refl))))
          }
      )
      λ _ x → er₁ , inj₁ refl , x

  -- The proofs are the same as proc0-2-l-t-3 but symmetric.
  -- We will postulate by now!
  postulate
    proc1-2-l-t-3 : ( λ preSt →  control₁ preSt ≡ 2F )
                     l-t
                     λ posSt → control₁ posSt ≡ 3F

  -- We proved this via transitivity :
  -- control₀ fstSt ≡ 1F   l-t   control₀ someSt ≡ 2F   l-t   control₀ ≡ 3F
  proc0-live : (λ preSt → control₀ preSt ≡ 1F) l-t (λ posSt → control₀ posSt ≡ 3F)
  proc0-live = viaTrans proc0-1-l-t-2 proc0-2-l-t-3

  proc1-live : (λ preSt → control₁ preSt ≡ 1F) l-t (λ posSt → control₁ posSt ≡ 3F)
  proc1-live = viaTrans proc1-1-l-t-2 proc1-2-l-t-3

  ------------------------------------------------------------------------------
   -- Liveness property
  ------------------------------------------------------------------------------
  --   If Process 1 (Process 2) wants to access the critical section, which
  --   means its control variable is in 1F (it just expressed its will in
  --   accessing the CS in r₀) then it will eventually access the CS
  progress : ( (_≡ 1F) ∘ control₀ l-t (_≡ 3F) ∘ control₀ )
           × ( (_≡ 1F) ∘ control₁ l-t (_≡ 3F) ∘ control₁ )
  progress = proc0-live , proc1-live


{-# OPTIONS --safe --warning=error --without-K #-}

open import LogicalFormulae
open import Groups.Cosets
open import Groups.Homomorphisms.Definition
open import Rings.Homomorphisms.Definition
open import Groups.Lemmas
open import Groups.Definition
open import Setoids.Setoids
open import Setoids.Functions.Lemmas
open import Rings.Definition
open import Sets.EquivalenceRelations
open import Rings.Ideals.Definition
open import Fields.Fields
open import Fields.Lemmas
open import Rings.Cosets
open import Rings.Ideals.Maximal.Definition
open import Rings.Ideals.Lemmas
open import Rings.Ideals.Prime.Definition
open import Rings.IntegralDomains.Definition
open import Rings.Ideals.Prime.Lemmas

open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)

module Rings.Ideals.Maximal.Lemmas {a b : _} {A : Set a} {S : Setoid {a} {b} A} {_+_ _*_ : A → A → A} {R : Ring S _+_ _*_} {c : _} {pred : A → Set c} (i : Ideal R pred)  where

open Ring R
open Group additiveGroup
open Setoid S
open Equivalence eq

idealMaximalImpliesQuotientField : ({d : Level} → MaximalIdeal i {d}) → Field (cosetRing R i)
Field.allInvertible (idealMaximalImpliesQuotientField max) cosetA cosetA!=0 = ans' , ans''
  where
    gen : Ideal (cosetRing R i) (generatedIdealPred (cosetRing R i) cosetA)
    gen = generatedIdeal (cosetRing R i) cosetA
    inv : Ideal R (inverseImagePred {S = S} {T = cosetSetoid additiveGroup (Ideal.isSubgroup i)} (GroupHom.wellDefined (RingHom.groupHom (cosetRingHom R i))) (Ideal.isSubset gen))
    inv = inverseImageIsIdeal (cosetRing R i) (cosetRingHom R i) gen
    containsOnce : {a : A} → (Ideal.predicate i a) → (Ideal.predicate inv a)
    containsOnce {x} ix = x , ((x , Ideal.closedUnderPlus i (Ideal.closedUnderInverse i ix) (Ideal.isSubset i *Commutative (Ideal.accumulatesTimes i ix))) ,, Ideal.isSubset i (symmetric invLeft) (Ideal.containsIdentity i))
    notInI : A
    notInI = cosetA
    notInIIsInInv : Ideal.predicate inv notInI
    notInIIsInInv = cosetA , ((1R , Ideal.isSubset i {0R} (symmetric (transitive (+WellDefined reflexive (transitive *Commutative identIsIdent)) (invLeft {cosetA}))) (Ideal.containsIdentity i)) ,, Ideal.isSubset i (symmetric invLeft) (Ideal.containsIdentity i))
    notInIPr : (Ideal.predicate i notInI) → False
    notInIPr iInI = cosetA!=0 (Ideal.isSubset i (transitive (symmetric identLeft) (+WellDefined (symmetric (invIdent additiveGroup)) reflexive)) iInI)
    ans : {a : A} → Ideal.predicate inv a
    ans = MaximalIdeal.isMaximal max inv containsOnce (notInI , (notInIIsInInv ,, notInIPr))
    ans' : A
    ans' with ans {1R}
    ... | _ , ((b , _) ,, _) = b
    ans'' : pred (inverse (Ring.1R (cosetRing R i)) + (ans' * cosetA))
    ans'' with ans {1R}
    ans'' | a , ((b , predCAb-a) ,, pred1-a) = Ideal.isSubset i (transitive (+WellDefined (invContravariant additiveGroup) reflexive) (transitive +Associative (+WellDefined (transitive (symmetric +Associative) (transitive (+WellDefined reflexive invLeft) identRight)) *Commutative))) (Ideal.closedUnderPlus i (Ideal.closedUnderInverse i pred1-a) predCAb-a)
Field.nontrivial (idealMaximalImpliesQuotientField max) 1=0 = MaximalIdeal.notContainedIsNotContained max (Ideal.isSubset i (identIsIdent {MaximalIdeal.notContained (max {lzero})}) (Ideal.accumulatesTimes i p))
  where
    have : pred (inverse 1R)
    have = Ideal.isSubset i identRight 1=0
    p : pred 1R
    p = Ideal.isSubset i (invTwice additiveGroup 1R) (Ideal.closedUnderInverse i have)

quotientFieldImpliesIdealMaximal : Field (cosetRing R i) → ({d : _} → MaximalIdeal i {d})
MaximalIdeal.notContained (quotientFieldImpliesIdealMaximal f) = Ring.1R (cosetRing R i)
MaximalIdeal.notContainedIsNotContained (quotientFieldImpliesIdealMaximal f) p1R = Field.nontrivial f (memberDividesImpliesMember R i p1R ((inverse 1R + 0R) , identIsIdent))
MaximalIdeal.isMaximal (quotientFieldImpliesIdealMaximal f) {bigger} biggerIdeal contained (a , (biggerA ,, notPredA)) = Ideal.isSubset biggerIdeal identIsIdent (Ideal.accumulatesTimes biggerIdeal v)
  where
    inv : Sg A (λ t → pred (inverse 1R + (t * a)))
    inv = Field.allInvertible f a λ r → notPredA (translate' R i r)
    r : A
    r = underlying inv
    s : pred (inverse 1R + (r * a))
    s with inv
    ... | _ , p = p
    t : bigger (inverse 1R + (r * a))
    t = contained s
    u : bigger (inverse (r * a))
    u = Ideal.closedUnderInverse biggerIdeal (Ideal.isSubset biggerIdeal *Commutative (Ideal.accumulatesTimes biggerIdeal biggerA))
    v : bigger 1R
    v = Ideal.isSubset biggerIdeal (invTwice additiveGroup 1R) (Ideal.closedUnderInverse biggerIdeal (Ideal.isSubset biggerIdeal (transitive (symmetric +Associative) (transitive (+WellDefined reflexive invRight) identRight)) (Ideal.closedUnderPlus biggerIdeal t u)))

idealMaximalImpliesIdealPrime : ({d : _} → MaximalIdeal i {d}) → PrimeIdeal i
idealMaximalImpliesIdealPrime max = quotientIntDomImpliesIdealPrime i (fieldIsIntDom (idealMaximalImpliesQuotientField max))

maximalIdealWellDefined : {d : _} {pred2 : A → Set d} (i2 : Ideal R pred2) → ({x : A} → pred x → pred2 x) → ({x : A} → pred2 x → pred x) → {e : _} → MaximalIdeal i {e} → MaximalIdeal i2 {e}
MaximalIdeal.notContained (maximalIdealWellDefined i2 pToP2 p2ToP record { notContained = notContained ; notContainedIsNotContained = notContainedIsNotContained ; isMaximal = isMaximal }) = notContained
MaximalIdeal.notContainedIsNotContained (maximalIdealWellDefined i2 pToP2 p2ToP record { notContained = notContained ; notContainedIsNotContained = notContainedIsNotContained ; isMaximal = isMaximal }) p2Not = notContainedIsNotContained (p2ToP p2Not)
MaximalIdeal.isMaximal (maximalIdealWellDefined i2 pToP2 p2ToP record { notContained = notContained ; notContainedIsNotContained = notContainedIsNotContained ; isMaximal = isMaximal }) {biggerPred} bigger pred2InBigger (r , (biggerPredR ,, notP2r)) {x} = isMaximal bigger (λ p → pred2InBigger (pToP2 p)) (r , (biggerPredR ,, λ p → notP2r (pToP2 p)))


module paper where

open import Data.Bool using (Bool; not; _∨_; _∧_)
open import Data.Nat using (ℕ)
open import Data.Fin using (Fin; suc; zero)
open import Data.List using (List; _++_) renaming (_∷_ to _,_; [] to ∅)
open import Data.Product using (_×_; _,_)
open import Relation.Binary.PropositionalEquality using (_≡_; refl)

postulate
  Entity   : Set
  _⊃_      : Bool → Bool → Bool
  FORALL   : (Entity → Bool) → Bool
  EXISTS   : (Entity → Bool) → Bool
  PERSON   : Entity → Bool
  FIND     : Entity → Entity → Bool
  UNICORN  : Entity → Bool

data U : Set where S N NP : U

⟦_⟧ᵁ : U → Set
⟦ S   ⟧ᵁ = Bool
⟦ N   ⟧ᵁ = Entity → Bool
⟦ NP  ⟧ᵁ = Entity

import IntuitionisticLogic U ⟦_⟧ᵁ as IL
import LinearLogic U S ⟦_⟧ᵁ as LP
import LambekGrishinCalculus U S ⟦_⟧ᵁ as LG

open LG
open IL.Explicit using (Ctxt; _,_; ∅)
open IL.Explicit.Reify TypeReify

everyone  : ⟦ (el NP + ⇐ el N +) ⊗ el N + ⟧
everyone  = ( (λ{ (A , B) → FORALL (λ x → B x ⊃ A x) }) , PERSON )
finds     : ⟦ (el NP + ⇒ el S -) ⇐ el NP + ⟧
finds     = λ{ ((x , k) , y) → k (FIND y x) }
some      : ⟦ el NP + ⇐ el N + ⟧
some      = λ{ (A , B) → EXISTS (λ x → A x ∧ B x) }
unicorn   : ⟦ el N + ⟧
unicorn   = UNICORN

sent :
  · (el NP + ⇐ el N +) ⊗ el N +         -- everyone
  · ⊗ (· (el NP + ⇒ el S -) ⇐ el NP +  -- finds
  · ⊗ (· el NP + ⇐ el N +               -- some
  · ⊗ · el N + ·                         -- unicorn
  )) ⊢[ el S - ]
sent =
  μ (res₃ (⊗L (res₃ (μ̃* (⇐L (
    μ̃ (res₄ (res₁ (res₁ (res₃ (μ̃* (⇐L (
      μ̃ (res₂ (res₃ (μ̃* (⇐L (⇒L var covar) var))))) var))))))) var)))))

test : ([ sent ] (everyone , finds , some , unicorn , ∅))
     ≡ (λ k → FORALL (λ x₁ → PERSON x₁ ⊃ EXISTS (λ x₂ → k (FIND x₂ x₁) ∧ UNICORN x₂)))
test = refl


{-# OPTIONS --omega-in-omega --no-termination-check --overlapping-instances #-}

module Light.Implementation.Data.Natural where

open import Light.Library.Data.Natural using (Library ; Dependencies)
import Light.Implementation.Relation.Decidable
import Light.Implementation.Relation.Binary.Equality.Propositional
import Light.Package
open import Light.Library.Relation.Decidable using (Decidable ; yes ; no ; if_then_else_)
import Light.Implementation.Relation.Binary.Equality.Propositional.Decidable as DecidablePropositional
open import Light.Library.Relation.Binary using (reflexivity ; congruence)
open import Light.Library.Relation.Binary.Equality using (_≈_ ; wrap)
open import Agda.Builtin.Equality using (refl)

instance dependencies : Dependencies
dependencies = record {}

instance library : Library dependencies
library = record { Implementation }
      where
      module Implementation where
            data ℕ : Set where
                  zero : ℕ
                  successor : ℕ → ℕ

            {-# COMPILE JS
                  ℕ = (a, cons) => a === 0n ? cons.zero() : cons.successor(a - 1n)
            #-}
            {-# COMPILE JS zero = 0n #-}
            {-# COMPILE JS successor = a => a + 1n #-}

            postulate _+_ _∗_ _//_ _∸_ : ℕ → ℕ → ℕ

            {-# COMPILE JS _+_ = () => a => b => a + b #-}
            {-# COMPILE JS _∗_ = () => a => b => a * b #-}
            {-# COMPILE JS _//_ = () => a => b => a / b #-}
            {-# COMPILE JS _∸_ = () => a => b => a < b ? 0n : a - b #-}

            predecessor : _
            predecessor a = a ∸ successor zero

            private _≈?_ : ∀ (a b : ℕ) → Decidable (a ≈ b)
            zero ≈? zero = yes reflexivity
            successor _ ≈? zero = no λ ()
            zero ≈? successor _ = no λ ()
            successor a ≈? successor b =
                  if a ≈? b
                  then (λ ⦃ a‐≡‐b ⦄ → yes (congruence a‐≡‐b))
                  else (λ ⦃ f ⦄ → no λ {refl → f reflexivity})

            equals = record { equals = wrap (record { are = λ a b → a ≈? b }) }

            module EqualityProperties = DecidablePropositional.Main _≈?_


postulate
  X Y Z A : Set

record R : Set where
  field
    x : X
    y : Y
    z : Z

module M where
  postulate
    x : X
    y : Y

r : R
r = record { M; z = zz } where postulate zz : Z

-- Record update. Same as: record r { y = ... }
r2 : R
r2 = record { R r; y = y } where postulate y : Y

module M2 (a : A) where
 postulate
  w : Y
  z : Z

r3 : A → R
r3 a = record { M hiding (y); M2 a renaming (w to y) }


module Oscar.Function where

open import Function public using (id; _∘_; _∘′_; flip; _on_; _$_) renaming (const to const_)

infix -1 _∋_
_∋_ : ∀ {a} (A : Set a) → A → A
_ ∋ x = x

open import Prelude.Function public using (it)


{-# OPTIONS --without-K #-}

-- Universes
open import Agda.Primitive

module main where

-- I don't really understand exactly which equality gets imported in agda if
-- I try to import the builtin, so define the sane MLTT one here.

infixl 4 _≡_
data _≡_ {n : Level} {A : Set n} : A → A → Set n where
  refl : {a : A} → a ≡ a
{-# BUILTIN EQUALITY _≡_ #-}

-- Lemma 2.1.1 all paths have inverses
inv : ∀ {n} {A : Set n} {a b : A} → a ≡ b → b ≡ a
inv refl = refl

-- This is painful to type so I'll just stick with inv most of the time
_⁻¹ = inv

-- Lemma 2.1.2 any two paths with connecting endpoint compose
trans : ∀ {n} {A : Set n} {a b c : A} → a ≡ b → b ≡ c → a ≡ c
trans refl p = p

_∙_ = trans
infixl 50 _∙_

-- Lemma 2.1.4 types are groupoids
-- (i) left and right identity laws
left-id : ∀ {n} {A : Set n} {a b : A} → (p : a ≡ b) → refl ∙ p ≡ p
left-id refl = refl

right-id : ∀ {n} {A : Set n} {a b : A} → (p : a ≡ b) → p ∙ refl ≡ p
right-id refl = refl

-- (ii) inverses compose to identity
left-inv : ∀ {n} {A : Set n} {a b : A} → (p : a ≡ b) → (inv p) ∙ p ≡ refl
left-inv refl = refl

right-inv : ∀ {n} {A : Set n} {a b : A} → (p : a ≡ b) → p ∙ (inv p) ≡ refl
right-inv refl = refl

-- (iii) inverse of inverse gives an equal path
inv-inv : ∀ {n} {A : Set n} {a b : A} → (p : a ≡ b) → inv (inv p) ≡ p
inv-inv refl = refl

-- (iv) associativity of path composition
assoc :
  ∀ {n} {A : Set n} {a b c d : A} →
  (p : a ≡ b) (q : b ≡ c) (r : c ≡ d) →
  p ∙ (q ∙ r) ≡ (p ∙ q) ∙ r
assoc refl q r = refl

-- Theorem 2.1.6 Eckmann-Hilton
loop-space : (A : Set) (a : A) → Set
loop-space A a = a ≡ a

Ω = loop-space

loop-space-2d : (A : Set) (a : A) → Set
loop-space-2d A a = loop-space (a ≡ a) (refl {a = a})

Ω² = loop-space-2d

_∙ᵣ_ :
  ∀ {n} {A : Set n} {a b c : A} {p q : a ≡ b} →
  (α : p ≡ q) (r : b ≡ c) →
  (p ∙ r ≡ q ∙ r)
α ∙ᵣ refl = (right-id _) ∙ α ∙ (inv (right-id _))

-- My emacs setup doesn't show subscript l for some reason, or I typed it wrong
_∙ₗ_ :
  ∀ {n} {A : Set n} {a b c : A} {r s : b ≡ c} →
  (q : a ≡ b) (β : r ≡ s) →
  (q ∙ r ≡ q ∙ s)
refl ∙ₗ β = β

horizontal-comp : ∀ {n} {A : Set n} {a b c : A} →
  {p q : a ≡ b} {r s : b ≡ c} →
  (α : p ≡ q) (β : r ≡ s) →
  (p ∙ r ≡ q ∙ s)
horizontal-comp {q = q} {r = r} α β = (α ∙ᵣ r) ∙ (q ∙ₗ β)

_⋆_ = horizontal-comp

horizontal-comp' : ∀ {n} {A : Set n} {a b c : A}
  {p q : a ≡ b} {r s : b ≡ c} →
  (α : p ≡ q) (β : r ≡ s) →
  (p ∙ r ≡ q ∙ s)
horizontal-comp' {p = p} {s = s} α β = (p ∙ₗ β) ∙ (α ∙ᵣ s)

_⋆'_ = horizontal-comp'

-- two compositions agree
comp-agree : {A : Set} {a : A} → (α β : loop-space-2d A a) → α ⋆ β ≡ α ⋆' β
comp-agree α β = comp-agree' α β
  where
    -- (more generally at two free endpoints, or we won't get path induction)
    comp-agree' : {A : Set} {a : A} {p r : a ≡ a} → (α : p ≡ refl) (β : refl ≡ r) → α ⋆ β ≡ α ⋆' β
    comp-agree' refl refl = refl

eckmann-hilton : {A : Set} {a : A} → (α β : loop-space-2d A a) → α ∙ β ≡ β ∙ α
eckmann-hilton α β = (inv horizontal-comp-simp) ∙ (comp-agree α β) ∙ horizontal-comp-simp'
  where
    horizontal-comp-simp : α ⋆ β ≡ α ∙ β
    horizontal-comp-simp = remove α β
      where
        -- not hard, just annoying to do directly.
        remove :
          {A : Set} {a b c : A} (p : a ≡ b) (q : b ≡ c) → (p ∙ refl) ∙ q ≡ p ∙ q
        remove refl refl = refl

    horizontal-comp-simp' : α ⋆' β ≡ β ∙ α
    horizontal-comp-simp' = remove β α
      where
        remove :
          {A : Set} {a b c : A} (p : a ≡ b) (q : b ≡ c) → p ∙ (q ∙ refl) ≡ p ∙ q
        remove refl refl = refl

-- Lemma 2.2.1 action on paths preserve path equality
ap :
  ∀ {n m} {A : Set n} {B : Set m} {x y : A} →
  (f : A → B) (p : x ≡ y) → f x ≡ f y
ap f refl = refl

-- Lemma 2.2.2 functions are functors
-- (i) functions preserves composition
ap-preserves-composition :
  ∀ {n m} {A : Set n} {B : Set m} {x y z : A} {f : A → B} →
  (p : x ≡ y) (q : y ≡ z) →
  ap f (p ∙ q) ≡ (ap f p) ∙ (ap f q)
ap-preserves-composition refl q = refl

-- (ii) functions preserves inverses
ap-preserves-inverses :
  ∀ {n m} {A : Set n} {B : Set m} {x y z : A} {f : A → B} →
  (p : x ≡ y) →
  ap f (inv p) ≡ inv (ap f p)
ap-preserves-inverses refl = refl

-- (iii) functors compose
_∘_ :
  ∀ {n m p} {A : Set n} {B : A → Set m} {C : (x : A) → B x → Set p} →
  (g : {x : A} → (y : B x) → C x y) (f : (x : A) → B x) →
  (x : A) → C x (f x)
(g ∘ f) x = g (f x)

ap-preserves-function-composition :
  ∀ {n} {A B C : Set n} {x y z : A} {f : A → B} {g : B → C} →
  (p : x ≡ y) →
  ap g (ap f p) ≡ ap (g ∘ f) p
ap-preserves-function-composition refl = refl

-- (iv) identity maps to identity
ap-identity-map :
  ∀ {n} {A : Set n} {x y : A} →
  (p : x ≡ y) →
  ap (λ x → x) p ≡ p
ap-identity-map refl = refl

-- Lemma 2.3.1 transport
transport :
  ∀ {n m} {A : Set n} {x y : A} →
  (P : A → Set m) (p : x ≡ y) →
  P x → P y
transport _ refl x = x

-- Lemma 2.3.4 dependent action on paths
apd :
  ∀ {n m} {A : Set n} {B : A → Set m} {x y : A} →
  (f : (x : A) → B x) →
  (p : x ≡ y) →
  transport B p (f x) ≡ f y
apd f refl = refl

-- Lemma 2.3.5 non-dependent transport moves around ap path
transport-const :
  ∀ {n} {A B : Set n} {x y : A} →
  (p : x ≡ y) (b : B) →
  transport (λ _ → B) p b ≡ b
transport-const refl b = refl

-- Lemma 2.3.8 relation between dependent and nondependent transport
apd-ap :
  ∀ {n} {A B : Set n} {x y : A} →
  (f : A → B) (p : x ≡ y) →
  apd f p ≡ (transport-const p (f x)) ∙ (ap f p)
apd-ap f refl = refl

-- Lemma 2.3.9 transport unrolling
transport-unroll :
  ∀ {n m} {A : Set n} {P : A → Set m} {x y z : A} →
  (p : x ≡ y) (q : y ≡ z) →
  {u : P x} → transport P q (transport P p u) ≡ transport P (p ∙ q) u
transport-unroll refl refl = refl

-- Lemma 2.3.10 transport over ap
transport-ap :
  ∀ {n m} {A B : Set n} {P : B → Set m} {x y : A} →
  (f : A → B) (p : x ≡ y) →
  {u : P (f x)} → transport (P ∘ f) p u ≡ transport P (ap f p) u
transport-ap f refl = refl

-- Lemma 2.3.11 transport naturality
transport-natural :
  ∀ {n m} {A : Set n} {P Q : A → Set m} {x y : A} →
  (f : (x : A) → P x → Q x) (p : x ≡ y) →
  {u : P x} → transport Q p (f x u) ≡ f y (transport P p u)
transport-natural f refl = refl

-- Definition 2.4.1 homotopy between functions
homotopy : ∀ {n m} {A : Set n} {P : A → Set m} → (f g : (x : A) → P x) → Set (n ⊔ m)
homotopy {A = A} f g = (x : A) → f x ≡ g x

_~_ = homotopy
infixl 10 _~_

-- Lemma 2.4.2 homotopy is an equivalence relation
homotopy-refl :
  ∀ {n m} {A : Set n} {P : A → Set m} →
  (f : (x : A) → P x) → f ~ f
homotopy-refl f x = refl

homotopy-sym :
  ∀ {n m} {A : Set n} {P : A → Set m} →
  (f g : (x : A) → P x) → f ~ g → g ~ f
homotopy-sym f g f-g-hom x = inv (f-g-hom x)

homotopy-trans :
  ∀ {n m} {A : Set n} {P : A → Set m} →
  (f g h : (x : A) → P x) → f ~ g → g ~ h → f ~ h
homotopy-trans f g h f-g-hom g-h-hom x = (f-g-hom x) ∙ (g-h-hom x)

-- Lemma 2.4.3 homotopies are natural transformations between functions
homotopy-natural :
  ∀ {n} {A B : Set n} {x y : A} {p : x ≡ y} →
  (f g : A → B) (H : f ~ g) →
  (H x) ∙ (ap g p) ≡ (ap f p) ∙ (H y)
homotopy-natural {x = x} {p = refl} f g h = right-id (h x)

-- Corollary 2.4.4 naturality over identity
homotopy-natural-id :
  ∀ {n} {A : Set n} →
  (f : A → A) (H : f ~ (λ x → x)) →
  {x : A} → H (f x) ≡ ap f (H x)
homotopy-natural-id f H {x = x} = remove-ends (H x) (inv commute-square)
  where
    f-x-path : f x ≡ x
    f-x-path = H x

    -- annoying to reason about, not hard
    replace-inline :
      ∀ {n} {A : Set n} {x y z : A} →
      {p : x ≡ y} {q q' : y ≡ z} {r : x ≡ z} →
      p ∙ q ≡ r → q ≡ q' → p ∙ q' ≡ r
    replace-inline {p = refl} q-r q-q' = (inv q-q') ∙ q-r

    commute-square : (ap f (H x)) ∙ (H x) ≡ (H (f x)) ∙ (H x)
    commute-square = inv
      (replace-inline
      (homotopy-natural {p = f-x-path} f (λ x → x) H)
      (ap-identity-map (H x)))

    -- annoying to reason about, not hard
    remove-ends :
      ∀ {n} {A : Set n} {x y z : A} →
      {p p' : x ≡ y} → (q : y ≡ z) →
      p ∙ q ≡ p' ∙ q → p ≡ p'
    remove-ends {p = p} {p' = p'} refl p-q-eq-p'-eq =
      (inv (right-id p)) ∙ p-q-eq-p'-eq ∙ (right-id p')

-- Definition 2.4.6 quasi-inverse
record qinv {n m : Level} {A : Set n} {B : Set m} (f : A → B) : Set (n ⊔ m) where
  constructor _st_and_
  field
    g : B → A
    α : f ∘ g ~ λ x → x
    β : g ∘ f ~ λ x → x

-- Example 2.4.7 the identity function is a quasi-inverse
id-qinv : ∀ {n} {A : Set n} → qinv {A = A} {B = A} (λ x → x)
id-qinv = (λ x → x) st (λ x → refl) and (λ x → refl)

-- Example 2.4.8 path concats are quasi-inverses
preconcat-qinv :
  ∀ {n} {A : Set n} {x y z : A} →
  (p : x ≡ y) → qinv (λ (q : y ≡ z) → p ∙ q)
preconcat-qinv {x = x} {y = y} {z = z} p =
  g st α and β
  where
    f : y ≡ z → x ≡ z
    f q = p ∙ q

    g : x ≡ z → y ≡ z
    g pq = (inv p) ∙ pq

    α : (f ∘ g) ~ λ x → x
    α refl = simpl p
      where
        simpl : ∀ {n} {A : Set n} {x y : A} → (p : x ≡ y) → p ∙ ((inv p) ∙ refl) ≡ refl
        simpl refl = refl

    β : (g ∘ f) ~ λ x → x
    β refl = simpl p
      where
        simpl : ∀ {n} {A : Set n} {x y : A} → (p : x ≡ y) → (inv p) ∙ (p ∙ refl) ≡ refl
        simpl refl = refl

postconcat-qinv :
  ∀ {n} {A : Set n} {x y z : A} →
  (p : x ≡ y) → qinv (λ (q : z ≡ x) → q ∙ p)
postconcat-qinv {x = x} {y = y} {z = z} p =
  g st α and β
  where
    f : z ≡ x → z ≡ y
    f q = q ∙ p

    g : z ≡ y → z ≡ x
    g qp = qp ∙ (inv p)

    α : (f ∘ g) ~ λ x → x
    α refl = left-inv p

    β : (g ∘ f) ~ λ x → x
    β refl = right-inv p

-- Example 2.4.9 transport over paths induces a quasi-inverse over the inverse path
transport-qinv :
  ∀ {n m} {A : Set n} {x y : A} →
  (P : A → Set m) (p : x ≡ y) →
  qinv (transport P p)
transport-qinv {x = x} {y = y} P p =
  g st α and β
    where
      f : P x → P y
      f = transport P p

      g : P y → P x
      g = transport P (inv p)

      transport-equiv-paths :
        ∀ {n m} {A : Set n} {x y : A} →
        (P : A → Set m) (p q : x ≡ y) →
        p ≡ q → {n : P x} → transport P p n ≡ transport P q n
      transport-equiv-paths P p .p refl = refl

      transport-refl-paths :
        ∀ {n m} {A : Set n} {x : A} →
        (P : A → Set m) (p : x ≡ x) →
        p ≡ refl → {n : P x} → transport P p n ≡ n
      transport-refl-paths P p p-refl {n = n} =
        transport-equiv-paths P p refl p-refl {n = n}

      α : (f ∘ g) ~ λ x → x
      α x =
        (transport-unroll {P = P} (inv p) p) ∙
        (transport-refl-paths P ((inv p) ∙ p) (left-inv p) {n = x})

      β : (g ∘ f) ~ λ x → x
      β x =
        (transport-unroll {P = P} p (inv p)) ∙
        (transport-refl-paths P _ (right-inv p))

-- 2.4.10 a specific definition of equivalence
record isequiv {n m : Level} {A : Set n} {B : Set m} (f : A → B) : Set (n ⊔ m) where
  constructor _st_also_st_
  field
    g : B → A
    α : f ∘ g ~ λ x → x
    h : B → A
    β : h ∘ f ~ λ x → x

-- (i) quasi-inverses induce equivalences
qinv-to-isequiv :
  ∀ {n m} {A : Set n} {B : Set m} → (f : A → B) → qinv f → isequiv f
qinv-to-isequiv f (g st α and β) = g st α also g st β

-- (ii) equivalences induce quasi-inverses
isequiv-to-qinv :
  ∀ {n m} {A : Set n} {B : Set m} → (f : A → B) → isequiv f → qinv f
isequiv-to-qinv {A} {B} f (g st α also h st β) = g st α and β'
  where
    g~h∘f∘g : g ~ (h ∘ (f ∘ g))
    g~h∘f∘g x = inv (β (g x))

    h∘f∘g~h : (h ∘ (f ∘ g)) ~ h
    h∘f∘g~h x = ap h (α x)

    g~h : g ~ h
    g~h = homotopy-trans _ _ _ g~h∘f∘g h∘f∘g~h

    β' : g ∘ f ~ λ x → x
    β' x = g~h (f x) ∙ (β x)

-- Definition 2.4.11 equivalence between types
record _≃_ {n : Level} (A B : Set n) : Set n where
  constructor _withequiv_
  field
    f : A → B
    e : isequiv f

-- Lemma 2.4.12 type equivalence is a equivalence relation
equiv-refl : ∀ {n} {A : Set n} → A ≃ A
equiv-refl =
  (λ x → x) withequiv
  (qinv-to-isequiv (λ x → x) ((λ x → x) st (λ x → refl) and (λ x → refl)))

equiv-sym : ∀ {n} {A B : Set n} → A ≃ B → B ≃ A
equiv-sym (f withequiv equiv) with (isequiv-to-qinv f equiv)
... | g st α and β = g withequiv qinv-to-isequiv g (f st β and α)

equiv-trans : ∀ {n} {A B C : Set n} → A ≃ B → B ≃ C → A ≃ C
equiv-trans (fab withequiv equivab) (fbc withequiv equivbc)
  with (isequiv-to-qinv fab equivab) | (isequiv-to-qinv fbc equivbc)
... | gab st αab and βab | gbc st αbc and βbc =
      (fbc ∘ fab) withequiv
      (qinv-to-isequiv (fbc ∘ fab) ((gab ∘ gbc)
        st (λ x → ap fbc (αab (gbc x)) ∙ (αbc x))
        and λ x → ap gab (βbc (fab x)) ∙ (βab x)))

record _×_ {n m : Level} (A : Set n) (B : Set m) : Set (n ⊔ m) where
  constructor _,,_
  field
    fst : A
    snd : B

fst : ∀ {n m} {A : Set n} {B : Set m} → A × B → A
fst (fst ,, snd) = fst

snd : ∀ {n m} {A : Set n} {B : Set m} → A × B → B
snd (fst ,, snd) = snd

-- Function 2.6.1 a path between products induces a pair of paths between elements
product-path-to-elem-path :
  ∀ {n m} {A : Set n} {B : Set m} {x y : A × B} →
  x ≡ y → (fst x ≡ fst y) × (snd x ≡ snd y)
product-path-to-elem-path refl = refl ,, refl

-- Theorem 2.6.2 product path to element paths is an equivalence
product-path-to-elem-path-equiv :
  ∀ {n m} {A : Set n} {B : Set m} {x y : A × B} →
  isequiv (product-path-to-elem-path {A = A} {B = B} {x = x} {y = y})
product-path-to-elem-path-equiv {A = A} {B = B} {x = x} {y = y} =
  qinv-to-isequiv product-path-to-elem-path (g st α and β)
    where
      f = product-path-to-elem-path

      g : (fst x ≡ fst y) × (snd x ≡ snd y) → x ≡ y
      g = g' x y
        where
          g' : (x y : A × B) → (fst x ≡ fst y) × (snd x ≡ snd y) → x ≡ y
          g' (fst₁ ,, snd₁) (.fst₁ ,, .snd₁) (refl ,, refl) = refl

      α : f ∘ g ~ λ x → x
      α (refl ,, refl) = refl

      β : g ∘ f ~ λ x → x
      β refl = refl

-- Theorem 2.6.4 transport over a path to a product fiber is a product of fibers over a path
product-transport :
  ∀ {n m} {Z : Set n} {A B : Z → Set m} {z w : Z} →
  (p : z ≡ w) (x : (A z) × (B z))  →
  transport (λ z → (A z) × (B z)) p x ≡ (transport A p (fst x) ,, transport B p (snd x))
product-transport refl (fst ,, snd) = refl

-- Definition of pair⁼
pair⁼ :
  ∀ {n m} {A : Set n} {B : Set m} {x y : A × B} →
  (fst x ≡ fst y) × (snd x ≡ snd y) →
  x ≡ y
pair⁼ {A = A} {B = B} {x = x} {y = y} =
  isequiv.g (product-path-to-elem-path-equiv {A = A} {B = B} {x = x} {y = y})

-- Theorem 2.6.5 functions are functors over products
function-functor-pair :
  {A B A' B' : Set} →
  (g : A → A') (h : B → B') →
  {x y : A × B} {p : fst x ≡ fst y} {q : snd x ≡ snd y} →
  ap (λ x → (g (fst x) ,, h (snd x))) (pair⁼ (p ,, q)) ≡ pair⁼ (ap g p ,, ap h q)
function-functor-pair g h {x = fstx ,, sndx} {y = .fstx ,, .sndx} {p = refl} {q = refl} = refl

-- Theorem 2.7.2 dependent functions are fibrations over Σ-types
record Sigma (A : Set) (B : A → Set) : Set where
  constructor _,,_
  field
    pr1 : A
    pr2 : B pr1

syntax Sigma A (λ x → y) = Σ x of A , y

pr1 : {A : Set} {B : A → Set} → Σ x of A , B x → A
pr1 (left ,, right) = left

pr2 : {A : Set} {B : A → Set} → (v : Σ x of A , B x) → B (pr1 {A} {B} v)
pr2 (left ,, right) = right

-- Theorem 2.7.2 dependent functions are functors over fibrations
function-fibration-product :
  {A : Set} {P : A → Set} {w w' : Σ x of A , P x} →
  (w ≡ w') ≃ (Σ p of (pr1 w ≡ pr1 w') , (transport P p (pr2 w) ≡ pr2 w'))
function-fibration-product {A = A} {P = P} {w = w} {w' = w'} =
  f withequiv qinv-to-isequiv f (g st α and β)
  where
    f :
      {w w' : Σ x of A , P x} →
      (w ≡ w') → (Σ p of (pr1 w ≡ pr1 w') , (transport P p (pr2 w) ≡ pr2 w'))
    f refl = refl ,, refl

    g :
      {w w' : Σ x of A , P x} →
      (Σ p of (pr1 w ≡ pr1 w') , (transport P p (pr2 w) ≡ pr2 w')) → (w ≡ w')
    g {w = w1 ,, w2} {w' = .w1 ,, .w2} (refl ,, refl) = refl

    α : f ∘ g ~ λ x → x
    α (refl ,, refl) = refl

    β : g ∘ f ~ λ x → x
    β refl = refl

-- Corollary 2.7.3 computation rule for Σ types
computation-sigma :
  {A : Set} {P : A → Set} →
  (z : Σ x of A , P x) → z ≡ (pr1 z ,, pr2 z)
computation-sigma z =
  isequiv.g (_≃_.e function-fibration-product)
  (refl ,, refl)

-- Theorem 2.8.1 : only one path between unit elements
record Unit : Set where
  constructor unit

single-path-between-unit : {x y : Unit} → (x ≡ y) ≃ Unit
single-path-between-unit {x = x} {y = y} =
  f withequiv qinv-to-isequiv f
  (g st α and β)
  where
    f : x ≡ y → Unit
    f _ = unit

    g : {x y : Unit} → Unit → x ≡ y
    g {x = unit} {y = unit} _ = refl

    α : f ∘ g ~ λ x → x
    α unit = refl

    β : g ∘ f ~ λ x → x
    β refl = refl

-- Theorem 2.9.2 path between functions are homotopies
happly :
  ∀ {n m} {A : Set n} {B : A → Set m} {f g : (x : A) → B x} →
  (f ≡ g) → f ~ g
happly refl x = refl

-- Axiom 2.9.3 function extensionality
postulate
  funext-equiv : ∀ {n m} {A : Set n} {B : A → Set m} {f g : (x : A) → B x} →
    isequiv (happly {A = A} {B = B} {f = f} {g = g})

funext :
  ∀ {n m} {A : Set n} {B : A → Set m} {f g : (x : A) → B x} →
  f ~ g → f ≡ g
funext = isequiv.g funext-equiv

-- Lemma 2.9.6
function-path-transport-equiv :
  ∀ {n m} {X : Set n} {A B : X → Set m} {x y : X} →
  {p : x ≡ y} (f : A x → B x) (g : A y → B y) →
  (transport (λ x → A x → B x) p f ≡ g) ≃
    ((a : A x) → (transport B p (f a) ≡ g (transport A p a)))
function-path-transport-equiv {p = refl} f g = happly withequiv funext-equiv

-- Lemma 2.10.1 paths between types are equivalences.
id-to-equiv : ∀ {n} {A B : Set n} → A ≡ B → A ≃ B
id-to-equiv refl = equiv-refl

-- Axiom 2.10.3 univalence axiom.
postulate univalence-equiv : ∀ {n} {A B : Set n} → isequiv (id-to-equiv {A = A} {B = B})


module TelescopingLet5 where

postulate
  A : Set
  a : A

module B (a : A) where
   postulate
     C : Set
-- B.C : (a : A) → Set

module N = B a
module M' (open N) (c : C) where
  postulate cc : C
-- M.cc : (a : B.A a) → B.A a

E = let open B a in C

module M (open B a) (x : A) where
  D = C
  postulate cc : C
-- M.cc : (a : B.A a) → B.A a