From e94784953a751b0720689b686e607c95ba0f0592 Mon Sep 17 00:00:00 2001 From: Josh Chen Date: Wed, 15 Aug 2018 00:00:09 +0200 Subject: Function composition, rename path composition to differentiate the two. --- EqualProps.thy | 40 ++++++++++++++++++++-------------------- Prod.thy | 16 ++++++++++++++++ 2 files changed, 36 insertions(+), 20 deletions(-) diff --git a/EqualProps.thy b/EqualProps.thy index 3d99456..2da7e2f 100644 --- a/EqualProps.thy +++ b/EqualProps.thy @@ -48,17 +48,17 @@ text " Raw composition function, of type \\x:A. \y:A. x =\<^sub>A y \ (\z:A. y =\<^sub>A z \ x =\<^sub>A z)\ polymorphic over the type \A\. " -axiomatization rcompose :: Term where - rcompose_def: "rcompose \ \<^bold>\x y p. ind\<^sub>= (\_. \<^bold>\z q. ind\<^sub>= (\x. refl(x)) q) p" +axiomatization reqcompose :: Term where + reqcompose_def: "reqcompose \ \<^bold>\x y p. ind\<^sub>= (\_. \<^bold>\z q. ind\<^sub>= (\x. refl(x)) q) p" text " More complicated proofs---the nested path inductions require more explicit step-by-step rule applications: " -lemma rcompose_type: +lemma reqcompose_type: assumes "A: U(i)" - shows "rcompose: \x:A. \y:A. x =\<^sub>A y \ (\z:A. y =\<^sub>A z \ x =\<^sub>A z)" -unfolding rcompose_def + shows "reqcompose: \x:A. \y:A. x =\<^sub>A y \ (\z:A. y =\<^sub>A z \ x =\<^sub>A z)" +unfolding reqcompose_def proof fix x assume 1: "x: A" show "\<^bold>\y p. ind\<^sub>= (\_. \<^bold>\z q. ind\<^sub>= refl q) p: \y:A. x =\<^sub>A y \ (\z:A. y =\<^sub>A z \ x =\<^sub>A z)" @@ -85,17 +85,17 @@ qed fact corollary assumes "A: U(i)" "x: A" "y: A" "z: A" "p: x =\<^sub>A y" "q: y =\<^sub>A z" - shows "rcompose`x`y`p`z`q: x =\<^sub>A z" - by (simple lem: assms rcompose_type) + shows "reqcompose`x`y`p`z`q: x =\<^sub>A z" + by (simple lem: assms reqcompose_type) text " The following proof is very long, chiefly because for every application of \`\ we have to show the wellformedness of the type family appearing in the equality computation rule. " -lemma rcompose_comp: +lemma reqcompose_comp: assumes "A: U(i)" and "a: A" - shows "rcompose`a`a`refl(a)`a`refl(a) \ refl(a)" -unfolding rcompose_def + shows "reqcompose`a`a`refl(a)`a`refl(a) \ refl(a)" +unfolding reqcompose_def proof (subst comp) { fix x assume 1: "x: A" show "\<^bold>\y p. ind\<^sub>= (\_. \<^bold>\z q. ind\<^sub>= refl q) p: \y:A. x =\<^sub>A y \ (\z:A. y =\<^sub>A z \ x =\<^sub>A z)" @@ -197,28 +197,28 @@ qed fact text "The raw object lambda term is cumbersome to use, so we define a simpler constant instead." -axiomatization compose :: "[Term, Term] \ Term" (infixl "\" 60) where - compose_def: "\ +axiomatization eqcompose :: "[Term, Term] \ Term" (infixl "\" 60) where + eqcompose_def: "\ A: U(i); x: A; y: A; z: A; p: x =\<^sub>A y; q: y =\<^sub>A z - \ \ p \ q \ rcompose`x`y`p`z`q" + \ \ p \ q \ reqcompose`x`y`p`z`q" -lemma compose_type: +lemma eqcompose_type: assumes "A: U(i)" "x: A" "y: A" "z: A" "p: x =\<^sub>A y" "q: y =\<^sub>A z" shows "p \ q: x =\<^sub>A z" -proof (subst compose_def) +proof (subst eqcompose_def) show "A: U(i)" "x: A" "y: A" "z: A" "p: x =\<^sub>A y" "q: y =\<^sub>A z" by fact+ -qed (simple lem: assms rcompose_type) +qed (simple lem: assms reqcompose_type) -lemma compose_comp: +lemma eqcompose_comp: assumes "A : U(i)" and "a : A" shows "refl(a) \ refl(a) \ refl(a)" -by (subst compose_def) (simple lem: assms rcompose_comp) +by (subst eqcompose_def) (simple lem: assms reqcompose_comp) -lemmas EqualProps_rules [intro] = inv_type compose_type -lemmas EqualProps_comps [comp] = inv_comp compose_comp +lemmas EqualProps_rules [intro] = inv_type eqcompose_type +lemmas EqualProps_comps [comp] = inv_comp eqcompose_comp end \ No newline at end of file diff --git a/Prod.thy b/Prod.thy index 76b66dd..496bf3e 100644 --- a/Prod.thy +++ b/Prod.thy @@ -68,6 +68,22 @@ lemmas Prod_rules [intro] = Prod_form Prod_intro Prod_elim Prod_comp Prod_uniq lemmas Prod_wellform [wellform] = Prod_form_cond1 Prod_form_cond2 lemmas Prod_comps [comp] = Prod_comp Prod_uniq +subsection \Composition\ + +axiomatization fncompose :: "[Term, Term] \ Term" (infixr "\" 70) where + fncompose_type: "\ + g: \x:B. C(x); + f: A \ B; + (\x:B. C(x)): U(i); + A \ B: U(i) + \ \ g \ f: \x:A. C(f`x)" +and + fncompose_comp: "\ + A: U(i); + \x. x: A \ b(x): B; + \x. x: A \ c(x): C(x) + \ \ (\<^bold>\x. c(x)) \ (\<^bold>\x. b(x)) \ \<^bold>\x. c(b(x))" + section \Unit type\ -- cgit v1.2.3