
wenzelm@58889: section \<open>Lambda Cube Examples\<close>
wenzelm@17453: 
wenzelm@17453: theory Example
wenzelm@17453: imports Cube
wenzelm@17453: begin
wenzelm@17453: 
wenzelm@58617: text \<open>Examples taken from:
wenzelm@17453: 
wenzelm@17453:   H. Barendregt. Introduction to Generalised Type Systems.
wenzelm@58617:   J. Functional Programming.\<close>
wenzelm@17453: 
wenzelm@58617: method_setup depth_solve =
wenzelm@58617:   \<open>Attrib.thms >> (fn thms => K (METHOD (fn facts =>
wenzelm@58617:     (DEPTH_SOLVE (HEADGOAL (ares_tac (facts @ thms)))))))\<close>
wenzelm@17453: 
wenzelm@58617: method_setup depth_solve1 =
wenzelm@58617:   \<open>Attrib.thms >> (fn thms => K (METHOD (fn facts =>
wenzelm@58617:     (DEPTH_SOLVE_1 (HEADGOAL (ares_tac (facts @ thms)))))))\<close>
wenzelm@17453: 
wenzelm@58617: method_setup strip_asms =
wenzelm@58617:   \<open>Attrib.thms >> (fn thms => K (METHOD (fn facts =>
wenzelm@30549:     REPEAT (resolve_tac [@{thm strip_b}, @{thm strip_s}] 1 THEN
wenzelm@58617:     DEPTH_SOLVE_1 (ares_tac (facts @ thms) 1)))))\<close>
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Simple types\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma "A:* \<turnstile> A\<rightarrow>A : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma "A:* \<turnstile> \<Lambda> a:A. a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma "A:* B:* b:B \<turnstile> \<Lambda> x:A. b : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma "A:* b:A \<turnstile> (\<Lambda> a:A. a)^b: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma "A:* B:* c:A b:B \<turnstile> (\<Lambda> x:A. b)^ c: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma "A:* B:* \<turnstile> \<Lambda> a:A. \<Lambda> b:B. a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Second-order types\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in L2) "\<turnstile> \<Lambda> A:*. \<Lambda> a:A. a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in L2) "A:* \<turnstile> (\<Lambda> B:*.\<Lambda> b:B. b)^A : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in L2) "A:* b:A \<turnstile> (\<Lambda> B:*.\<Lambda> b:B. b) ^ A ^ b: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in L2) "\<turnstile> \<Lambda> B:*.\<Lambda> a:(\<Pi> A:*.A).a ^ ((\<Pi> A:*.A)\<rightarrow>B) ^ a: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Weakly higher-order propositional logic\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega) "\<turnstile> \<Lambda> A:*.A\<rightarrow>A : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega) "B:* \<turnstile> (\<Lambda> A:*.A\<rightarrow>A) ^ B : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega) "B:* b:B \<turnstile> (\<Lambda> y:B. b): ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega) "A:* F:*\<rightarrow>* \<turnstile> F^(F^A): ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega) "A:* \<turnstile> \<Lambda> F:*\<rightarrow>*.F^(F^A): ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>LP\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* \<turnstile> A \<rightarrow> * : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>* a:A \<turnstile> P^a: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>A\<rightarrow>* a:A \<turnstile> \<Pi> a:A. P^a^a: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>* Q:A\<rightarrow>* \<turnstile> \<Pi> a:A. P^a \<rightarrow> Q^a: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>* \<turnstile> \<Pi> a:A. P^a \<rightarrow> P^a: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>* \<turnstile> \<Lambda> a:A. \<Lambda> x:P^a. x: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>* Q:* \<turnstile> (\<Pi> a:A. P^a\<rightarrow>Q) \<rightarrow> (\<Pi> a:A. P^a) \<rightarrow> Q : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP) "A:* P:A\<rightarrow>* Q:* a0:A \<turnstile>
wenzelm@45242:         \<Lambda> x:\<Pi> a:A. P^a\<rightarrow>Q. \<Lambda> y:\<Pi> a:A. P^a. x^a0^(y^a0): ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Omega-order types\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in L2) "A:* B:* \<turnstile> \<Pi> C:*.(A\<rightarrow>B\<rightarrow>C)\<rightarrow>C : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega2) "\<turnstile> \<Lambda> A:*.\<Lambda> B:*.\<Pi> C:*.(A\<rightarrow>B\<rightarrow>C)\<rightarrow>C : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega2) "\<turnstile> \<Lambda> A:*.\<Lambda> B:*.\<Lambda> x:A. \<Lambda> y:B. x : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in Lomega2) "A:* B:* \<turnstile> ?p : (A\<rightarrow>B) \<rightarrow> ((B\<rightarrow>\<Pi> P:*.P)\<rightarrow>(A\<rightarrow>\<Pi> P:*.P))"
wenzelm@17453:   apply (strip_asms rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply assumption
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (erule pi_elim)
wenzelm@17453:    apply assumption
wenzelm@17453:   apply (erule pi_elim)
wenzelm@17453:    apply assumption
wenzelm@17453:   apply assumption
wenzelm@17453:   done
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Second-order Predicate Logic\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP2) "A:* P:A\<rightarrow>* \<turnstile> \<Lambda> a:A. P^a\<rightarrow>(\<Pi> A:*.A) : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP2) "A:* P:A\<rightarrow>A\<rightarrow>* \<turnstile>
wenzelm@45242:     (\<Pi> a:A. \<Pi> b:A. P^a^b\<rightarrow>P^b^a\<rightarrow>\<Pi> P:*.P) \<rightarrow> \<Pi> a:A. P^a^a\<rightarrow>\<Pi> P:*.P : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP2) "A:* P:A\<rightarrow>A\<rightarrow>* \<turnstile>
wenzelm@45242:     ?p: (\<Pi> a:A. \<Pi> b:A. P^a^b\<rightarrow>P^b^a\<rightarrow>\<Pi> P:*.P) \<rightarrow> \<Pi> a:A. P^a^a\<rightarrow>\<Pi> P:*.P"
wenzelm@58617:   -- \<open>Antisymmetry implies irreflexivity:\<close>
wenzelm@17453:   apply (strip_asms rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply assumption
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (erule pi_elim, assumption, assumption?)+
wenzelm@17453:   done
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>LPomega\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LPomega) "A:* \<turnstile> \<Lambda> P:A\<rightarrow>A\<rightarrow>*.\<Lambda> a:A. P^a^a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LPomega) "\<turnstile> \<Lambda> A:*.\<Lambda> P:A\<rightarrow>A\<rightarrow>*.\<Lambda> a:A. P^a^a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Constructions\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in CC) "\<turnstile> \<Lambda> A:*.\<Lambda> P:A\<rightarrow>*.\<Lambda> a:A. P^a\<rightarrow>\<Pi> P:*.P: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in CC) "\<turnstile> \<Lambda> A:*.\<Lambda> P:A\<rightarrow>*.\<Pi> a:A. P^a: ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in CC) "A:* P:A\<rightarrow>* a:A \<turnstile> ?p : (\<Pi> a:A. P^a)\<rightarrow>P^a"
wenzelm@17453:   apply (strip_asms rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (erule pi_elim, assumption, assumption)
wenzelm@17453:   done
wenzelm@17453: 
wenzelm@17453: 
wenzelm@58617: subsection \<open>Some random examples\<close>
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in LP2) "A:* c:A f:A\<rightarrow>A \<turnstile>
wenzelm@45242:     \<Lambda> a:A. \<Pi> P:A\<rightarrow>*.P^c \<rightarrow> (\<Pi> x:A. P^x\<rightarrow>P^(f^x)) \<rightarrow> P^a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@45242: schematic_lemma (in CC) "\<Lambda> A:*.\<Lambda> c:A. \<Lambda> f:A\<rightarrow>A.
wenzelm@45242:     \<Lambda> a:A. \<Pi> P:A\<rightarrow>*.P^c \<rightarrow> (\<Pi> x:A. P^x\<rightarrow>P^(f^x)) \<rightarrow> P^a : ?T"
wenzelm@17453:   by (depth_solve rules)
wenzelm@17453: 
wenzelm@36319: schematic_lemma (in LP2)
wenzelm@45242:   "A:* a:A b:A \<turnstile> ?p: (\<Pi> P:A\<rightarrow>*.P^a\<rightarrow>P^b) \<rightarrow> (\<Pi> P:A\<rightarrow>*.P^b\<rightarrow>P^a)"
wenzelm@58617:   -- \<open>Symmetry of Leibnitz equality\<close>
wenzelm@17453:   apply (strip_asms rules)
wenzelm@17453:   apply (rule lam_ss)
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    prefer 2
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@45242:   apply (erule_tac a = "\<Lambda> x:A. \<Pi> Q:A\<rightarrow>*.Q^x\<rightarrow>Q^a" in pi_elim)
wenzelm@17453:    apply (depth_solve1 rules)
wenzelm@17453:   apply (unfold beta)
wenzelm@17453:   apply (erule imp_elim)
wenzelm@17453:    apply (rule lam_bs)
wenzelm@17453:      apply (depth_solve1 rules)
wenzelm@17453:     prefer 2
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    apply (rule lam_ss)
wenzelm@17453:      apply (depth_solve1 rules)
wenzelm@17453:     prefer 2
wenzelm@17453:     apply (depth_solve1 rules)
wenzelm@17453:    apply assumption
wenzelm@17453:   apply assumption
wenzelm@17453:   done
wenzelm@17453: 
wenzelm@17453: end




