├── .gitignore ├── Tactic-Set.agda └── Tactic.agda /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai -------------------------------------------------------------------------------- /Tactic-Set.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K #-} 2 | 3 | module Tactic-Set where 4 | 5 | open import Agda.Primitive 6 | open import Agda.Builtin.Bool 7 | open import Agda.Builtin.Equality 8 | open import Agda.Builtin.List 9 | open import Agda.Builtin.Nat 10 | open import Agda.Builtin.Sigma renaming (_,_ to _,,_) 11 | 12 | module Util where 13 | 14 | private variable 15 | u : Level 16 | A B : Set u 17 | a b c : A 18 | 19 | id : A -> A 20 | id x = x 21 | 22 | map : (A -> B) -> List A -> List B 23 | map f [] = [] 24 | map f (x ∷ xs) = f x ∷ map f xs 25 | 26 | _++_ : List A -> List A -> List A 27 | [] ++ ys = ys 28 | (x ∷ xs) ++ ys = x ∷ (xs ++ ys) 29 | 30 | open Util 31 | 32 | private variable 33 | u : Level 34 | A B C D X : Set 35 | XS : List Set 36 | P : A -> Set 37 | a b : A 38 | 39 | data Env : List Set -> Set₁ where 40 | ∅ : Env [] 41 | _◂_ : X -> Env XS -> Env (X ∷ XS) 42 | infixr 20 _◂_ 43 | 44 | hd : Env (X ∷ XS) -> X 45 | hd (x ◂ xs) = x 46 | 47 | by_ : (Env [] -> Env (A ∷ [])) -> A 48 | by tactics with tactics ∅ 49 | ... | x ◂ ∅ = x 50 | infixr 1 by_ 51 | 52 | _,_ : ∀{u v w} {A : Set u} {B : Set v} {C : Set w} -> (B -> C) -> (A -> B) -> A -> C 53 | f , g = λ x -> f (g x) 54 | infixr 2 _,_ 55 | 56 | _∎ : (Env [] -> Env XS) -> Env [] -> Env XS 57 | _∎ = id 58 | infixl 1.5 _∎ 59 | 60 | record Casing (A : Set) : Set₁ where 61 | constructor casing 62 | field 63 | Types : List (Set -> Set) 64 | cases : A -> Env (map (λ t -> t X) Types ++ XS) -> Env (X ∷ XS) 65 | open Casing {{...}} using (cases) 66 | 67 | record Inductive (A : Set) : Set₁ where 68 | constructor induct 69 | field 70 | Types : List ((A -> Set) -> Set) 71 | induction : (a : A) -> Env (map (λ t -> t P) Types ++ XS) -> Env (P a ∷ XS) 72 | open Inductive {{...}} using (induction) 73 | 74 | instance 75 | _ : Casing Bool 76 | _ = record 77 | { Types = id ∷ id ∷ [] 78 | ; -- cases : Bool -> Env (X ∷ X ∷ xs) -> Env (X ∷ XS) 79 | cases = λ 80 | { true (t ◂ f ◂ xs) -> t ◂ xs 81 | ; false (z ◂ f ◂ xs) -> f ◂ xs 82 | } 83 | } 84 | 85 | _ : Casing Nat 86 | _ = record 87 | { Types = id ∷ (λ A -> (Nat -> A)) ∷ [] 88 | ; -- cases : Nat -> Env (A ∷ (Nat -> A) ∷ XS) -> Env (A ∷ XS) 89 | cases = λ 90 | { zero (z ◂ f ◂ xs) -> z ◂ xs 91 | ; (suc n) (z ◂ f ◂ xs) -> f n ◂ xs 92 | } 93 | } 94 | 95 | _ : Inductive Bool 96 | _ = record 97 | { Types = (λ P -> P true) ∷ (λ P -> P false) ∷ [] 98 | ; -- induction : (b : Bool) -> Env (P true ∷ P flase ∷ XS) -> Env (P b ∷ XS) 99 | induction = λ 100 | { true (t ◂ f ◂ xs) -> t ◂ xs 101 | ; false (z ◂ f ◂ xs) -> f ◂ xs 102 | } 103 | } 104 | 105 | _ : Inductive Nat 106 | _ = record 107 | { Types = (λ P -> P zero) ∷ (λ P -> (∀ n -> P n -> P (suc n))) ∷ [] 108 | ; -- induction : (n : Nat) -> Env (P zero ∷ (∀ n -> P n -> P (suc n)) ∷ XS) -> Env (P n ∷ XS) 109 | induction = λ 110 | { n (z ◂ f ◂ xs) -> helper n z f ◂ xs 111 | } 112 | } 113 | where 114 | helper : {P : Nat -> Set} -> (n : Nat) -> P zero -> (∀ n -> P n -> P (suc n)) -> P n 115 | helper zero z f = z 116 | helper (suc n) z f = f n (helper n z f) 117 | 118 | -- inductiveΣ : Inductive (Σ A P) 119 | -- inductiveΣ {A} {P} = record 120 | -- { Types = (λ C -> (∀ (a : A) -> (p : P a) -> C (a ,, p))) ∷ [] 121 | -- ; -- induction : (s : Σ A P) -> Env ((∀ (a : A) -> (p : P a) -> C (a ,, p)) ∷ XS) -> Env (C s ∷ XS) 122 | -- induction = λ 123 | -- { (a ,, p) (f ◂ xs) -> f a p ◂ xs 124 | -- } 125 | -- } 126 | 127 | inductive≡ : Inductive (Σ A (λ x -> Σ A (x ≡_))) 128 | inductive≡ {A} = record 129 | { Types = (λ C -> (∀ (a : A) -> C (a ,, a ,, refl))) ∷ [] 130 | ; -- 131 | induction = λ 132 | { (a ,, a ,, refl) (f ◂ xs) -> f a ◂ xs 133 | } 134 | } 135 | 136 | record App (A : Set) : Set₁ where 137 | constructor app 138 | field 139 | Froms : List Set 140 | To : Set 141 | apply : A -> Env (Froms ++ XS) -> Env (To ∷ XS) 142 | open App {{...}} using (apply) 143 | 144 | instance 145 | AppZ : App A 146 | AppZ {A = A} = record 147 | { Froms = [] 148 | ; To = A 149 | ; apply = λ a xs -> a ◂ xs 150 | } 151 | AppS : {{App B}} -> App (A -> B) 152 | AppS {A = A} {{app F T ap}} = record 153 | { Froms = A ∷ F 154 | ; To = T 155 | ; apply = λ {f (a ◂ fxs) -> ap (f a) fxs} 156 | } 157 | 158 | exact : X -> Env XS -> Env (X ∷ XS) 159 | exact = apply 160 | 161 | apply1 : ((a : A) -> P a) -> (env : Env (A ∷ XS)) -> Env (P (hd env) ∷ XS) 162 | apply1 f (a ◂ xs) = f a ◂ xs 163 | 164 | apply2 : (A -> B -> C) -> Env (A ∷ B ∷ XS) -> Env (C ∷ XS) 165 | apply2 f (a ◂ b ◂ xs) = f a b ◂ xs 166 | 167 | apply3 : (A -> B -> C -> D) -> Env (A ∷ B ∷ C ∷ XS) -> Env (D ∷ XS) 168 | apply3 f (a ◂ b ◂ c ◂ xs) = f a b c ◂ xs 169 | 170 | reflexivity : Env XS -> Env ((a ≡ a) ∷ XS) 171 | reflexivity = exact refl 172 | 173 | goal : (X : Set) -> Env (X ∷ XS) -> Env (X ∷ XS) 174 | goal _ = id 175 | -- syntax goal A tactics = goal A , tactics 176 | -- infixr 2 goal 177 | 178 | rw : {P : A -> Set} -> a ≡ b -> Env (P b ∷ XS) -> Env (P a ∷ XS) 179 | rw refl xs = xs 180 | 181 | intro-ty-syntax : (A : Set) {P : A -> Set} -> ((a : A) -> Env [] -> Env (P a ∷ [])) -> Env XS -> Env (((a : A) -> P a) ∷ XS) 182 | intro-ty-syntax _ tactics xs = (λ a -> by tactics a) ◂ xs 183 | syntax intro-ty-syntax A (λ a -> b) = intro a ∶ A ,, b 184 | infixr 2 intro-ty-syntax 185 | 186 | intro-syntax : ((a : A) -> Env [] -> Env (P a ∷ [])) -> Env XS -> Env (((a : A) -> P a) ∷ XS) 187 | intro-syntax = intro-ty-syntax _ 188 | syntax intro-syntax (λ a -> b) = intro a ,, b 189 | infixr 2 intro-syntax 190 | 191 | intro'-ty-syntax : (A : Set) {P : A -> Set} -> ((a : A) -> Env [] -> Env (P a ∷ [])) -> Env XS -> Env (({a : A} -> P a) ∷ XS) 192 | intro'-ty-syntax _ tactics xs = (λ {a} -> by tactics a) ◂ xs 193 | syntax intro'-ty-syntax A (λ a -> b) = intro' a ∶ A ,, b 194 | infixr 2 intro'-ty-syntax 195 | 196 | intro'-syntax : ((a : A) -> Env [] -> Env (P a ∷ [])) -> Env XS -> Env (({a : A} -> P a) ∷ XS) 197 | intro'-syntax = intro'-ty-syntax _ 198 | syntax intro'-syntax (λ a -> b) = intro' a ,, b 199 | infixr 2 intro'-syntax 200 | 201 | have-ty-syntax : (A : Set u) {P : A -> Set} -> (a : A) -> ((a : A) -> Env [] -> Env (P a ∷ [])) -> Env XS -> Env (P a ∷ XS) 202 | have-ty-syntax _ a f xs = (by f a) ◂ xs -- subgoal = apply1 (λ f -> f subgoal) -- (f ◂ xs) = f have ◂ xs 203 | syntax have-ty-syntax A subgoal (λ a -> b) = have a ∶ A := subgoal ,, b 204 | infixr 2 have-ty-syntax 205 | 206 | have-syntax : {A : Set u} {P : A -> Set} -> (a : A) -> ((a : A) -> Env [] -> Env (P a ∷ [])) -> Env XS -> Env (P a ∷ XS) 207 | have-syntax = have-ty-syntax _ 208 | syntax have-syntax subgoal (λ a -> b) = have a := subgoal ,, b 209 | infixr 2 have-syntax 210 | 211 | module Examples where 212 | 213 | boolToNat : Bool -> Nat 214 | boolToNat b = by 215 | cases b , 216 | exact 1 , 217 | exact 0 ∎ 218 | 219 | _ : boolToNat true ≡ 1 220 | _ = refl 221 | 222 | _ : boolToNat false ≡ 0 223 | _ = refl 224 | 225 | pred : Nat -> Nat 226 | pred n = by 227 | cases n , 228 | exact 0 , 229 | exact id ∎ 230 | 231 | _ : pred 5 ≡ 4 232 | _ = refl 233 | 234 | _ : pred 0 ≡ 0 235 | _ = refl 236 | 237 | succ : Nat -> Nat 238 | succ = by 239 | intro n ,, 240 | apply suc , 241 | exact n ∎ 242 | 243 | _ : succ 3 ≡ 4 244 | _ = refl 245 | 246 | 247 | private variable 248 | f g h : A -> B 249 | 250 | _~_ : (f g : A -> B) -> Set 251 | f ~ g = ∀ x -> f x ≡ g x 252 | 253 | refl~ : f ~ f 254 | refl~ x = by 255 | reflexivity ∎ 256 | 257 | sym~ : f ~ g -> g ~ f 258 | sym~ = by 259 | intro H ,, intro x ,, 260 | have sym ∶ ({A : Set} {a b : A} -> a ≡ b -> b ≡ a) := by 261 | intro' a ,, intro' b ,, 262 | intro eq ∶ a ≡ b ,, 263 | induction {P = λ {(a ,, b ,, _) -> b ≡ a}} (a ,, b ,, eq) , 264 | intro x ,, 265 | reflexivity ∎ ,, 266 | apply sym , 267 | exact (H x) ∎ 268 | 269 | trans~ : f ~ g -> g ~ h -> f ~ h 270 | trans~ H1 H2 x = by 271 | have trans ∶ ({A : Set} {a b c : A} -> a ≡ b -> b ≡ c -> a ≡ c) 272 | := (λ {refl refl -> refl}) ,, 273 | apply trans , 274 | exact (H1 x) , 275 | exact (H2 x) ∎ 276 | 277 | 278 | zero-plus : ∀ n -> 0 + n ≡ n 279 | zero-plus n = by 280 | reflexivity ∎ 281 | 282 | plus-zero : ∀ n -> n + 0 ≡ n 283 | plus-zero n = by 284 | induction {P = λ n -> n + 0 ≡ n} n , 285 | reflexivity , 286 | intro n ,, intro ih ,, 287 | rw {P = λ x -> suc x ≡ suc n} ih , 288 | reflexivity ∎ 289 | -------------------------------------------------------------------------------- /Tactic.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --without-K #-} 2 | 3 | module Tactic where 4 | 5 | open import Agda.Primitive 6 | open import Agda.Builtin.Bool 7 | open import Agda.Builtin.Equality 8 | open import Agda.Builtin.Nat 9 | open import Agda.Builtin.Sigma renaming (_,_ to _,,_) 10 | 11 | record 𝒰 : Setω where 12 | constructor ⦅_⦆ 13 | field 14 | {ℓ} : Level 15 | Ty : Set ℓ 16 | open 𝒰 public 17 | 18 | {-# NO_UNIVERSE_CHECK #-} 19 | data List (A : Setω) : Set where 20 | [] : List A 21 | _∷_ : A -> List A -> List A 22 | open List public 23 | infixr 5 _∷_ 24 | 25 | private variable 26 | u v : Level 27 | A B C D E : Set u 28 | P : A -> Set u 29 | a b c : A 30 | α β γ : Setω 31 | U : 𝒰 32 | US : List 𝒰 33 | 34 | sigma-syntax : (A : Set u) (B : A -> Set v) → Set (u ⊔ v) 35 | sigma-syntax = Σ 36 | 37 | syntax sigma-syntax A (λ a -> B) = Σ[ a ∶ A ] B 38 | infixr 2 sigma-syntax 39 | 40 | _++_ : List α -> List α -> List α 41 | [] ++ ys = ys 42 | (x ∷ xs) ++ ys = x ∷ (xs ++ ys) 43 | 44 | data Env : List 𝒰 -> Setω where 45 | ∅ : Env [] 46 | _◂_ : A -> Env US -> Env (⦅ A ⦆ ∷ US) 47 | infixr 5 _◂_ 48 | 49 | by_ : (Env [] -> Env (⦅ A ⦆ ∷ [])) -> A 50 | by tactics with tactics ∅ 51 | ... | x ◂ ∅ = x 52 | infixr 0 by_ 53 | 54 | _,_ : (β -> γ) -> (α -> β) -> α -> γ 55 | f , g = λ x -> f (g x) 56 | infixr 2 _,_ 57 | 58 | _∎ : (Env [] -> Env US) -> Env [] -> Env US 59 | tactics ∎ = tactics 60 | infixl 1 _∎ 61 | 62 | record Casing (A : Set u) : Setω where 63 | constructor casing 64 | field 65 | Types : Set v -> List 𝒰 66 | cases : A -> Env (Types C ++ US) -> Env (⦅ C ⦆ ∷ US) 67 | open Casing {{...}} using (cases) 68 | 69 | record Inductive (A : Set u) : Setω where 70 | constructor induct 71 | field 72 | Types : (A -> Set v) -> List 𝒰 73 | induction : (a : A) -> Env (Types P ++ US) -> Env (⦅ P a ⦆ ∷ US) 74 | open Inductive {{...}} using (induction) 75 | 76 | instance 77 | _ : Casing Bool 78 | _ = record 79 | { Types = λ C -> ⦅ C ⦆ ∷ ⦅ C ⦆ ∷ [] 80 | ; cases = λ 81 | { true (t ◂ f ◂ xs) -> t ◂ xs 82 | ; false (z ◂ f ◂ xs) -> f ◂ xs 83 | } 84 | } 85 | 86 | _ : Casing Nat 87 | _ = record 88 | { Types = λ C -> ⦅ C ⦆ ∷ ⦅ (Nat -> C) ⦆ ∷ [] 89 | ; cases = λ 90 | { zero (z ◂ s ◂ xs) -> z ◂ xs 91 | ; (suc n) (z ◂ s ◂ xs) -> s n ◂ xs 92 | } 93 | } 94 | 95 | _ : Inductive Bool 96 | _ = record 97 | { Types = λ P -> ⦅ P true ⦆ ∷ ⦅ P false ⦆ ∷ [] 98 | ; induction = λ 99 | { true (t ◂ f ◂ xs) -> t ◂ xs 100 | ; false (t ◂ f ◂ xs) -> f ◂ xs 101 | } 102 | } 103 | 104 | _ : Inductive Nat 105 | _ = record 106 | { Types = λ P -> ⦅ P zero ⦆ ∷ ⦅ (∀ n -> P n -> P (suc n)) ⦆ ∷ [] 107 | ; induction = λ { n (z ◂ f ◂ xs) -> helper n z f ◂ xs } 108 | } where 109 | helper : ∀ n -> P zero -> (∀ n -> P n -> P (suc n)) -> P n 110 | helper zero z f = z 111 | helper (suc n) z f = f n (helper n z f) 112 | 113 | inductiveΣ : Inductive (Σ A P) 114 | inductiveΣ {A = A} {P = P} = record 115 | { Types = λ C -> ⦅ (∀ a -> (p : P a) -> C (a ,, p)) ⦆ ∷ [] 116 | ; induction = λ { (a ,, p) (f ◂ xs) -> f a p ◂ xs } 117 | } 118 | 119 | inductive≡ : Inductive (Σ[ x ∶ A ] Σ[ y ∶ A ] x ≡ y) 120 | inductive≡ = record 121 | { Types = λ C -> ⦅ (∀ a -> C (a ,, a ,, refl)) ⦆ ∷ [] 122 | ; induction = λ { (a ,, a ,, refl) (f ◂ xs) -> f a ◂ xs } 123 | } 124 | 125 | record App (A : Set u) : Setω where 126 | constructor app 127 | field 128 | Froms : List 𝒰 129 | To : 𝒰 130 | apply : A -> Env (Froms ++ US) -> Env (To ∷ US) 131 | open App {{...}} using (apply) 132 | 133 | instance 134 | AppZ : App A 135 | AppZ {A = A} = record 136 | { Froms = [] 137 | ; To = ⦅ A ⦆ 138 | ; apply = λ a xs -> a ◂ xs 139 | } 140 | AppS : {{App B}} -> App (A -> B) 141 | AppS {A = A} {{app F T ap}} = record 142 | { Froms = ⦅ A ⦆ ∷ F 143 | ; To = T 144 | ; apply = λ { f (a ◂ fxs) -> ap (f a) fxs } 145 | } 146 | 147 | exact : A -> Env US -> Env (⦅ A ⦆ ∷ US) 148 | exact = apply 149 | 150 | apply1 : (A -> B) -> (env : Env (⦅ A ⦆ ∷ US)) -> Env (⦅ B ⦆ ∷ US) 151 | apply1 = apply 152 | 153 | apply2 : (A -> B -> C) -> Env (⦅ A ⦆ ∷ ⦅ B ⦆ ∷ US) -> Env (⦅ C ⦆ ∷ US) 154 | apply2 = apply 155 | 156 | apply3 : (A -> B -> C -> D) -> Env (⦅ A ⦆ ∷ ⦅ B ⦆ ∷ ⦅ C ⦆ ∷ US) -> Env (⦅ D ⦆ ∷ US) 157 | apply3 = apply 158 | 159 | reflexivity : Env US -> Env (⦅ a ≡ a ⦆ ∷ US) 160 | reflexivity = exact refl 161 | 162 | rw : a ≡ b -> Env (⦅ P b ⦆ ∷ US) -> Env (⦅ P a ⦆ ∷ US) 163 | rw refl xs = xs 164 | 165 | record Intro (how : ∀ {u v} {A : Set u} -> (A -> Set v) -> Set (u ⊔ v)) : Setω where 166 | field 167 | introduce : (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ how P ⦆ ∷ US) 168 | introduce-ty : (A : Set u) {P : A -> Set v} -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ how P ⦆ ∷ US) 169 | introduce-ty _ = introduce 170 | 171 | syntax introduce A (λ a -> b) = introduce a ∶ A ; b 172 | infixr 2 introduce 173 | syntax introduce-ty (λ a -> b) = introduce a ∶ A ; b 174 | infixr 2 introduce-ty 175 | open Intro {{...}} 176 | 177 | instance 178 | _ : Intro (λ P -> (∀ a -> P a)) 179 | _ = record 180 | { introduce = λ tactics xs -> (λ a -> by tactics a) ◂ xs 181 | } 182 | _ : Intro (λ P -> (∀ {a} -> P a)) 183 | _ = record 184 | { introduce = λ tactics xs -> (λ {a} -> by tactics a) ◂ xs 185 | } 186 | 187 | intro-ty-syntax : (A : Set u) {P : A -> Set v} -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ (∀ a -> P a) ⦆ ∷ US) 188 | intro-ty-syntax = introduce-ty 189 | syntax intro-ty-syntax A (λ a -> b) = intro a ∶ A ; b 190 | infixr 2 intro-ty-syntax 191 | 192 | intro-syntax : (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ (∀ a -> P a) ⦆ ∷ US) 193 | intro-syntax = introduce 194 | syntax intro-syntax (λ a -> b) = intro a ; b 195 | infixr 2 intro-syntax 196 | 197 | intro'-ty-syntax : (A : Set u) {P : A -> Set v} -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ (∀ {a} -> P a) ⦆ ∷ US) 198 | intro'-ty-syntax = introduce-ty 199 | syntax intro'-ty-syntax A (λ a -> b) = intro' a ∶ A ; b 200 | infixr 2 intro'-ty-syntax 201 | 202 | intro'-syntax : (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ (∀ {a} -> P a) ⦆ ∷ US) 203 | intro'-syntax = introduce 204 | syntax intro'-syntax (λ a -> b) = intro' a ; b 205 | infixr 2 intro'-syntax 206 | 207 | have-syntax : (a : A) -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ P a ⦆ ∷ US) 208 | have-syntax a f xs = (by f a) ◂ xs 209 | syntax have-syntax subgoal (λ a -> b) = have a := subgoal ; b 210 | infixr 2 have-syntax 211 | 212 | have-ty-syntax : (A : Set u) {P : A -> Set v} -> (a : A) -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ P a ⦆ ∷ US) 213 | have-ty-syntax _ = have-syntax 214 | syntax have-ty-syntax A subgoal (λ a -> b) = have a ∶ A := subgoal ; b 215 | infixr 2 have-ty-syntax 216 | 217 | haveω-syntax : {α : Setω} {P : α -> Set v} -> (a : α) -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ P a ⦆ ∷ US) 218 | haveω-syntax a f xs = (by f a) ◂ xs 219 | syntax haveω-syntax subgoal (λ a -> b) = haveω a := subgoal ; b 220 | infixr 2 haveω-syntax 221 | 222 | haveω-ty-syntax : (α : Setω) {P : α -> Set v} -> (a : α) -> (∀ a -> Env [] -> Env (⦅ P a ⦆ ∷ [])) -> Env US -> Env (⦅ P a ⦆ ∷ US) 223 | haveω-ty-syntax _ = haveω-syntax 224 | syntax haveω-ty-syntax A subgoal (λ a -> b) = haveω a ∶ A := subgoal ; b 225 | infixr 2 haveω-ty-syntax 226 | 227 | module Examples where 228 | 229 | boolToNat : Bool -> Nat 230 | boolToNat b = by 231 | cases b , 232 | exact 1 , 233 | exact 0 ∎ 234 | 235 | _ : boolToNat true ≡ 1 236 | _ = refl 237 | 238 | _ : boolToNat false ≡ 0 239 | _ = refl 240 | 241 | pred : Nat -> Nat 242 | pred n = by 243 | cases n , 244 | exact 0 , 245 | exact (λ x -> x) ∎ 246 | 247 | _ : pred 5 ≡ 4 248 | _ = refl 249 | 250 | _ : pred 0 ≡ 0 251 | _ = refl 252 | 253 | succ : Nat -> Nat 254 | succ = by 255 | intro n ; 256 | apply suc , 257 | exact n ∎ 258 | 259 | _ : succ 3 ≡ 4 260 | _ = refl 261 | 262 | 263 | private variable 264 | f g h : A -> B 265 | 266 | _~_ : (f g : A -> B) -> Set _ 267 | f ~ g = ∀ x -> f x ≡ g x 268 | 269 | refl~ : f ~ f 270 | refl~ x = by 271 | reflexivity ∎ 272 | 273 | sym~ : f ~ g -> g ~ f 274 | sym~ = by 275 | intro H ; intro x ; 276 | haveω sym ∶ (∀ {u} {A : Set u} {a b : A} -> a ≡ b -> b ≡ a) := by 277 | intro' a ; intro' b ; 278 | intro eq ∶ a ≡ b ; 279 | induction {P = λ {(a ,, b ,, _) -> b ≡ a}} (a ,, b ,, eq) , 280 | intro x ; 281 | reflexivity ; 282 | apply sym , 283 | exact (H x) ∎ 284 | 285 | trans~ : {f g h : A -> B} -> f ~ g -> g ~ h -> f ~ h 286 | trans~ {B = B} H1 H2 x = by 287 | have trans ∶ ({a b c : B} -> a ≡ b -> b ≡ c -> a ≡ c) 288 | := (λ {refl refl -> refl}) ; 289 | apply trans , 290 | exact (H1 x) , 291 | exact (H2 x) ∎ 292 | 293 | zero-plus : ∀ n -> 0 + n ≡ n 294 | zero-plus n = by 295 | reflexivity ∎ 296 | 297 | plus-zero : ∀ n -> n + 0 ≡ n 298 | plus-zero n = by 299 | induction {P = λ n -> n + 0 ≡ n} n , 300 | reflexivity , 301 | intro n ; intro ih ; 302 | rw {P = λ x -> suc x ≡ suc n} ih , 303 | reflexivity ∎ 304 | --------------------------------------------------------------------------------