aboutsummaryrefslogtreecommitdiff
path: root/Proj.thy
blob: 291113d9a3f57379ceeb34b30a301ece0f13a954 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
(*  Title:  HoTT/Proj.thy
    Author: Josh Chen
    Date:   Jun 2018

Projection functions ‹fst› and ‹snd› for the dependent sum type.
*)

theory Proj
  imports
    HoTT_Methods
    Prod
    Sum
begin


definition fst :: "Term ⇒ Term" where "fst(p) ≡ ind⇩∑ (λx y. x) p"
definition snd :: "Term ⇒ Term" where "snd(p) ≡ ind⇩∑ (λx y. y) p"

text "Typing judgments and computation rules for the dependent and non-dependent projection functions."

lemma fst_type:
  assumes "∑x:A. B(x): U(i)" and "p: ∑x:A. B(x)" shows "fst(p): A"
unfolding fst_def by (derive lems: assms)

lemma fst_comp:
  assumes "A: U(i)" and "B: A ⟶ U(i)" and "a: A" and "b: B(a)" shows "fst(<a,b>) ≡ a"
unfolding fst_def
proof
  show "a: A" and "b: B(a)" by fact+
qed (rule assms)+

lemma snd_type:
  assumes "∑x:A. B(x): U(i)" and "p: ∑x:A. B(x)" shows "snd(p): B(fst p)"
unfolding snd_def
proof
  show "⋀p. p: ∑x:A. B(x) ⟹ B(fst p): U(i)" by (derive lems: assms fst_type)

  fix x y
  assume asm: "x: A" "y: B(x)"
  show "y: B(fst <x,y>)"
  proof (subst fst_comp)
    show "A: U(i)" by (wellformed lems: assms(1))
    show "⋀x. x: A ⟹ B(x): U(i)" by (wellformed lems: assms(1))
  qed fact+
qed fact

lemma snd_comp:
  assumes "A: U(i)" and "B: A ⟶ U(i)" and "a: A" and "b: B(a)" shows "snd(<a,b>) ≡ b"
unfolding snd_def
proof
  show "⋀x y. y: B(x) ⟹ y: B(x)" .
  show "a: A" by fact
  show "b: B(a)" by fact
qed (simple lems: assms)


text "Rule declarations:"

lemmas Proj_types [intro] = fst_type snd_type
lemmas Proj_comps [comp] = fst_comp snd_comp


end