src/ZF/ex/Ntree.ML
author lcp
Fri, 12 Aug 1994 12:28:46 +0200
changeset 515 abcc438e7c27
parent 486 6b58082796f6
child 529 f0d16216e394
permissions -rw-r--r--
installation of new inductive/datatype sections
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     1
(*  Title: 	ZF/ex/Ntree.ML
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     2
    ID:         $Id$
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     3
    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     4
    Copyright   1994  University of Cambridge
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     5
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     6
Datatype definition n-ary branching trees
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     7
Demonstrates a simple use of function space in a datatype definition
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     8
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
     9
Based upon ex/Term.ML
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    10
*)
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    11
515
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    12
open Ntree;
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    13
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    14
goal Ntree.thy "ntree(A) = A * (UN n: nat. n -> ntree(A))";
515
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    15
by (rtac (ntree.unfold RS trans) 1);
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    16
bws ntree.con_defs;
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    17
br equalityI 1;
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    18
by (fast_tac sum_cs 1);
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    19
by (fast_tac (sum_cs addIs datatype_intrs
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    20
 	             addDs [ntree.dom_subset RS subsetD]
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    21
 	             addEs [nat_fun_into_univ]) 1);
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    22
val ntree_unfold = result();
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    23
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    24
(*A nicer induction rule than the standard one*)
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    25
val major::prems = goal Ntree.thy
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    26
    "[| t: ntree(A);  \
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    27
\       !!x n h. [| x: A;  n: nat;  h: n -> ntree(A);  ALL i:n. P(h`i)  \
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    28
\                |] ==> P(Branch(x,h))  \
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    29
\    |] ==> P(t)";
515
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    30
by (rtac (major RS ntree.induct) 1);
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    31
by (etac UN_E 1);
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    32
by (REPEAT_SOME (ares_tac prems));
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    33
by (fast_tac (ZF_cs addEs [fun_weaken_type]) 1);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    34
by (fast_tac (ZF_cs addDs [apply_type]) 1);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    35
val ntree_induct2 = result();
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    36
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    37
(*Induction on ntree(A) to prove an equation*)
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    38
val major::prems = goal Ntree.thy
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    39
  "[| t: ntree(A);  f: ntree(A)->B;  g: ntree(A)->B;		\
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    40
\     !!x n h. [| x: A;  n: nat;  h: n -> ntree(A);  f O h = g O h |] ==> \
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    41
\              f ` Branch(x,h) = g ` Branch(x,h)  		\
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    42
\  |] ==> f`t=g`t";
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    43
by (rtac (major RS ntree_induct2) 1);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    44
by (REPEAT_SOME (ares_tac prems));
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    45
by (cut_facts_tac prems 1);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    46
br fun_extension 1;
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    47
by (REPEAT_SOME (ares_tac [comp_fun]));
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    48
by (asm_simp_tac (ZF_ss addsimps [comp_fun_apply]) 1);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    49
val ntree_induct_eqn = result();
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    50
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    51
(**  Lemmas to justify using "Ntree" in other recursive type definitions **)
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    52
515
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    53
goalw Ntree.thy ntree.defs "!!A B. A<=B ==> ntree(A) <= ntree(B)";
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    54
by (rtac lfp_mono 1);
515
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    55
by (REPEAT (rtac ntree.bnd_mono 1));
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    56
by (REPEAT (ares_tac (univ_mono::basic_monos) 1));
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    57
val ntree_mono = result();
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    58
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    59
(*Easily provable by induction also*)
515
abcc438e7c27 installation of new inductive/datatype sections
lcp
parents: 486
diff changeset
    60
goalw Ntree.thy (ntree.defs@ntree.con_defs) "ntree(univ(A)) <= univ(A)";
486
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    61
by (rtac lfp_lowerbound 1);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    62
by (rtac (A_subset_univ RS univ_mono) 2);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    63
by (safe_tac ZF_cs);
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    64
by (REPEAT (ares_tac [Pair_in_univ, nat_fun_univ RS subsetD] 1));
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    65
val ntree_univ = result();
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    66
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    67
val ntree_subset_univ = 
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    68
    [ntree_mono, ntree_univ] MRS subset_trans |> standard;
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    69
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    70
goal Ntree.thy "!!t A B. [| t: ntree(A);  A <= univ(B) |] ==> t: univ(B)";
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    71
by (REPEAT (ares_tac [ntree_subset_univ RS subsetD] 1));
6b58082796f6 Misc minor updates
lcp
parents:
diff changeset
    72
val ntree_into_univ = result();