src/Cube/Example.thy
author ballarin
Tue Jun 20 15:53:44 2006 +0200 (2006-06-20)
changeset 19931 fb32b43e7f80
parent 17453 eccff680177d
child 19943 26b37721b357
permissions -rw-r--r--
Restructured locales with predicates: import is now an interpretation.
New method intro_locales.
wenzelm@17453
     1
wenzelm@17453
     2
(* $Id$ *)
wenzelm@17453
     3
wenzelm@17453
     4
header {* Lambda Cube Examples *}
wenzelm@17453
     5
wenzelm@17453
     6
theory Example
wenzelm@17453
     7
imports Cube
wenzelm@17453
     8
begin
wenzelm@17453
     9
wenzelm@17453
    10
text {*
wenzelm@17453
    11
  Examples taken from:
wenzelm@17453
    12
wenzelm@17453
    13
  H. Barendregt. Introduction to Generalised Type Systems.
wenzelm@17453
    14
  J. Functional Programming.
wenzelm@17453
    15
*}
wenzelm@17453
    16
wenzelm@17453
    17
method_setup depth_solve = {*
wenzelm@17453
    18
  Method.thms_args (fn thms => Method.METHOD (fn facts =>
ballarin@19931
    19
  (DEPTH_SOLVE (HEADGOAL (ares_tac (PolyML.print (facts @ thms)))))))
wenzelm@17453
    20
*} ""
wenzelm@17453
    21
wenzelm@17453
    22
method_setup depth_solve1 = {*
wenzelm@17453
    23
  Method.thms_args (fn thms => Method.METHOD (fn facts =>
wenzelm@17453
    24
  (DEPTH_SOLVE_1 (HEADGOAL (ares_tac (facts @ thms))))))
wenzelm@17453
    25
*} ""
wenzelm@17453
    26
wenzelm@17453
    27
method_setup strip_asms =  {*
wenzelm@17453
    28
  let val strip_b = thm "strip_b" and strip_s = thm "strip_s" in
wenzelm@17453
    29
    Method.thms_args (fn thms => Method.METHOD (fn facts =>
wenzelm@17453
    30
      REPEAT (resolve_tac [strip_b, strip_s] 1 THEN DEPTH_SOLVE_1 (ares_tac (facts @ thms) 1))))
wenzelm@17453
    31
  end
wenzelm@17453
    32
*} ""
wenzelm@17453
    33
wenzelm@17453
    34
wenzelm@17453
    35
subsection {* Simple types *}
wenzelm@17453
    36
wenzelm@17453
    37
lemma "A:* |- A->A : ?T"
wenzelm@17453
    38
  by (depth_solve rules)
wenzelm@17453
    39
wenzelm@17453
    40
lemma "A:* |- Lam a:A. a : ?T"
wenzelm@17453
    41
  by (depth_solve rules)
wenzelm@17453
    42
wenzelm@17453
    43
lemma "A:* B:* b:B |- Lam x:A. b : ?T"
wenzelm@17453
    44
  by (depth_solve rules)
wenzelm@17453
    45
wenzelm@17453
    46
lemma "A:* b:A |- (Lam a:A. a)^b: ?T"
wenzelm@17453
    47
  by (depth_solve rules)
wenzelm@17453
    48
wenzelm@17453
    49
lemma "A:* B:* c:A b:B |- (Lam x:A. b)^ c: ?T"
wenzelm@17453
    50
  by (depth_solve rules)
wenzelm@17453
    51
wenzelm@17453
    52
lemma "A:* B:* |- Lam a:A. Lam b:B. a : ?T"
wenzelm@17453
    53
  by (depth_solve rules)
wenzelm@17453
    54
wenzelm@17453
    55
wenzelm@17453
    56
subsection {* Second-order types *}
wenzelm@17453
    57
wenzelm@17453
    58
lemma (in L2) "|- Lam A:*. Lam a:A. a : ?T"
wenzelm@17453
    59
  by (depth_solve rules)
wenzelm@17453
    60
wenzelm@17453
    61
lemma (in L2) "A:* |- (Lam B:*.Lam b:B. b)^A : ?T"
wenzelm@17453
    62
  by (depth_solve rules)
wenzelm@17453
    63
wenzelm@17453
    64
lemma (in L2) "A:* b:A |- (Lam B:*.Lam b:B. b) ^ A ^ b: ?T"
wenzelm@17453
    65
  by (depth_solve rules)
wenzelm@17453
    66
wenzelm@17453
    67
lemma (in L2) "|- Lam B:*.Lam a:(Pi A:*.A).a ^ ((Pi A:*.A)->B) ^ a: ?T"
wenzelm@17453
    68
  by (depth_solve rules)
wenzelm@17453
    69
wenzelm@17453
    70
wenzelm@17453
    71
subsection {* Weakly higher-order propositional logic *}
wenzelm@17453
    72
wenzelm@17453
    73
lemma (in Lomega) "|- Lam A:*.A->A : ?T"
wenzelm@17453
    74
  by (depth_solve rules)
wenzelm@17453
    75
wenzelm@17453
    76
lemma (in Lomega) "B:* |- (Lam A:*.A->A) ^ B : ?T"
wenzelm@17453
    77
  by (depth_solve rules)
wenzelm@17453
    78
wenzelm@17453
    79
lemma (in Lomega) "B:* b:B |- (Lam y:B. b): ?T"
wenzelm@17453
    80
  by (depth_solve rules)
wenzelm@17453
    81
wenzelm@17453
    82
lemma (in Lomega) "A:* F:*->* |- F^(F^A): ?T"
wenzelm@17453
    83
  by (depth_solve rules)
wenzelm@17453
    84
wenzelm@17453
    85
lemma (in Lomega) "A:* |- Lam F:*->*.F^(F^A): ?T"
wenzelm@17453
    86
  by (depth_solve rules)
wenzelm@17453
    87
wenzelm@17453
    88
wenzelm@17453
    89
subsection {* LP *}
wenzelm@17453
    90
wenzelm@17453
    91
lemma (in LP) "A:* |- A -> * : ?T"
wenzelm@17453
    92
  by (depth_solve rules)
wenzelm@17453
    93
wenzelm@17453
    94
lemma (in LP) "A:* P:A->* a:A |- P^a: ?T"
wenzelm@17453
    95
  by (depth_solve rules)
wenzelm@17453
    96
wenzelm@17453
    97
lemma (in LP) "A:* P:A->A->* a:A |- Pi a:A. P^a^a: ?T"
wenzelm@17453
    98
  by (depth_solve rules)
wenzelm@17453
    99
wenzelm@17453
   100
lemma (in LP) "A:* P:A->* Q:A->* |- Pi a:A. P^a -> Q^a: ?T"
wenzelm@17453
   101
  by (depth_solve rules)
wenzelm@17453
   102
wenzelm@17453
   103
lemma (in LP) "A:* P:A->* |- Pi a:A. P^a -> P^a: ?T"
wenzelm@17453
   104
  by (depth_solve rules)
wenzelm@17453
   105
wenzelm@17453
   106
lemma (in LP) "A:* P:A->* |- Lam a:A. Lam x:P^a. x: ?T"
wenzelm@17453
   107
  by (depth_solve rules)
wenzelm@17453
   108
wenzelm@17453
   109
lemma (in LP) "A:* P:A->* Q:* |- (Pi a:A. P^a->Q) -> (Pi a:A. P^a) -> Q : ?T"
wenzelm@17453
   110
  by (depth_solve rules)
wenzelm@17453
   111
wenzelm@17453
   112
lemma (in LP) "A:* P:A->* Q:* a0:A |-
wenzelm@17453
   113
        Lam x:Pi a:A. P^a->Q. Lam y:Pi a:A. P^a. x^a0^(y^a0): ?T"
wenzelm@17453
   114
  by (depth_solve rules)
wenzelm@17453
   115
wenzelm@17453
   116
wenzelm@17453
   117
subsection {* Omega-order types *}
wenzelm@17453
   118
wenzelm@17453
   119
lemma (in L2) "A:* B:* |- Pi C:*.(A->B->C)->C : ?T"
wenzelm@17453
   120
  by (depth_solve rules)
wenzelm@17453
   121
wenzelm@17453
   122
lemma (in Lomega2) "|- Lam A:*.Lam B:*.Pi C:*.(A->B->C)->C : ?T"
wenzelm@17453
   123
  by (depth_solve rules)
wenzelm@17453
   124
wenzelm@17453
   125
lemma (in Lomega2) "|- Lam A:*.Lam B:*.Lam x:A. Lam y:B. x : ?T"
wenzelm@17453
   126
  by (depth_solve rules)
wenzelm@17453
   127
wenzelm@17453
   128
lemma (in Lomega2) "A:* B:* |- ?p : (A->B) -> ((B->Pi P:*.P)->(A->Pi P:*.P))"
wenzelm@17453
   129
  apply (strip_asms rules)
wenzelm@17453
   130
  apply (rule lam_ss)
wenzelm@17453
   131
    apply (depth_solve1 rules)
wenzelm@17453
   132
   prefer 2
wenzelm@17453
   133
   apply (depth_solve1 rules)
wenzelm@17453
   134
  apply (rule lam_ss)
wenzelm@17453
   135
    apply (depth_solve1 rules)
wenzelm@17453
   136
   prefer 2
wenzelm@17453
   137
   apply (depth_solve1 rules)
wenzelm@17453
   138
  apply (rule lam_ss)
wenzelm@17453
   139
    apply assumption
wenzelm@17453
   140
   prefer 2
wenzelm@17453
   141
   apply (depth_solve1 rules)
wenzelm@17453
   142
  apply (erule pi_elim)
wenzelm@17453
   143
   apply assumption
wenzelm@17453
   144
  apply (erule pi_elim)
wenzelm@17453
   145
   apply assumption
wenzelm@17453
   146
  apply assumption
wenzelm@17453
   147
  done
wenzelm@17453
   148
wenzelm@17453
   149
wenzelm@17453
   150
subsection {* Second-order Predicate Logic *}
wenzelm@17453
   151
wenzelm@17453
   152
lemma (in LP2) "A:* P:A->* |- Lam a:A. P^a->(Pi A:*.A) : ?T"
wenzelm@17453
   153
  by (depth_solve rules)
wenzelm@17453
   154
wenzelm@17453
   155
lemma (in LP2) "A:* P:A->A->* |-
wenzelm@17453
   156
    (Pi a:A. Pi b:A. P^a^b->P^b^a->Pi P:*.P) -> Pi a:A. P^a^a->Pi P:*.P : ?T"
wenzelm@17453
   157
  by (depth_solve rules)
wenzelm@17453
   158
wenzelm@17453
   159
lemma (in LP2) "A:* P:A->A->* |-
wenzelm@17453
   160
    ?p: (Pi a:A. Pi b:A. P^a^b->P^b^a->Pi P:*.P) -> Pi a:A. P^a^a->Pi P:*.P"
wenzelm@17453
   161
  -- {* Antisymmetry implies irreflexivity: *}
wenzelm@17453
   162
  apply (strip_asms rules)
wenzelm@17453
   163
  apply (rule lam_ss)
wenzelm@17453
   164
    apply (depth_solve1 rules)
wenzelm@17453
   165
   prefer 2
wenzelm@17453
   166
   apply (depth_solve1 rules)
wenzelm@17453
   167
  apply (rule lam_ss)
wenzelm@17453
   168
    apply assumption
wenzelm@17453
   169
   prefer 2
wenzelm@17453
   170
   apply (depth_solve1 rules)
wenzelm@17453
   171
  apply (rule lam_ss)
wenzelm@17453
   172
    apply (depth_solve1 rules)
wenzelm@17453
   173
   prefer 2
wenzelm@17453
   174
   apply (depth_solve1 rules)
wenzelm@17453
   175
  apply (erule pi_elim, assumption, assumption?)+
wenzelm@17453
   176
  done
wenzelm@17453
   177
wenzelm@17453
   178
wenzelm@17453
   179
subsection {* LPomega *}
wenzelm@17453
   180
wenzelm@17453
   181
lemma (in LPomega) "A:* |- Lam P:A->A->*.Lam a:A. P^a^a : ?T"
wenzelm@17453
   182
  by (depth_solve rules)
wenzelm@17453
   183
wenzelm@17453
   184
lemma (in LPomega) "|- Lam A:*.Lam P:A->A->*.Lam a:A. P^a^a : ?T"
wenzelm@17453
   185
  by (depth_solve rules)
wenzelm@17453
   186
wenzelm@17453
   187
wenzelm@17453
   188
subsection {* Constructions *}
wenzelm@17453
   189
wenzelm@17453
   190
lemma (in CC) "|- Lam A:*.Lam P:A->*.Lam a:A. P^a->Pi P:*.P: ?T"
wenzelm@17453
   191
  by (depth_solve rules)
wenzelm@17453
   192
wenzelm@17453
   193
lemma (in CC) "|- Lam A:*.Lam P:A->*.Pi a:A. P^a: ?T"
wenzelm@17453
   194
  by (depth_solve rules)
wenzelm@17453
   195
wenzelm@17453
   196
lemma (in CC) "A:* P:A->* a:A |- ?p : (Pi a:A. P^a)->P^a"
wenzelm@17453
   197
  apply (strip_asms rules)
wenzelm@17453
   198
  apply (rule lam_ss)
wenzelm@17453
   199
    apply (depth_solve1 rules)
wenzelm@17453
   200
   prefer 2
wenzelm@17453
   201
   apply (depth_solve1 rules)
wenzelm@17453
   202
  apply (erule pi_elim, assumption, assumption)
wenzelm@17453
   203
  done
wenzelm@17453
   204
wenzelm@17453
   205
wenzelm@17453
   206
subsection {* Some random examples *}
wenzelm@17453
   207
wenzelm@17453
   208
lemma (in LP2) "A:* c:A f:A->A |-
wenzelm@17453
   209
    Lam a:A. Pi P:A->*.P^c -> (Pi x:A. P^x->P^(f^x)) -> P^a : ?T"
wenzelm@17453
   210
  by (depth_solve rules)
wenzelm@17453
   211
wenzelm@17453
   212
lemma (in CC) "Lam A:*.Lam c:A. Lam f:A->A.
wenzelm@17453
   213
    Lam a:A. Pi P:A->*.P^c -> (Pi x:A. P^x->P^(f^x)) -> P^a : ?T"
wenzelm@17453
   214
  by (depth_solve rules)
wenzelm@17453
   215
wenzelm@17453
   216
lemma (in LP2)
wenzelm@17453
   217
  "A:* a:A b:A |- ?p: (Pi P:A->*.P^a->P^b) -> (Pi P:A->*.P^b->P^a)"
wenzelm@17453
   218
  -- {* Symmetry of Leibnitz equality *}
wenzelm@17453
   219
  apply (strip_asms rules)
wenzelm@17453
   220
  apply (rule lam_ss)
wenzelm@17453
   221
    apply (depth_solve1 rules)
wenzelm@17453
   222
   prefer 2
wenzelm@17453
   223
   apply (depth_solve1 rules)
wenzelm@17453
   224
  apply (erule_tac a = "Lam x:A. Pi Q:A->*.Q^x->Q^a" in pi_elim)
wenzelm@17453
   225
   apply (depth_solve1 rules)
wenzelm@17453
   226
  apply (unfold beta)
wenzelm@17453
   227
  apply (erule imp_elim)
wenzelm@17453
   228
   apply (rule lam_bs)
wenzelm@17453
   229
     apply (depth_solve1 rules)
wenzelm@17453
   230
    prefer 2
wenzelm@17453
   231
    apply (depth_solve1 rules)
wenzelm@17453
   232
   apply (rule lam_ss)
wenzelm@17453
   233
     apply (depth_solve1 rules)
wenzelm@17453
   234
    prefer 2
wenzelm@17453
   235
    apply (depth_solve1 rules)
wenzelm@17453
   236
   apply assumption
wenzelm@17453
   237
  apply assumption
wenzelm@17453
   238
  done
wenzelm@17453
   239
wenzelm@17453
   240
end