src/ZF/ex/Term.ML
changeset 0 a5a9c433f639
child 16 0b033d50ca1c
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/ZF/ex/Term.ML	Thu Sep 16 12:20:38 1993 +0200
     1.3 @@ -0,0 +1,66 @@
     1.4 +(*  Title: 	ZF/ex/term.ML
     1.5 +    ID:         $Id$
     1.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
     1.7 +    Copyright   1993  University of Cambridge
     1.8 +
     1.9 +Datatype definition of terms over an alphabet.
    1.10 +Illustrates the list functor (essentially the same type as in Trees & Forests)
    1.11 +*)
    1.12 +
    1.13 +structure Term = Datatype_Fun
    1.14 + (val thy = List.thy;
    1.15 +  val rec_specs = 
    1.16 +      [("term", "univ(A)",
    1.17 +	  [(["Apply"], "[i,i]=>i")])];
    1.18 +  val rec_styp = "i=>i";
    1.19 +  val ext = None
    1.20 +  val sintrs = ["[| a: A;  l: list(term(A)) |] ==> Apply(a,l) : term(A)"];
    1.21 +  val monos = [list_mono];
    1.22 +  val type_intrs = [SigmaI,Pair_in_univ, list_univ RS subsetD, A_into_univ];
    1.23 +  val type_elims = []);
    1.24 +
    1.25 +val [ApplyI] = Term.intrs;
    1.26 +
    1.27 +(*Induction on term(A) followed by induction on List *)
    1.28 +val major::prems = goal Term.thy
    1.29 +    "[| t: term(A);  \
    1.30 +\       !!x.      [| x: A |] ==> P(Apply(x,Nil));  \
    1.31 +\       !!x z zs. [| x: A;  z: term(A);  zs: list(term(A));  P(Apply(x,zs))  \
    1.32 +\                 |] ==> P(Apply(x, Cons(z,zs)))  \
    1.33 +\    |] ==> P(t)";
    1.34 +by (rtac (major RS Term.induct) 1);
    1.35 +by (etac List.induct 1);
    1.36 +by (etac CollectE 2);
    1.37 +by (REPEAT (ares_tac (prems@[list_CollectD]) 1));
    1.38 +val term_induct2 = result();
    1.39 +
    1.40 +(*Induction on term(A) to prove an equation*)
    1.41 +val major::prems = goal (merge_theories(Term.thy,ListFn.thy))
    1.42 +    "[| t: term(A);  \
    1.43 +\       !!x zs. [| x: A;  zs: list(term(A));  map(f,zs) = map(g,zs) |] ==> \
    1.44 +\               f(Apply(x,zs)) = g(Apply(x,zs))  \
    1.45 +\    |] ==> f(t)=g(t)";
    1.46 +by (rtac (major RS Term.induct) 1);
    1.47 +by (resolve_tac prems 1);
    1.48 +by (REPEAT (eresolve_tac [asm_rl, map_list_Collect, list_CollectD] 1));
    1.49 +val term_induct_eqn = result();
    1.50 +
    1.51 +(**  Lemmas to justify using "term" in other recursive type definitions **)
    1.52 +
    1.53 +goalw Term.thy Term.defs "!!A B. A<=B ==> term(A) <= term(B)";
    1.54 +by (rtac lfp_mono 1);
    1.55 +by (REPEAT (rtac Term.bnd_mono 1));
    1.56 +by (REPEAT (ares_tac (univ_mono::basic_monos) 1));
    1.57 +val term_mono = result();
    1.58 +
    1.59 +(*Easily provable by induction also*)
    1.60 +goalw Term.thy (Term.defs@Term.con_defs) "term(univ(A)) <= univ(A)";
    1.61 +by (rtac lfp_lowerbound 1);
    1.62 +by (rtac (A_subset_univ RS univ_mono) 2);
    1.63 +by (safe_tac ZF_cs);
    1.64 +by (REPEAT (ares_tac [Pair_in_univ, list_univ RS subsetD] 1));
    1.65 +val term_univ = result();
    1.66 +
    1.67 +val term_subset_univ = standard
    1.68 +    (term_mono RS (term_univ RSN (2,subset_trans)));
    1.69 +