--- a/src/HOLCF/cfun1.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,129 +0,0 @@
-(* Title: HOLCF/cfun1.ML
- ID: $Id$
- Author: Franz Regensburger
- Copyright 1993 Technische Universitaet Muenchen
-
-Lemmas for cfun1.thy
-*)
-
-open Cfun1;
-
-(* ------------------------------------------------------------------------ *)
-(* A non-emptyness result for Cfun *)
-(* ------------------------------------------------------------------------ *)
-
-val CfunI = prove_goalw Cfun1.thy [Cfun_def] "(% x.x):Cfun"
- (fn prems =>
- [
- (rtac (mem_Collect_eq RS ssubst) 1),
- (rtac contX_id 1)
- ]);
-
-
-(* ------------------------------------------------------------------------ *)
-(* less_cfun is a partial order on type 'a -> 'b *)
-(* ------------------------------------------------------------------------ *)
-
-val refl_less_cfun = prove_goalw Cfun1.thy [less_cfun_def] "less_cfun(f,f)"
-(fn prems =>
- [
- (rtac refl_less 1)
- ]);
-
-val antisym_less_cfun = prove_goalw Cfun1.thy [less_cfun_def]
- "[|less_cfun(f1,f2); less_cfun(f2,f1)|] ==> f1 = f2"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (rtac injD 1),
- (rtac antisym_less 2),
- (atac 3),
- (atac 2),
- (rtac inj_inverseI 1),
- (rtac Rep_Cfun_inverse 1)
- ]);
-
-val trans_less_cfun = prove_goalw Cfun1.thy [less_cfun_def]
- "[|less_cfun(f1,f2); less_cfun(f2,f3)|] ==> less_cfun(f1,f3)"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (etac trans_less 1),
- (atac 1)
- ]);
-
-(* ------------------------------------------------------------------------ *)
-(* lemmas about application of continuous functions *)
-(* ------------------------------------------------------------------------ *)
-
-val cfun_cong = prove_goal Cfun1.thy
- "[| f=g; x=y |] ==> f[x] = g[y]"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (fast_tac HOL_cs 1)
- ]);
-
-val cfun_fun_cong = prove_goal Cfun1.thy "f=g ==> f[x] = g[x]"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (etac cfun_cong 1),
- (rtac refl 1)
- ]);
-
-val cfun_arg_cong = prove_goal Cfun1.thy "x=y ==> f[x] = f[y]"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (rtac cfun_cong 1),
- (rtac refl 1),
- (atac 1)
- ]);
-
-
-(* ------------------------------------------------------------------------ *)
-(* additional lemma about the isomorphism between -> and Cfun *)
-(* ------------------------------------------------------------------------ *)
-
-val Abs_Cfun_inverse2 = prove_goal Cfun1.thy "contX(f) ==> fapp(fabs(f)) = f"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (rtac Abs_Cfun_inverse 1),
- (rewrite_goals_tac [Cfun_def]),
- (etac (mem_Collect_eq RS ssubst) 1)
- ]);
-
-(* ------------------------------------------------------------------------ *)
-(* simplification of application *)
-(* ------------------------------------------------------------------------ *)
-
-val Cfunapp2 = prove_goal Cfun1.thy
- "contX(f) ==> (fabs(f))[x] = f(x)"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (etac (Abs_Cfun_inverse2 RS fun_cong) 1)
- ]);
-
-(* ------------------------------------------------------------------------ *)
-(* beta - equality for continuous functions *)
-(* ------------------------------------------------------------------------ *)
-
-val beta_cfun = prove_goal Cfun1.thy
- "contX(c1) ==> (LAM x .c1(x))[u] = c1(u)"
-(fn prems =>
- [
- (cut_facts_tac prems 1),
- (rtac Cfunapp2 1),
- (atac 1)
- ]);
-
-(* ------------------------------------------------------------------------ *)
-(* load ML file cinfix.ML *)
-(* ------------------------------------------------------------------------ *)
-
-
- writeln "Reading file cinfix.ML";
-use "cinfix.ML";
--- a/src/Pure/Syntax/earley0A.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,465 +0,0 @@
-(* Title: Pure/Syntax/earley0A.ML
- ID: $Id$
- Author: Tobias Nipkow
-
-WARNING: This file is about to disappear.
-*)
-
-signature PARSER =
-sig
- structure Lexicon: LEXICON
- structure SynExt: SYN_EXT
- local open Lexicon SynExt SynExt.Ast in
- type gram
- val empty_gram: gram
- val extend_gram: gram -> string list -> xprod list -> gram
- val merge_grams: gram -> gram -> gram
- val pretty_gram: gram -> Pretty.T list
- datatype parsetree =
- Node of string * parsetree list |
- Tip of token
- val parse: gram -> string -> token list -> parsetree list
- end
-end;
-
-functor EarleyFun(structure Symtab: SYMTAB and Lexicon: LEXICON
- and SynExt: SYN_EXT)(*: PARSER *) = (* FIXME *)
-struct
-
-structure Pretty = SynExt.Ast.Pretty;
-structure Lexicon = Lexicon;
-structure SynExt = SynExt;
-open Lexicon;
-
-
-(** datatype parsetree **)
-
-datatype parsetree =
- Node of string * parsetree list |
- Tip of token;
-
-fun mk_pt ("", [pt]) = pt
- | mk_pt ("", _) = sys_error "mk_pt: funny copy op in parse tree"
- | mk_pt (s, ptl) = Node (s, ptl);
-
-
-
-(** token maps (from lexicon.ML) **)
-
-type 'b TokenMap = (token * 'b list) list * 'b list;
-val first_token = 0;
-
-fun int_of_token(Token(tk)) = first_token |
- int_of_token(IdentSy _) = first_token - 1 |
- int_of_token(VarSy _) = first_token - 2 |
- int_of_token(TFreeSy _) = first_token - 3 |
- int_of_token(TVarSy _) = first_token - 4 |
- int_of_token(EndToken) = first_token - 5;
-
-fun lesstk(s, t) = int_of_token(s) < int_of_token(t) orelse
- (case (s, t) of (Token(a), Token(b)) => a<b | _ => false);
-
-fun mkTokenMap(atll) =
- let val aill = atll;
- val dom = sort lesstk (distinct(flat(map snd aill)));
- val mt = map fst (filter (null o snd) atll);
- fun mktm(i) =
- let fun add(l, (a, il)) = if i mem il then a::l else l
- in (i, foldl add ([], aill)) end;
- in (map mktm dom, mt) end;
-
-fun find_al (i) =
- let fun find((j, al)::l) = if lesstk(i, j) then [] else
- if matching_tokens(i, j) then al else find l |
- find [] = [];
- in find end;
-fun applyTokenMap((l, mt), tk:token) = mt@(find_al tk l);
-
-
-
-(* Linked lists: *)
-infix 5 &;
-datatype 'a LList = nilL | op & of 'a * ('a LListR)
-withtype 'a LListR = 'a LList ref;
-
-(* Apply proc to all elements in a linked list *)
-fun seqll (proc: '_a -> unit) : ('_a LListR -> unit) =
- let fun seq (ref nilL) = () |
- seq (ref((a:'_a)&l)) = (proc a; seq l)
- in seq end;
-
-fun llist_to_list (ref nilL) = [] |
- llist_to_list (ref(a&ll)) = a::(llist_to_list ll);
-
-val len = length;
-
-local open Array SynExt in
-nonfix sub;
-
-fun forA(p: int -> unit, a: 'a array) : unit =
- let val ub = length a
- fun step(i) = if i=ub then () else (p(i); step(i+1));
- in step 0 end;
-
-fun itA(a0:'a, b: 'b array)(f:'a * 'b -> 'a) : 'a =
- let val ub = length b
- fun acc(a,i) = if i=ub then a else acc(f(a,sub(b,i)),i+1)
- in acc(a0,0) end;
-
-
-
-(** grammars **)
-
-datatype 'a symb =
- Dlm of 'a |
- Arg of string * int;
-
-datatype 'a prod = Prod of string * 'a symb list * string * int;
-
-
-datatype Symbol = T of token | NT of int * int
- and Op = Op of OpSyn * string * int
-withtype OpSyn = Symbol array
- and OpListA = Op array * int TokenMap
- and FastAcc = int TokenMap;
-
-(*gram_tabs: name of nt -> number, nt number -> productions array,
- nt number -> list of nt's reachable via copy ops*)
-
-type gram_tabs = int Symtab.table * OpListA array * int list array;
-
-type gram = string list * string prod list * gram_tabs;
-
-
-fun non_term (Arg (s, _)) = if is_terminal s then None else Some s
- | non_term _ = None;
-
-fun non_terms (Prod (_, symbs, _, _)) = mapfilter non_term symbs;
-
-
-(* mk_pre_grammar *)
-(* converts a list of productions in external format into an
- internal gram object. *)
-
-val dummyTM:FastAcc = mkTokenMap[];
-
-fun mk_pre_grammar prods : gram_tabs =
- let
- fun same_res (Prod(t1, _, _, _), Prod(t2, _, _, _)) = t1=t2;
- val partitioned0 = partition_eq same_res prods;
- val nts0 = map (fn Prod(ty, _, _, _)::_ => ty) partitioned0;
- val nts' = distinct(flat(map non_terms prods)) \\ nts0;
- val nts = nts' @ nts0;
- val partitioned = (replicate (len nts') []) @ partitioned0;
- val ntis = nts ~~ (0 upto (len(nts)-1));
- val tab = foldr Symtab.update (ntis, Symtab.null);
-
- fun nt_or_vt (s, p) =
- (case predef_term s of
- None => NT (the (Symtab.lookup (tab, s)), p)
- | Some tk => T tk);
-
- fun mksyn(Dlm(t)) = T(t)
- | mksyn(Arg(t)) = nt_or_vt t;
-
- fun prod2op(Prod(nt, sy, opn, p)) =
- let val syA = arrayoflist(map mksyn sy) in Op(syA, opn, p) end;
-
- fun mkops prods = (arrayoflist(map prod2op prods), dummyTM);
-
- val opLA = arrayoflist(map mkops partitioned);
-
- val subs = array(length opLA, []) : int list array;
- fun newcp v (a, Op(syA, _, p)) =
- if p=chain_pri
- then let val NT(k, _) = sub(syA, 0)
- in if k mem v then a else k ins a end
- else a;
- fun reach v i =
- let val new = itA ([], #1(sub(opLA, i))) (newcp v)
- val v' = new union v
- in flat(map (reach v') new) union v' end;
- fun rch(i) = update(subs, i, reach[i]i);
-
- in
- forA(rch, subs); (tab, opLA, subs)
- end;
-
-
-val RootPref = "__";
-
-(* Lookahead tables for speeding up parsing. Lkhd is a mapping from
-nonterminals (in the form of OpList) to sets (lists) of token strings *)
-
-type Lkhd = token list list list;
-
-(* subst_syn(s, k) syn = [ pref k ts | ts is a token string derivable from sy
- under substitution s ] *)
-(* This is the general version.
-fun cross l1 l2 = flat(map (fn e2 => (map (fn e1 => e1@e2) l1)) l2);
-
-(* pref k [x1,...,xn] is [x1,...,xk] if 0<=k<=n and [x1,...,xn] otherwise *)
-fun pref 0 l = []
- | pref _ [] = []
- | pref k (e::l) = e::(pref (k-1) l);
-
-fun subst_syn(s:Lkhd,k) =
- let fun subst(ref(symb & syn)):token list list =
- let val l1 = case symb of T t => [[t]] |
- NT(oplr,_) => let val Some l = assoc(s,!oplr) in l end
- in distinct(map (pref k) (cross l1 (subst syn))) end |
- subst _ = [[]]
- in subst end;
-*)
-(* This one is specialized to lookahead 1 and a bit too generous *)
-fun subst_syn(s:Lkhd,1) syA =
- let fun subst i = if i = length(syA) then [[]] else
- case sub(syA,i) of
- NT(j,_) => let val pre = nth_elem(j,s)
- in if [] mem pre then (pre \ []) union subst(i+1)
- else pre end |
- T(tk) => [[tk]];
- in subst 0 end;
-
-(* mk_lkhd(G,k) returns a table which associates with every nonterminal N in
-G the list of pref k s for all token strings s with N -G->* s *)
-
-fun mk_lkhd(opLA:OpListA array,k:int):Lkhd =
- let fun step(s:Lkhd):Lkhd =
- let fun subst_op(l,Op(sy,_,_)) = subst_syn(s,k)sy union l;
- fun step2(l,(opA,_)) = l@[itA([],opA)subst_op];
- in writeln"."; itA([],opLA)step2 end;
- fun iterate(s:Lkhd):Lkhd = let val s' = step s
- in if map len s = map len s' then s
- else iterate s' end
- in writeln"Computing lookahead tables ...";
- iterate (replicate (length opLA) []) end;
-
-
-(* mk_earley_gram *) (* create look ahead tables *)
-
-fun mk_earley_gram (g as (tab, opLA, _):gram_tabs):gram_tabs =
- let val lkhd = mk_lkhd(opLA, 1);
- fun mk_fa(i):FastAcc =
- let val opA = #1(sub(opLA, i));
- fun start(j) = let val Op(sy, _, _) = sub(opA, j);
- val pre = subst_syn(lkhd, 1) sy
- in (j, if [] mem pre then [] else map hd pre) end;
- in mkTokenMap(map start (0 upto(length(opA)-1))) end;
- fun updt(i) = update(opLA, i, (#1(sub(opLA, i)), mk_fa(i)));
-
- in forA(updt, opLA); g end;
-
-
-(* compile_xgram *)
-
-fun compile_xgram (roots, prods) =
- let
- fun mk_root nt =
- Prod (RootPref ^ nt, [Arg (nt, 0), Dlm EndToken], "", 0);
-
- val prods' = (map mk_root roots) @ prods;
- in
- mk_earley_gram (mk_pre_grammar prods')
- end;
-
-
-(* translate (from xgram.ML) *)
-
-fun translate trfn =
- map (fn Dlm t => Dlm (trfn t) | Arg s => Arg s);
-
-
-(* mk_gram_tabs *)
-
-fun str_to_tok (opl: string prod list): token prod list =
- map
- (fn Prod (t, syn, s, pa) => Prod (t, translate Token syn, s, pa))
- opl;
-
-fun mk_gram_tabs roots prods = compile_xgram (roots, str_to_tok prods);
-
-
-
-(** build gram **)
-
-fun mk_gram roots prods = (roots, prods, mk_gram_tabs roots prods);
-
-fun sub_gram (roots1, prods1, _) (roots2, prods2, _) =
- roots1 subset roots2 andalso prods1 subset prods2;
-
-
-(* empty, extend, merge grams *)
-
-val empty_gram = mk_gram [] [];
-
-fun extend_gram (gram1 as (roots1, prods1, _)) roots2 xprods2 =
- let
- fun symb_of (Delim s) = Some (Dlm s)
- | symb_of (Argument s_p) = Some (Arg s_p)
- | symb_of _ = None;
-
- fun prod_of (XProd (lhs, xsymbs, const, pri)) =
- Prod (lhs, mapfilter symb_of xsymbs, const, pri);
-
- val prods2 = distinct (map prod_of xprods2);
- in
- if roots2 subset roots1 andalso prods2 subset prods1 then gram1
- else mk_gram (extend_list roots1 roots2) (extend_list prods1 prods2)
- end;
-
-fun merge_grams (gram1 as (roots1, prods1, _)) (gram2 as (roots2, prods2, _)) =
- if sub_gram gram2 gram1 then gram1
- else if sub_gram gram1 gram2 then gram2
- else mk_gram (merge_lists roots1 roots2) (merge_lists prods1 prods2);
-
-
-(* pretty_gram *)
-
-fun pretty_gram (_, prods, _) =
- let
- fun pretty_name name = [Pretty.str (name ^ " =")];
-
- fun pretty_symb (Dlm s) = Pretty.str (quote s)
- | pretty_symb (Arg (s, p)) =
- if is_terminal s then Pretty.str s
- else Pretty.str (s ^ "[" ^ string_of_int p ^ "]");
-
- fun pretty_const "" = []
- | pretty_const c = [Pretty.str ("=> " ^ quote c)];
-
- fun pretty_pri p = [Pretty.str ("(" ^ string_of_int p ^ ")")];
-
- fun pretty_prod (Prod (name, symbs, const, pri)) =
- Pretty.block (Pretty.breaks (pretty_name name @
- map pretty_symb symbs @ pretty_const const @ pretty_pri pri));
- in
- map pretty_prod prods
- end;
-
-
-
-(* State: nonterminal#, production#, index in production,
- index of originating state set,
- parse trees generated so far,
-*)
-
-datatype State = St of int * int * int * int * parsetree list
-withtype StateSet = State LListR * (State -> unit) LListR;
-type Compl = State -> unit;
-type StateSetList = StateSet array;
-(* Debugging:
-val print_SL = seqll(fn St(nti,pi,ip,fs,ptl)=>
-(print_int nti; prs" "; print_int pi; prs" "; print_int ip; prs" ";
-print_int fs; prs" "; print_int(len ptl); prs"\n"));
-
-fun print_SS(s1,delr) = (writeln"================="; print_SL s1);
-
-fun count_ss(ref nilL) = 0
- | count_ss(ref(_ & ss)) = count_ss(ss)+1;
-
-fun print_stat(state_sets) =
- let fun pr i = let val(s1,_)=sub(state_sets,i)
- in prs" "; print_int(count_ss s1) end;
- in prs"["; forA(pr,state_sets); prs"]\n" end;
-*)
-fun mt_stateS():StateSet = (ref nilL, ref nilL);
-
-fun mt_states(n):StateSetList = array(n,mt_stateS());
-
-fun ismt_stateS((ref nilL,_):StateSet) = true | ismt_stateS _ = false;
-
-fun fst_state((ref(st & _),_): StateSet) = st;
-
-fun apply_all_states(f,(slr,_):StateSet) = seqll f slr;
-
-fun add_state(nti,pi,ip,from,ptl,(sllr,delr):StateSet) =
- let fun add(ref(St(nti',pi',ip',from',_) & rest)) =
- if nti=nti' andalso pi=pi' andalso ip=ip' andalso from=from'
- then ()
- else add rest |
- add(last as ref nilL) =
- let val newst = St(nti,pi,ip,from,ptl)
- in last := newst & ref nilL;
- seqll (fn compl => compl newst) delr
- end;
- in add sllr end;
-
-fun complete(nti,syA,opn,p,ptl,ss,si as (_,delr):StateSet,opLA,rchA) =
- let val pt = mk_pt(opn,ptl)
- fun compl(St(ntj,pj,jp,from,ptl)) =
- let val Op(syj,_,_) = sub(fst(sub(opLA,ntj)),pj) in
- if jp=length(syj) then () else
- case sub(syj,jp) of
- NT(nt,p') => if p >= p' andalso nti mem sub(rchA,nt)
- then add_state(ntj,pj,jp+1,from,ptl@[pt], si)
- else ()
- | _ => ()
- end
- in apply_all_states(compl,ss);
- if length(syA)=0 (* delayed completion in case of empty production: *)
- then delr := compl & ref(!delr) else ()
- end;
-
-fun predict(tk,isi,si,p',opLA) = fn nti =>
- let val (opA,tm) = sub(opLA,nti);
- fun add(pi) = let val opr as Op(syA,_,p) = sub(opA,pi)
- in if p < p' then () else add_state(nti,pi,0,isi,[],si) end
- in seq add (applyTokenMap(tm,tk)) end;
-
-
-
-fun unknown c = error ("Unparsable category: " ^ c);
-
-fun syn_err toks =
- error ("Syntax error at: " ^ quote (space_implode " " (map str_of_token toks)));
-
-fun parse ((_, _, (tab, opLA, rchA)):gram) (root:string) (tl: token list): parsetree list =
- let
- val tl' = tl;
- val state_sets = mt_states(len tl' + 1);
- val s0 = mt_stateS();
- val rooti = case Symtab.lookup(tab, RootPref^root) of
- Some(ri) => ri | None => unknown root;
-
- fun lr (tl, isi, si, t) =
- if ismt_stateS(si) then syn_err (t::tl) else
- case tl of
- [] => () |
- t::tl =>
- let val si1 = mt_stateS();
- fun process(St(nti,pi,ip,from,ptl)) =
- let val opA = #1(sub(opLA,nti))
- val Op(syA,opn,p) = sub(opA,pi) in
- if ip = length(syA)
- then complete(nti,syA,opn,p,ptl,
- sub(state_sets,from),si,opLA,rchA)
- else case sub(syA,ip) of
- NT(ntj,p) =>
- seq (predict(t,isi,si,p,opLA)) (sub(rchA,ntj))
- | T(t') =>
- if matching_tokens(t,t')
- then add_state(nti,pi,ip+1,from,
- if valued_token(t)
- then ptl@[Tip(t)] else ptl,
- si1)
- else () end;
-
- in apply_all_states(process,si);
- update(state_sets,isi+1,si1);
- lr(tl,isi+1,si1,t) end
-
- in
- update (state_sets, 0, s0);
- add_state (rooti, 0, 0, 0, [], s0);
- lr (tl', 0, s0, EndToken(*dummy*));
- (*print_stat state_sets;*)
- let val St(_, _, _, _, [pt]) = fst_state(sub(state_sets, len tl'))
- in [pt] end
- end;
-
-end;
-
-
-end;
-
--- a/src/Pure/Syntax/extension.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,315 +0,0 @@
-(* Title: Pure/Syntax/extension.ML
- ID: $Id$
- Author: Tobias Nipkow and Markus Wenzel, TU Muenchen
-
-External grammar definition (internal interface).
-*)
-
-signature EXTENSION0 =
-sig
- val typeT: typ
- val constrainC: string
-end;
-
-signature EXTENSION =
-sig
- include EXTENSION0
- structure XGram: XGRAM
- local open XGram XGram.Ast in
- datatype mfix = Mfix of string * typ * string * int list * int
- datatype ext =
- Ext of {
- roots: string list,
- mfix: mfix list,
- extra_consts: string list,
- parse_ast_translation: (string * (ast list -> ast)) list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list,
- print_ast_translation: (string * (ast list -> ast)) list} |
- ExtRules of {
- parse_rules: (ast * ast) list,
- print_rules: (ast * ast) list} |
- ExtRoots of string list
- val logic: string
- val args: string
- val idT: typ
- val varT: typ
- val tfreeT: typ
- val tvarT: typ
- val typ_to_nonterm: typ -> string
- val applC: string
- val empty_xgram: xgram
- val extend_xgram: xgram -> ext -> xgram
- val mk_xgram: ext -> xgram
- end
-end;
-
-functor ExtensionFun(structure XGram: XGRAM and Lexicon: LEXICON): EXTENSION =
-struct
-
-structure XGram = XGram;
-open XGram XGram.Ast Lexicon;
-
-
-(** datatype ext **)
-
-(*Mfix (sy, ty, c, ps, p):
- sy: rhs of production as symbolic string
- ty: type description of production
- c: head of parse tree
- ps: priorities of arguments in sy
- p: priority of production*)
-
-datatype mfix = Mfix of string * typ * string * int list * int;
-
-datatype ext =
- Ext of {
- roots: string list,
- mfix: mfix list,
- extra_consts: string list,
- parse_ast_translation: (string * (ast list -> ast)) list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list,
- print_ast_translation: (string * (ast list -> ast)) list} |
- ExtRules of {
- parse_rules: (ast * ast) list,
- print_rules: (ast * ast) list} |
- ExtRoots of string list;
-
-
-(* ext_components *)
-
-fun ext_components (Ext ext) = {
- roots = #roots ext,
- mfix = #mfix ext,
- extra_consts = #extra_consts ext,
- parse_ast_translation = #parse_ast_translation ext,
- parse_rules = [],
- parse_translation = #parse_translation ext,
- print_translation = #print_translation ext,
- print_rules = [],
- print_ast_translation = #print_ast_translation ext}
- | ext_components (ExtRules {parse_rules, print_rules}) = {
- roots = [],
- mfix = [],
- extra_consts = [],
- parse_ast_translation = [],
- parse_rules = parse_rules,
- parse_translation = [],
- print_translation = [],
- print_rules = print_rules,
- print_ast_translation = []}
- | ext_components (ExtRoots roots) = {
- roots = roots,
- mfix = [],
- extra_consts = [],
- parse_ast_translation = [],
- parse_rules = [],
- parse_translation = [],
- print_translation = [],
- print_rules = [],
- print_ast_translation = []};
-
-
-(* empty_xgram *)
-
-val empty_xgram =
- XGram {
- roots = [], prods = [], consts = [],
- parse_ast_translation = [],
- parse_rules = [],
- parse_translation = [],
- print_translation = [],
- print_rules = [],
- print_ast_translation = []};
-
-
-(* syntactic categories *)
-
-val logic = "logic";
-val logicT = Type (logic, []);
-
-val logic1 = "logic1";
-val logic1T = Type (logic1, []);
-
-val args = "args";
-val argsT = Type (args, []);
-
-val funT = Type ("fun", []);
-
-val typeT = Type ("type", []);
-
-
-(* terminals *)
-
-val idT = Type (id, []);
-val varT = Type (var, []);
-val tfreeT = Type (tfree, []);
-val tvarT = Type (tvar, []);
-
-
-(* constants *)
-
-val applC = "_appl";
-val constrainC = "_constrain";
-
-
-(* typ_to_nonterm *)
-
-fun typ_to_nonterm (Type (c, _)) = c
- | typ_to_nonterm _ = logic;
-
-fun typ_to_nonterm1 (Type (c, _)) = c
- | typ_to_nonterm1 _ = logic1;
-
-
-
-(** mfix_to_prod **)
-
-fun mfix_to_prod (Mfix (sy, typ, const, pris, pri)) =
- let
- fun err msg =
- (writeln ("Error in mixfix annotation " ^ quote sy ^ " for " ^ quote const);
- error msg);
-
- fun check_pri p =
- if p >= 0 andalso p <= max_pri then ()
- else err ("precedence out of range: " ^ string_of_int p);
-
- fun blocks_ok [] 0 = true
- | blocks_ok [] _ = false
- | blocks_ok (Bg _ :: syms) n = blocks_ok syms (n + 1)
- | blocks_ok (En :: _) 0 = false
- | blocks_ok (En :: syms) n = blocks_ok syms (n - 1)
- | blocks_ok (_ :: syms) n = blocks_ok syms n;
-
- fun check_blocks syms =
- if blocks_ok syms 0 then ()
- else err "unbalanced block parentheses";
-
-
- fun is_meta c = c mem ["(", ")", "/", "_"];
-
- fun scan_delim_char ("'" :: c :: cs) =
- if is_blank c then err "illegal spaces in delimiter" else (c, cs)
- | scan_delim_char ["'"] = err "trailing escape character"
- | scan_delim_char (chs as c :: cs) =
- if is_blank c orelse is_meta c then raise LEXICAL_ERROR else (c, cs)
- | scan_delim_char [] = raise LEXICAL_ERROR;
-
- val scan_symb =
- $$ "_" >> K (Nonterminal ("", 0)) ||
- $$ "(" -- scan_int >> (Bg o #2) ||
- $$ ")" >> K En ||
- $$ "/" -- $$ "/" >> K (Brk ~1) ||
- $$ "/" -- scan_any is_blank >> (Brk o length o #2) ||
- scan_any1 is_blank >> (Space o implode) ||
- repeat1 scan_delim_char >> (Terminal o implode);
-
-
- val cons_fst = apfst o cons;
-
- fun add_args [] ty [] = ([], typ_to_nonterm1 ty)
- | add_args [] _ _ = err "too many precedences"
- | add_args (Nonterminal _ :: syms) (Type ("fun", [ty, tys])) [] =
- cons_fst (Nonterminal (typ_to_nonterm ty, 0)) (add_args syms tys [])
- | add_args (Nonterminal _ :: syms) (Type ("fun", [ty, tys])) (p :: ps) =
- cons_fst (Nonterminal (typ_to_nonterm ty, p)) (add_args syms tys ps)
- | add_args (Nonterminal _ :: _) _ _ =
- err "more arguments than in corresponding type"
- | add_args (sym :: syms) ty ps = cons_fst sym (add_args syms ty ps);
-
-
- fun is_arg (Nonterminal _) = true
- | is_arg _ = false;
-
- fun is_term (Terminal _) = true
- | is_term (Nonterminal (s, _)) = is_terminal s
- | is_term _ = false;
-
- fun rem_pri (Nonterminal (s, _)) = Nonterminal (s, chain_pri)
- | rem_pri sym = sym;
-
-
- val (raw_symbs, _) = repeat scan_symb (explode sy);
- val (symbs, lhs) = add_args raw_symbs typ pris;
- val prod = Prod (lhs, symbs, const, pri);
- in
- seq check_pri pris;
- check_pri pri;
- check_blocks symbs;
-
- if is_terminal lhs then err ("illegal lhs: " ^ lhs)
- else if const <> "" then prod
- else if length (filter is_arg symbs) <> 1 then
- err "copy production must have exactly one argument"
- else if exists is_term symbs then prod
- else Prod (lhs, map rem_pri symbs, "", chain_pri)
- end;
-
-
-
-(** extend_xgram **)
-
-fun extend_xgram (XGram xgram) ext =
- let
- fun descend (from, to) = Mfix ("_", to --> from, "", [0], 0);
-
- fun parents T = Mfix ("'(_')", T --> T, "", [0], max_pri);
-
- fun mkappl T =
- Mfix ("(1_/(1'(_')))", [funT, argsT] ---> T, applC, [max_pri, 0], max_pri);
-
- fun mkid T = Mfix ("_", idT --> T, "", [], max_pri);
-
- fun mkvar T = Mfix ("_", varT --> T, "", [], max_pri);
-
- fun constrain T =
- Mfix ("_::_", [T, typeT] ---> T, constrainC, [max_pri, 0], max_pri - 1);
-
-
- val {roots = roots1, prods, consts,
- parse_ast_translation = parse_ast_translation1,
- parse_rules = parse_rules1,
- parse_translation = parse_translation1,
- print_translation = print_translation1,
- print_rules = print_rules1,
- print_ast_translation = print_ast_translation1} = xgram;
-
- val {roots = roots2, mfix, extra_consts,
- parse_ast_translation = parse_ast_translation2,
- parse_rules = parse_rules2,
- parse_translation = parse_translation2,
- print_translation = print_translation2,
- print_rules = print_rules2,
- print_ast_translation = print_ast_translation2} = ext_components ext;
-
- val Troots = map (apr (Type, [])) (roots2 \\ roots1);
- val Troots' = Troots \\ [typeT, propT, logicT];
- val mfix' = mfix @ map parents (Troots \ logicT) @ map mkappl Troots' @
- map mkid Troots' @ map mkvar Troots' @ map constrain Troots' @
- map (apl (logicT, descend)) (Troots \\ [typeT, logicT]) @
- map (apr (descend, logic1T)) Troots';
- val mfix_consts =
- distinct (filter is_xid (map (fn (Mfix (_, _, c, _, _)) => c) mfix'));
- in
- XGram {
- roots = distinct (roots1 @ roots2),
- prods = prods @ map mfix_to_prod mfix',
- consts = extra_consts union (mfix_consts union consts),
- parse_ast_translation = parse_ast_translation1 @ parse_ast_translation2,
- parse_rules = parse_rules1 @ parse_rules2,
- parse_translation = parse_translation1 @ parse_translation2,
- print_translation = print_translation1 @ print_translation2,
- print_rules = print_rules1 @ print_rules2,
- print_ast_translation = print_ast_translation1 @ print_ast_translation2}
- end;
-
-
-(* mk_xgram *)
-
-val mk_xgram = extend_xgram empty_xgram;
-
-
-end;
-
--- a/src/Pure/Syntax/parse_tree.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-(* Title: Pure/Syntax/parse_tree.ML
- ID: $Id$
- Author: Tobias Nipkow and Markus Wenzel, TU Muenchen
-
-TODO:
- move parsetree to parser.ML
- move pt_to_ast before ast_to_term (sextension.ML (?))
- delete this file
-*)
-
-signature PARSE_TREE =
-sig
- structure Ast: AST
- structure Lexicon: LEXICON
- local open Ast Lexicon in
- datatype parsetree =
- Node of string * parsetree list |
- Tip of token
- val pt_to_ast: (string -> (ast list -> ast) option) -> parsetree -> ast
- end
-end;
-
-functor ParseTreeFun(structure Ast: AST and Lexicon: LEXICON): PARSE_TREE =
-struct
-
-structure Ast = Ast;
-structure Lexicon = Lexicon;
-open Ast Lexicon;
-
-
-(* datatype parsetree *)
-
-datatype parsetree =
- Node of string * parsetree list |
- Tip of token;
-
-
-(* pt_to_ast *)
-
-fun pt_to_ast trf pt =
- let
- fun trans a args =
- (case trf a of
- None => mk_appl (Constant a) args
- | Some f => f args handle exn
- => (writeln ("Error in parse ast translation for " ^ quote a); raise exn));
-
- fun ast_of (Node (a, pts)) = trans a (map ast_of pts)
- | ast_of (Tip tok) = Variable (str_of_token tok);
- in
- ast_of pt
- end;
-
-
-end;
-
--- a/src/Pure/Syntax/sextension.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,591 +0,0 @@
-(* Title: Pure/Syntax/sextension.ML
- ID: $Id$
- Author: Tobias Nipkow and Markus Wenzel, TU Muenchen
-
-Syntax extensions (external interface): mixfix declarations, infixes,
-binders, translation rules / functions and the Pure syntax.
-
-TODO:
- move ast_to_term, pt_to_ast (?)
-*)
-
-infix |-> <-| <->;
-
-signature SEXTENSION0 =
-sig
- structure Parser: PARSER
- local open Parser.SynExt.Ast in
- datatype mixfix =
- Mixfix of string * string * string * int list * int |
- Delimfix of string * string * string |
- Infixl of string * string * int |
- Infixr of string * string * int |
- Binder of string * string * string * int * int |
- TInfixl of string * string * int |
- TInfixr of string * string * int
- datatype xrule =
- op |-> of (string * string) * (string * string) |
- op <-| of (string * string) * (string * string) |
- op <-> of (string * string) * (string * string)
- datatype sext =
- Sext of {
- mixfix: mixfix list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list} |
- NewSext of {
- mixfix: mixfix list,
- xrules: xrule list,
- parse_ast_translation: (string * (ast list -> ast)) list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list,
- print_ast_translation: (string * (ast list -> ast)) list}
- val eta_contract: bool ref
- val mk_binder_tr: string * string -> string * (term list -> term)
- val mk_binder_tr': string * string -> string * (term list -> term)
- val dependent_tr': string * string -> term list -> term
- val max_pri: int
- end
-end;
-
-signature SEXTENSION1 =
-sig
- include SEXTENSION0
- local open Parser.SynExt.Ast in
- val empty_sext: sext
- val simple_sext: mixfix list -> sext
- val constants: sext -> (string list * string) list
- val pure_sext: sext
- val syntax_types: string list
- val syntax_consts: (string list * string) list
- val constrainAbsC: string
- val pure_trfuns:
- (string * (ast list -> ast)) list *
- (string * (term list -> term)) list *
- (string * (term list -> term)) list *
- (string * (ast list -> ast)) list
- end
-end;
-
-signature SEXTENSION =
-sig
- include SEXTENSION1
- local open Parser Parser.SynExt Parser.SynExt.Ast in
- val xrules_of: sext -> xrule list
- val abs_tr': term -> term
- val prop_tr': bool -> term -> term
- val appl_ast_tr': ast * ast list -> ast
- val syn_ext_of_sext: string list -> string list -> string list -> (string -> typ) -> sext -> syn_ext
- val pt_to_ast: (string -> (ast list -> ast) option) -> parsetree -> ast
- val ast_to_term: (string -> (term list -> term) option) -> ast -> term
- end
-end;
-
-functor SExtensionFun(structure TypeExt: TYPE_EXT and Parser: PARSER
- sharing TypeExt.SynExt = Parser.SynExt): SEXTENSION =
-struct
-
-structure Parser = Parser;
-open TypeExt Parser.Lexicon Parser.SynExt.Ast Parser.SynExt Parser;
-
-
-(** datatype sext **) (* FIXME remove *)
-
-datatype mixfix =
- Mixfix of string * string * string * int list * int |
- Delimfix of string * string * string |
- Infixl of string * string * int |
- Infixr of string * string * int |
- Binder of string * string * string * int * int |
- TInfixl of string * string * int |
- TInfixr of string * string * int;
-
-
-(* FIXME -> syntax.ML, BASIC_SYNTAX, SYNTAX *)
-datatype xrule =
- op |-> of (string * string) * (string * string) |
- op <-| of (string * string) * (string * string) |
- op <-> of (string * string) * (string * string);
-
-datatype sext =
- Sext of {
- mixfix: mixfix list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list} |
- NewSext of {
- mixfix: mixfix list,
- xrules: xrule list,
- parse_ast_translation: (string * (ast list -> ast)) list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list,
- print_ast_translation: (string * (ast list -> ast)) list};
-
-
-(* simple_sext *)
-
-fun simple_sext mixfix =
- Sext {mixfix = mixfix, parse_translation = [], print_translation = []};
-
-
-(* empty_sext *)
-
-val empty_sext = simple_sext [];
-
-
-(* sext_components *)
-
-fun sext_components (Sext {mixfix, parse_translation, print_translation}) =
- {mixfix = mixfix,
- xrules = [],
- parse_ast_translation = [],
- parse_translation = parse_translation,
- print_translation = print_translation,
- print_ast_translation = []}
- | sext_components (NewSext cmps) = cmps;
-
-
-(* mixfix_of *)
-
-fun mixfix_of (Sext {mixfix, ...}) = mixfix
- | mixfix_of (NewSext {mixfix, ...}) = mixfix;
-
-
-(* xrules_of *)
-
-fun xrules_of (Sext _) = []
- | xrules_of (NewSext {xrules, ...}) = xrules;
-
-
-
-(*** translation functions ***) (* FIXME -> trans.ML *)
-
-fun const c = Const (c, dummyT);
-
-
-(** parse (ast) translations **)
-
-(* application *)
-
-fun appl_ast_tr (*"_appl"*) [f, args] = Appl (f :: unfold_ast "_args" args)
- | appl_ast_tr (*"_appl"*) asts = raise_ast "appl_ast_tr" asts;
-
-
-(* abstraction *)
-
-fun idtyp_ast_tr (*"_idtyp"*) [x, ty] = Appl [Constant constrainC, x, ty]
- | idtyp_ast_tr (*"_idtyp"*) asts = raise_ast "idtyp_ast_tr" asts;
-
-fun lambda_ast_tr (*"_lambda"*) [idts, body] =
- fold_ast_p "_abs" (unfold_ast "_idts" idts, body)
- | lambda_ast_tr (*"_lambda"*) asts = raise_ast "lambda_ast_tr" asts;
-
-fun abs_tr (*"_abs"*) [Free (x, T), body] = absfree (x, T, body)
- | abs_tr (*"_abs"*) (ts as [Const (c, _) $ Free (x, T) $ tT, body]) =
- if c = constrainC then
- const "_constrainAbs" $ absfree (x, T, body) $ tT
- else raise_term "abs_tr" ts
- | abs_tr (*"_abs"*) ts = raise_term "abs_tr" ts;
-
-
-(* nondependent abstraction *)
-
-fun k_tr (*"_K"*) [t] = Abs ("uu", dummyT, incr_boundvars 1 t)
- | k_tr (*"_K"*) ts = raise_term "k_tr" ts;
-
-
-(* binder *)
-
-fun mk_binder_tr (sy, name) =
- let
- fun tr (Free (x, T), t) = const name $ absfree (x, T, t)
- | tr (Const ("_idts", _) $ idt $ idts, t) = tr (idt, tr (idts, t))
- | tr (t1 as Const (c, _) $ Free (x, T) $ tT, t) =
- if c = constrainC then
- const name $ (const "_constrainAbs" $ absfree (x, T, t) $ tT)
- else raise_term "binder_tr" [t1, t]
- | tr (t1, t2) = raise_term "binder_tr" [t1, t2];
-
- fun binder_tr (*sy*) [idts, body] = tr (idts, body)
- | binder_tr (*sy*) ts = raise_term "binder_tr" ts;
- in
- (sy, binder_tr)
- end;
-
-
-(* meta propositions *)
-
-fun aprop_tr (*"_aprop"*) [t] = const constrainC $ t $ const "prop"
- | aprop_tr (*"_aprop"*) ts = raise_term "aprop_tr" ts;
-
-fun ofclass_tr (*"_ofclass"*) [ty, cls] =
- cls $ (const constrainC $ const "TYPE" $ (const "itself" $ ty))
- | ofclass_tr (*"_ofclass"*) ts = raise_term "ofclass_tr" ts;
-
-
-(* meta implication *)
-
-fun bigimpl_ast_tr (*"_bigimpl"*) [asms, concl] =
- fold_ast_p "==>" (unfold_ast "_asms" asms, concl)
- | bigimpl_ast_tr (*"_bigimpl"*) asts = raise_ast "bigimpl_ast_tr" asts;
-
-
-(* explode atoms *)
-
-fun explode_tr (*"_explode"*) (ts as [consC, nilC, bit0, bit1, txt]) =
- let
- fun mk_list [] = nilC
- | mk_list (t :: ts) = consC $ t $ mk_list ts;
-
- fun encode_bit 0 = bit0
- | encode_bit 1 = bit1
- | encode_bit _ = sys_error "encode_bit";
-
- fun encode_char c = (* FIXME leading 0s (?) *)
- mk_list (map encode_bit (radixpand (2, (ord c))));
-
- val str =
- (case txt of
- Free (s, _) => s
- | Const (s, _) => s
- | _ => raise_term "explode_tr" ts);
- in
- mk_list (map encode_char (explode str))
- end
- | explode_tr (*"_explode"*) ts = raise_term "explode_tr" ts;
-
-
-
-(** print (ast) translations **)
-
-(* application *)
-
-fun appl_ast_tr' (f, []) = raise_ast "appl_ast_tr'" [f]
- | appl_ast_tr' (f, args) = Appl [Constant "_appl", f, fold_ast "_args" args];
-
-
-(* abstraction *)
-
-fun strip_abss vars_of body_of tm =
- let
- fun free (x, _) = Free (x, dummyT);
-
- val vars = vars_of tm;
- val body = body_of tm;
- val rev_new_vars = rename_wrt_term body vars;
- in
- (map Free (rev rev_new_vars), subst_bounds (map free rev_new_vars, body))
- end;
-
-(*do (partial) eta-contraction before printing*)
-
-val eta_contract = ref false;
-
-fun eta_contr tm =
- let
- fun eta_abs (Abs (a, T, t)) =
- (case eta_abs t of
- t' as f $ u =>
- (case eta_abs u of
- Bound 0 =>
- if not (0 mem loose_bnos f) then incr_boundvars ~1 f
- else Abs (a, T, t')
- | _ => Abs (a, T, t'))
- | t' => Abs (a, T, t'))
- | eta_abs t = t;
- in
- if ! eta_contract then eta_abs tm else tm
- end;
-
-
-fun abs_tr' tm =
- foldr (fn (x, t) => const "_abs" $ x $ t)
- (strip_abss strip_abs_vars strip_abs_body (eta_contr tm));
-
-
-fun abs_ast_tr' (*"_abs"*) asts =
- (case unfold_ast_p "_abs" (Appl (Constant "_abs" :: asts)) of
- ([], _) => raise_ast "abs_ast_tr'" asts
- | (xs, body) => Appl [Constant "_lambda", fold_ast "_idts" xs, body]);
-
-
-(* binder *)
-
-fun mk_binder_tr' (name, sy) =
- let
- fun mk_idts [] = raise Match (*abort translation*)
- | mk_idts [idt] = idt
- | mk_idts (idt :: idts) = const "_idts" $ idt $ mk_idts idts;
-
- fun tr' t =
- let
- val (xs, bd) = strip_abss (strip_qnt_vars name) (strip_qnt_body name) t;
- in
- const sy $ mk_idts xs $ bd
- end;
-
- fun binder_tr' (*name*) (t :: ts) =
- list_comb (tr' (const name $ t), ts)
- | binder_tr' (*name*) [] = raise Match;
- in
- (name, binder_tr')
- end;
-
-
-(* idts *)
-
-fun idts_ast_tr' (*"_idts"*) [Appl [Constant c, x, ty], xs] =
- if c = constrainC then
- Appl [Constant "_idts", Appl [Constant "_idtyp", x, ty], xs]
- else raise Match
- | idts_ast_tr' (*"_idts"*) _ = raise Match;
-
-
-(* meta propositions *)
-
-fun prop_tr' show_sorts tm =
- let
- fun aprop t = const "_aprop" $ t;
-
- fun is_prop tys t =
- fastype_of1 (tys, t) = propT handle TERM _ => false;
-
- fun tr' _ (t as Const _) = t
- | tr' _ (t as Free (x, ty)) =
- if ty = propT then aprop (Free (x, dummyT)) else t
- | tr' _ (t as Var (xi, ty)) =
- if ty = propT then aprop (Var (xi, dummyT)) else t
- | tr' tys (t as Bound _) =
- if is_prop tys t then aprop t else t
- | tr' tys (Abs (x, ty, t)) = Abs (x, ty, tr' (ty :: tys) t)
- | tr' tys (t as t1 $ (t2 as Const ("TYPE", Type ("itself", [ty])))) =
- if is_prop tys t then
- const "_ofclass" $ term_of_typ show_sorts ty $ tr' tys t1
- else tr' tys t1 $ tr' tys t2
- | tr' tys (t as t1 $ t2) =
- (if is_Const (head_of t) orelse not (is_prop tys t)
- then I else aprop) (tr' tys t1 $ tr' tys t2);
- in
- tr' [] tm
- end;
-
-
-(* meta implication *)
-
-fun impl_ast_tr' (*"==>"*) asts =
- (case unfold_ast_p "==>" (Appl (Constant "==>" :: asts)) of
- (asms as _ :: _ :: _, concl)
- => Appl [Constant "_bigimpl", fold_ast "_asms" asms, concl]
- | _ => raise Match);
-
-
-(* dependent / nondependent quantifiers *)
-
-fun dependent_tr' (q, r) (A :: Abs (x, T, B) :: ts) =
- if 0 mem (loose_bnos B) then
- let val (x', B') = variant_abs (x, dummyT, B);
- in list_comb (const q $ Free (x', T) $ A $ B', ts) end
- else list_comb (const r $ A $ B, ts)
- | dependent_tr' _ _ = raise Match;
-
-
-(* implode atoms *)
-
-fun implode_ast_tr' (*"_implode"*) (asts as [Constant cons_name, nilC,
- bit0, bit1, bitss]) =
- let
- fun err () = raise_ast "implode_ast_tr'" asts;
-
- fun strip_list lst =
- let val (xs, y) = unfold_ast_p cons_name lst
- in if y = nilC then xs else err ()
- end;
-
- fun decode_bit bit =
- if bit = bit0 then "0"
- else if bit = bit1 then "1"
- else err ();
-
- fun decode_char bits =
- chr (#1 (scan_radixint (2, map decode_bit (strip_list bits))));
- in
- Variable (implode (map decode_char (strip_list bitss)))
- end
- | implode_ast_tr' (*"_implode"*) asts = raise_ast "implode_ast_tr'" asts;
-
-
-
-
-(** syn_ext_of_sext **) (* FIXME remove *)
-
-fun strip_esc str =
- let
- fun strip ("'" :: c :: cs) = c :: strip cs
- | strip ["'"] = []
- | strip (c :: cs) = c :: strip cs
- | strip [] = [];
- in
- implode (strip (explode str))
- end;
-
-fun infix_name sy = "op " ^ strip_esc sy;
-
-
-fun syn_ext_of_sext all_roots new_roots xconsts read_typ sext =
- let
- val {mixfix, parse_ast_translation, parse_translation, print_translation,
- print_ast_translation, ...} = sext_components sext;
-
- val tinfixT = [typeT, typeT] ---> typeT;
-
- fun binder (Binder (sy, _, name, _, _)) = Some (sy, name)
- | binder _ = None;
-
- fun binder_typ ty =
- (case read_typ ty of
- Type ("fun", [Type ("fun", [_, T2]), T3]) =>
- [Type ("idts", []), T2] ---> T3
- | _ => error ("Illegal binder type " ^ quote ty));
-
- fun mk_infix sy ty c p1 p2 p3 =
- [Mfix ("(_ " ^ sy ^ "/ _)", ty, c, [p1, p2], p3),
- Mfix ("op " ^ sy, ty, c, [], max_pri)];
-
- fun mfix_of (Mixfix (sy, ty, c, ps, p)) = [Mfix (sy, read_typ ty, c, ps, p)]
- | mfix_of (Delimfix (sy, ty, c)) = [Mfix (sy, read_typ ty, c, [], max_pri)]
- | mfix_of (Infixl (sy, ty, p)) =
- mk_infix sy (read_typ ty) (infix_name sy) p (p + 1) p
- | mfix_of (Infixr (sy, ty, p)) =
- mk_infix sy (read_typ ty) (infix_name sy) (p + 1) p p
- | mfix_of (Binder (sy, ty, _, p, q)) =
- [Mfix ("(3" ^ sy ^ "_./ _)", binder_typ ty, sy, [0, p], q)]
- | mfix_of (TInfixl (s, c, p)) =
- [Mfix ("(_ " ^ s ^ "/ _)", tinfixT, c, [p, p + 1], p)]
- | mfix_of (TInfixr (s, c, p)) =
- [Mfix ("(_ " ^ s ^ "/ _)", tinfixT, c, [p + 1, p], p)];
-
- val mfix = flat (map mfix_of mixfix);
- val binders = mapfilter binder mixfix;
- val bparses = map mk_binder_tr binders;
- val bprints = map (mk_binder_tr' o swap) binders;
- in
- syn_ext all_roots new_roots mfix (distinct (filter is_xid xconsts))
- (parse_ast_translation,
- bparses @ parse_translation,
- bprints @ print_translation,
- print_ast_translation)
- ([], [])
- end;
-
-
-
-(** constants **) (* FIXME remove *)
-
-fun constants sext =
- let
- fun consts (Delimfix (_, ty, c)) = ([c], ty)
- | consts (Mixfix (_, ty, c, _, _)) = ([c], ty)
- | consts (Infixl (c, ty, _)) = ([infix_name c], ty)
- | consts (Infixr (c, ty, _)) = ([infix_name c], ty)
- | consts (Binder (_, ty, c, _, _)) = ([c], ty)
- | consts _ = ([""], ""); (*is filtered out below*)
- in
- distinct (filter_out (fn (l, _) => l = [""]) (map consts (mixfix_of sext)))
- end;
-
-
-
-(** pt_to_ast **)
-
-fun pt_to_ast trf pt =
- let
- fun trans a args =
- (case trf a of
- None => mk_appl (Constant a) args
- | Some f => f args handle exn
- => (writeln ("Error in parse ast translation for " ^ quote a); raise exn));
-
- fun ast_of (Node (a, pts)) = trans a (map ast_of pts)
- | ast_of (Tip tok) = Variable (str_of_token tok);
- in
- ast_of pt
- end;
-
-
-
-(** ast_to_term **)
-
-fun ast_to_term trf ast =
- let
- fun trans a args =
- (case trf a of
- None => list_comb (const a, args)
- | Some f => f args handle exn
- => (writeln ("Error in parse translation for " ^ quote a); raise exn));
-
- fun term_of (Constant a) = trans a []
- | term_of (Variable x) = scan_var x
- | term_of (Appl (Constant a :: (asts as _ :: _))) =
- trans a (map term_of asts)
- | term_of (Appl (ast :: (asts as _ :: _))) =
- list_comb (term_of ast, map term_of asts)
- | term_of (ast as Appl _) = raise_ast "ast_to_term: malformed ast" [ast];
- in
- term_of ast
- end;
-
-
-
-(** pure_trfuns **)
-
-val pure_trfuns =
- ([(applC, appl_ast_tr), ("_lambda", lambda_ast_tr), ("_idtyp", idtyp_ast_tr),
- ("_bigimpl", bigimpl_ast_tr)],
- [("_abs", abs_tr), ("_aprop", aprop_tr), ("_ofclass", ofclass_tr),
- ("_K", k_tr), ("_explode", explode_tr)],
- [],
- [("_abs", abs_ast_tr'), ("_idts", idts_ast_tr'), ("==>", impl_ast_tr'),
- ("_implode", implode_ast_tr')]);
-
-val constrainAbsC = "_constrainAbs";
-
-
-(** the Pure syntax **) (* FIXME remove *)
-
-val pure_sext =
- NewSext {
- mixfix = [
- Mixfix ("(3%_./ _)", "[idts, 'a] => ('b => 'a)", "_lambda", [0], 0),
- Delimfix ("_", "'a => " ^ args, ""),
- Delimfix ("_,/ _", "['a, " ^ args ^ "] => " ^ args, "_args"),
- Delimfix ("_", "id => idt", ""),
- Mixfix ("_::_", "[id, type] => idt", "_idtyp", [0, 0], 0),
- Delimfix ("'(_')", "idt => idt", ""),
- Delimfix ("_", "idt => idts", ""),
- Mixfix ("_/ _", "[idt, idts] => idts", "_idts", [1, 0], 0),
- Delimfix ("_", "id => aprop", ""),
- Delimfix ("_", "var => aprop", ""),
- Mixfix ("(1_/(1'(_')))", "[('b => 'a), " ^ args ^ "] => aprop", applC, [max_pri, 0], max_pri),
- Delimfix ("PROP _", "aprop => prop", "_aprop"),
- Delimfix ("_", "prop => asms", ""),
- Delimfix ("_;/ _", "[prop, asms] => asms", "_asms"),
- Mixfix ("((3[| _ |]) ==>/ _)", "[asms, prop] => prop", "_bigimpl", [0, 1], 1),
- Mixfix ("(_ ==/ _)", "['a::{}, 'a] => prop", "==", [3, 2], 2),
- Mixfix ("(_ =?=/ _)", "['a::{}, 'a] => prop", "=?=", [3, 2], 2),
- Mixfix ("(_ ==>/ _)", "[prop, prop] => prop", "==>", [2, 1], 1),
- Binder ("!!", "('a::logic => prop) => prop", "all", 0, 0)],
- xrules = [],
- parse_ast_translation = [(applC, appl_ast_tr), ("_lambda", lambda_ast_tr),
- ("_idtyp", idtyp_ast_tr), ("_bigimpl", bigimpl_ast_tr)],
- parse_translation = [("_abs", abs_tr), ("_aprop", aprop_tr), ("_K", k_tr),
- ("_explode", explode_tr)],
- print_translation = [],
- print_ast_translation = [("_abs", abs_ast_tr'), ("_idts", idts_ast_tr'),
- ("==>", impl_ast_tr'), ("_implode", implode_ast_tr')]};
-
-val syntax_types = terminals @ ["syntax", logic, "type", "types", "sort",
- "classes", args, "idt", "idts", "aprop", "asms"];
-
-val syntax_consts = [(["_K", "_explode", "_implode"], "syntax")];
-
-
-end;
-
--- a/src/Pure/Syntax/xgram.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,100 +0,0 @@
-(* Title: Pure/Syntax/xgram.ML
- ID: $Id$
- Author: Tobias Nipkow and Markus Wenzel, TU Muenchen
-
-External grammar representation (internal interface).
-
-TODO:
- prod, xsymb: 'a --> string
- Terminal --> Literal, Nonterminal --> Argument (?)
-*)
-
-signature XGRAM =
-sig
- structure Ast: AST
- local open Ast in
- datatype 'a xsymb =
- Terminal of 'a |
- Nonterminal of string * int |
- Space of string |
- Bg of int | Brk of int | En
- datatype 'a prod = Prod of string * ('a xsymb list) * string * int
- val max_pri: int
- val chain_pri: int
- val literals_of: string prod list -> string list
- datatype xgram =
- XGram of {
- roots: string list,
- prods: string prod list,
- consts: string list,
- parse_ast_translation: (string * (ast list -> ast)) list,
- parse_rules: (ast * ast) list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list,
- print_rules: (ast * ast) list,
- print_ast_translation: (string * (ast list -> ast)) list}
- end
-end;
-
-functor XGramFun(Ast: AST): XGRAM =
-struct
-
-structure Ast = Ast;
-open Ast;
-
-
-(** datatype prod **)
-
-(*Terminal s: literal token s
- Nonterminal (s, p): nonterminal s requiring priority >= p, or valued token
- Space s: some white space for printing
- Bg, Brk, En: blocks and breaks for pretty printing*)
-
-datatype 'a xsymb =
- Terminal of 'a |
- Nonterminal of string * int |
- Space of string |
- Bg of int | Brk of int | En;
-
-
-(*Prod (lhs, syms, c, p):
- lhs: name of nonterminal on the lhs of the production
- syms: list of symbols on the rhs of the production
- c: head of parse tree
- p: priority of this production*)
-
-datatype 'a prod = Prod of string * ('a xsymb list) * string * int;
-
-val max_pri = 1000; (*maximum legal priority*)
-val chain_pri = ~1; (*dummy for chain productions*)
-
-
-(* literals_of *)
-
-fun literals_of prods =
- let
- fun lits_of (Prod (_, syn, _, _)) =
- mapfilter (fn Terminal s => Some s | _ => None) syn;
- in
- distinct (flat (map lits_of prods))
- end;
-
-
-
-(** datatype xgram **)
-
-datatype xgram =
- XGram of {
- roots: string list,
- prods: string prod list,
- consts: string list,
- parse_ast_translation: (string * (ast list -> ast)) list,
- parse_rules: (ast * ast) list,
- parse_translation: (string * (term list -> term)) list,
- print_translation: (string * (term list -> term)) list,
- print_rules: (ast * ast) list,
- print_ast_translation: (string * (ast list -> ast)) list};
-
-
-end;
-
--- a/src/Pure/Thy/parse.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,142 +0,0 @@
-(* Title: Pure/Thy/parse
- ID: $Id$
- Author: Sonia Mahjoub / Tobias Nipkow
- Copyright 1992 TU Muenchen
-
- modified Dezember 1993 by Max Breitling (type-variables added)
-
-The parser combinators.
-Adapted from Larry Paulson's ML for the Working Programmer.
-*)
-
-(*Global infix declarations for the parsing primitives*)
-infix 5 -- --$$ $$--;
-infix 3 >>;
-infix 0 ||;
-
-
-signature PARSE =
-sig
-
-type token
-val $$ : string ->
- (token * int) list -> string * (token * int)list
-val id : (token * int) list -> string * (token * int)list
-val nat : (token * int) list -> string * (token * int)list
-val stg : (token * int) list -> string * (token * int)list
-val txt : (token * int) list -> string * (token * int)list
-val typevar: (token * int) list -> string * (token * int)list
-val >> : ('a -> 'b * 'c) * ('b -> 'd) -> 'a -> 'd * 'c
-val || : ('a -> 'b) * ('a -> 'b) -> 'a -> 'b
-val -- : ('a -> 'b * 'c) * ('c -> 'd * 'e) ->
- 'a -> ('b * 'd) * 'e
-val $$-- : string * ((token * int)list -> 'b * 'c) ->
- (token * int) list -> 'b * 'c
-val --$$ : ( 'a -> 'b * (token * int)list ) * string ->
- 'a -> 'b * (token * int)list
-val !! : ((token * int) list -> 'a * (token * int) list )
- -> (token * int) list -> 'a * (token * int) list
-val empty : 'a -> 'b list * 'a
-val repeat : ('a -> 'b * 'a) -> 'a -> 'b list * 'a
-val repeat1: ('a -> 'b * 'a) -> 'a -> 'b list * 'a
-val list_of: ((token * int)list -> 'b * (token * int)list ) ->
- (token * int)list -> 'b list * (token * int)list
-val list_of1: ((token * int)list -> 'b * (token * int)list ) ->
- (token * int)list -> 'b list * (token * int)list
-val reader : ((token * int) list -> 'a * ('b * int) list )
- -> string list -> 'a
-
-end;
-
-
-
-functor ParseFUN (Lex: LEXICAL): PARSE =
-struct
-
-type token = Lex.token;
-
-datatype synerr = Line of string * string * int | EOF of string;
-
-exception SynError of synerr;
-
-fun synerr(Line(s1, s2, n)) =
- error("Syntax error on line " ^ (string_of_int n) ^ ": " ^ s1 ^
- " expected and " ^ s2 ^ " was found")
- | synerr(EOF(s)) = error("Syntax error on last line: " ^ s ^
- " expected and end-of-file was found");
-
-fun string_of_token (Lex.Key b) = b
- | string_of_token (Lex.Id b) = b
- | string_of_token (Lex.Nat b) = b
- | string_of_token (Lex.Txt b) = b
- | string_of_token (Lex.Stg b) = b
- | string_of_token (Lex.TypVar b) = b;
-
-fun line_err x = raise SynError(Line x);
-fun eof_err s = raise SynError(EOF s);
-
-fun $$a ((Lex.Key b,n) :: toks) =
- if a = b then (a,toks) else line_err(a,b,n)
- | $$a ((t,n) :: toks) = line_err (a,string_of_token t, n)
- | $$a _ = eof_err a;
-
-
-fun id ((Lex.Id b,n) :: toks) = (b, toks)
- | id ((t,n) :: toks) = line_err ("identifier", string_of_token t, n)
- | id _ = eof_err "identifier";
-
-
-fun nat ((Lex.Nat b,n) :: toks) = (b, toks)
- | nat ((t,n) :: toks) =
- line_err ("natural number", string_of_token t, n)
- | nat _ = eof_err "natural number";
-
-
-fun stg ((Lex.Stg b,n) :: toks) = (b, toks)
- | stg ((t,n) :: toks) = line_err("string", string_of_token t, n)
- | stg _ = eof_err"string";
-
-
-fun txt ((Lex.Txt b,n) :: toks) = (b, toks)
- | txt ((t,n) :: toks) = line_err ("ML text", string_of_token t, n)
- | txt _ = eof_err "ML text";
-
-fun typevar ((Lex.TypVar b,n) :: toks) = (b, toks)
- | typevar ((t,n)::toks) = line_err("type variable",string_of_token t,n)
- | typevar _ = eof_err "type variable";
-
-
-fun ( ph >> f) toks = let val (x, toks2) = ph toks in (f x, toks2) end;
-
-fun (ph1 || ph2) toks = ph1 toks handle SynError _ => ph2 toks;
-
-
-fun (ph1 -- ph2) toks =
- let val (x, toks2) = ph1 toks
- val (y, toks3) = ph2 toks2
- in ((x,y), toks3) end;
-
-fun (a $$-- ph) = $$a -- ph >> #2;
-
-fun (ph --$$ a) = ph -- $$a >> #1;
-
-fun !! ph toks = ph toks handle SynError s => synerr s;
-
-fun empty toks = ([], toks);
-
-fun repeat ph toks = ( ph -- repeat ph >> (op::)
- || empty ) toks;
-
-fun repeat1 ph = ph -- repeat ph >> (op::);
-
-fun list_of1 ph = ph -- repeat("," $$-- !! ph) >> (op::);
-fun list_of ph = list_of1 ph || empty;
-
-fun reader ph a =
- ( case ph (Lex.scan a) of
- (x, []) => x
- | (_,(_, n)::_) => error
- ("Syntax error on line " ^ (string_of_int n) ^ ": " ^
- "Extra characters in phrase")
- );
-end;
--- a/src/Pure/Thy/read.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,452 +0,0 @@
-(* Title: Pure/Thy/read
- ID: $Id$
- Author: Sonia Mahjoub / Tobias Nipkow / L C Paulson
- Copyright 1993 TU Muenchen
-
-Reading and writing the theory definition files.
-
-For theory XXX, the input file is called XXX.thy
- the output file is called .XXX.thy.ML
- and it then tries to read XXX.ML
-*)
-
-datatype thy_info = ThyInfo of {name: string, path: string,
- children: string list,
- thy_info: string option, ml_info: string option,
- theory: Thm.theory option};
-
-signature READTHY =
-sig
- datatype basetype = Thy of string
- | File of string
-
- val loaded_thys : thy_info list ref
- val loadpath : string list ref
- val delete_tmpfiles: bool ref
-
- val use_thy : string -> unit
- val update : unit -> unit
- val time_use_thy : string -> unit
- val unlink_thy : string -> unit
- val base_on : basetype list -> string -> Thm.theory
- val store_theory : string -> Thm.theory -> unit
-end;
-
-
-functor ReadthyFUN (structure ThySyn: THYSYN) : READTHY =
-struct
-
-datatype basetype = Thy of string
- | File of string;
-
-val loaded_thys = ref [ThyInfo {name = "Pure", path = "", children = [],
- thy_info = Some "", ml_info = Some "",
- theory = Some Thm.pure_thy}];
-
-val loadpath = ref ["."]; (*default search path for theory files *)
-
-val delete_tmpfiles = ref true; (*remove temporary files after use *)
-
-(*Make name of the output ML file for a theory *)
-fun out_name thy = "." ^ thy ^ ".thy.ML";
-
-(*Read a file specified by thy_file containing theory thy *)
-fun read_thy thy thy_file =
- let val instream = open_in thy_file;
- val outstream = open_out (out_name thy)
- in output (outstream, ThySyn.read (explode(input(instream, 999999))));
- close_out outstream;
- close_in instream
- end;
-
-fun file_exists file =
- let val instream = open_in file in close_in instream; true end
- handle Io _ => false;
-
-(*Get thy_info for a loaded theory *)
-fun get_thyinfo thy =
- let fun do_search (t :: loaded : thy_info list) =
- let val ThyInfo {name, ...} = t
- in if name = thy then Some t else do_search loaded end
- | do_search [] = None
- in do_search (!loaded_thys) end;
-
-(*Replace an item by the result of make_change *)
-fun change_thyinfo make_change =
- let fun search (t :: loaded) =
- let val ThyInfo {name, path, children, thy_info, ml_info,
- theory} = t
- val (new_t, continue) = make_change name path children thy_info
- ml_info theory
- in if continue then
- new_t :: (search loaded)
- else
- new_t :: loaded
- end
- | search [] = []
- in loaded_thys := search (!loaded_thys) end;
-
-(*Check if a theory was already loaded *)
-fun already_loaded thy =
- let val t = get_thyinfo thy
- in if is_none t then false
- else let val ThyInfo {thy_info, ml_info, ...} = the t
- in if is_none thy_info orelse is_none ml_info then false
- else true end
- end;
-
-(*Check if a theory file has changed since its last use.
- Return a pair of boolean values for .thy and for .ML *)
-fun thy_unchanged thy thy_file ml_file =
- let val t = get_thyinfo thy
- in if is_some t then
- let val ThyInfo {thy_info, ml_info, ...} = the t
- val tn = is_none thy_info;
- val mn = is_none ml_info
- in if not tn andalso not mn then
- ((file_info thy_file = the thy_info),
- (file_info ml_file = the ml_info))
- else if not tn andalso mn then (true, false)
- else (false, false)
- end
- else (false, false)
- end;
-
-exception FILE_NOT_FOUND; (*raised by find_file *)
-
-(*Find a file using a list of paths if no absolute or relative path is
- specified.*)
-fun find_file "" name =
- let fun find_it (curr :: paths) =
- if file_exists (tack_on curr name) then
- tack_on curr name
- else
- find_it paths
- | find_it [] = ""
- in find_it (!loadpath) end
- | find_file path name =
- if file_exists (tack_on path name) then tack_on path name
- else "";
-
-(*Get absolute pathnames for a new or already loaded theory *)
-fun get_filenames path name =
- let fun make_absolute file =
- if file = "" then "" else
- if hd (explode file) = "/" then file else tack_on (pwd ()) file;
-
- fun new_filename () =
- let val found = find_file path (name ^ ".thy")
- handle FILE_NOT_FOUND => "";
- val thy_file = make_absolute found;
- val (thy_path, _) = split_filename thy_file;
- val found = find_file path (name ^ ".ML");
- val ml_file = if thy_file = "" then make_absolute found
- else if file_exists (tack_on thy_path (name ^ ".ML"))
- then tack_on thy_path (name ^ ".ML")
- else "";
- val searched_dirs = if path = "" then (!loadpath) else [path]
- in if thy_file = "" andalso ml_file = "" then
- error ("Could not find file \"" ^ name ^ ".thy\" or \""
- ^ name ^ ".ML\" for theory \"" ^ name ^ "\"\n"
- ^ "in the following directories: \"" ^
- (space_implode "\", \"" searched_dirs) ^ "\"")
- else ();
- (thy_file, ml_file)
- end;
-
- val thy = get_thyinfo name
- in if is_some thy andalso path = "" then
- let val ThyInfo {path = abs_path, ...} = the thy;
- val (thy_file, ml_file) = if abs_path = "" then new_filename ()
- else (find_file abs_path (name ^ ".thy"),
- find_file abs_path (name ^ ".ML"))
- in if thy_file = "" andalso ml_file = "" then
- (writeln ("Warning: File \"" ^ (tack_on path name)
- ^ ".thy\"\ncontaining theory \"" ^ name
- ^ "\" no longer exists.");
- new_filename ()
- )
- else (thy_file, ml_file)
- end
- else new_filename ()
- end;
-
-(*Remove theory from all child lists in loaded_thys *)
-fun unlink_thy thy =
- let fun remove name path children thy_info ml_info theory =
- (ThyInfo {name = name, path = path, children = children \ thy,
- thy_info = thy_info, ml_info = ml_info,
- theory = theory}, true)
- in change_thyinfo remove end;
-
-(*Remove a theory from loaded_thys *)
-fun remove_thy thy =
- let fun remove (t :: ts) =
- let val ThyInfo {name, ...} = t
- in if name = thy then ts
- else t :: (remove ts)
- end
- | remove [] = []
- in loaded_thys := remove (!loaded_thys) end;
-
-(*Change thy_info and ml_info for an existent item *)
-fun set_info thy_new ml_new thy =
- let fun change name path children thy_info ml_info theory =
- if name = thy then
- (ThyInfo {name = name, path = path, children = children,
- thy_info = Some thy_new, ml_info = Some ml_new,
- theory = theory}, false)
- else
- (ThyInfo {name = name, path = path, children = children,
- thy_info = thy_info, ml_info = ml_info,
- theory = theory}, true)
- in change_thyinfo change end;
-
-(*Mark theory as changed since last read if it has been completly read *)
-fun mark_outdated thy =
- if already_loaded thy then set_info "" "" thy
- else ();
-
-(*Read .thy and .ML files that haven't been read yet or have changed since
- they were last read;
- loaded_thys is a thy_info list ref containing all theories that have
- completly been read by this and preceeding use_thy calls.
- If a theory changed since its last use its children are marked as changed *)
-fun use_thy name =
- let val (path, thy_name) = split_filename name;
- val (thy_file, ml_file) = get_filenames path thy_name;
- val (abs_path, _) = if thy_file = "" then split_filename ml_file
- else split_filename thy_file;
- val (thy_uptodate, ml_uptodate) = thy_unchanged thy_name
- thy_file ml_file;
-
- (*Set absolute path for loaded theory *)
- fun set_path () =
- let fun change name path children thy_info ml_info theory =
- if name = thy_name then
- (ThyInfo {name = name, path = abs_path, children = children,
- thy_info = thy_info, ml_info = ml_info,
- theory = theory}, false)
- else
- (ThyInfo {name = name, path = path, children = children,
- thy_info = thy_info, ml_info = ml_info,
- theory = theory}, true)
- in change_thyinfo change end;
-
- (*Mark all direct descendants of a theory as changed *)
- fun mark_children thy =
- let val ThyInfo {children, ...} = the (get_thyinfo thy)
- val loaded = filter already_loaded children
- in if loaded <> [] then
- (writeln ("The following children of theory " ^ (quote thy)
- ^ " are now out-of-date: "
- ^ (quote (space_implode "\",\"" loaded)));
- seq mark_outdated loaded
- )
- else ()
- end
-
- in if thy_uptodate andalso ml_uptodate then ()
- else
- (
- if thy_uptodate orelse thy_file = "" then ()
- else (writeln ("Reading \"" ^ name ^ ".thy\"");
- read_thy thy_name thy_file;
- use (out_name thy_name)
- );
-
- if ml_file = "" then ()
- else (writeln ("Reading \"" ^ name ^ ".ML\"");
- use ml_file);
-
- use_string ["store_theory " ^ quote thy_name ^ " " ^ thy_name
- ^ ".thy;"];
-
- (*Now set the correct info*)
- set_info (file_info thy_file) (file_info ml_file) thy_name;
- set_path ();
-
- (*Mark theories that have to be reloaded*)
- mark_children thy_name;
-
- (*Remove temporary files*)
- if not (!delete_tmpfiles) orelse (thy_file = "") orelse thy_uptodate
- then ()
- else delete_file (out_name thy_name)
- )
- end;
-
-fun time_use_thy tname = timeit(fn()=>
- (writeln("\n**** Starting Theory " ^ tname ^ " ****");
- use_thy tname;
- writeln("\n**** Finished Theory " ^ tname ^ " ****"))
- );
-
-(*Load all thy or ML files that have been changed and also
- all theories that depend on them *)
-fun update () =
- let (*List theories in the order they have to be loaded *)
- fun load_order [] result = result
- | load_order thys result =
- let fun next_level (t :: ts) =
- let val thy = get_thyinfo t
- in if is_some thy then
- let val ThyInfo {children, ...} = the thy
- in children union (next_level ts)
- end
- else next_level ts
- end
- | next_level [] = [];
-
- val children = next_level thys
- in load_order children ((result \\ children) @ children) end;
-
- fun reload_changed (t :: ts) =
- let val thy = get_thyinfo t;
-
- fun abspath () =
- if is_some thy then
- let val ThyInfo {path, ...} = the thy in path end
- else "";
-
- val (thy_file, ml_file) = get_filenames (abspath ()) t;
- val (thy_uptodate, ml_uptodate) =
- thy_unchanged t thy_file ml_file;
- in if thy_uptodate andalso ml_uptodate then ()
- else use_thy t;
- reload_changed ts
- end
- | reload_changed [] = ();
-
- (*Remove all theories that are no descendants of Pure.
- If there are still children in the deleted theory's list
- schedule them for reloading *)
- fun collect_garbage not_garbage =
- let fun collect (t :: ts) =
- let val ThyInfo {name, children, ...} = t
- in if name mem not_garbage then collect ts
- else (writeln("Theory \"" ^ name
- ^ "\" is no longer linked with Pure - removing it.");
- remove_thy name;
- seq mark_outdated children
- )
- end
- | collect [] = ()
-
- in collect (!loaded_thys) end
-
- in collect_garbage ("Pure" :: (load_order ["Pure"] []));
- reload_changed (load_order ["Pure"] [])
- end;
-
-(*Merge theories to build a base for a new theory.
- Base members are only loaded if they are missing. *)
-fun base_on bases child =
- let (*List all descendants of a theory list *)
- fun list_descendants (t :: ts) =
- let val tinfo = get_thyinfo t
- in if is_some tinfo then
- let val ThyInfo {children, ...} = the tinfo
- in children union (list_descendants (ts union children))
- end
- else []
- end
- | list_descendants [] = [];
-
- (*Show the cycle that would be created by add_child *)
- fun show_cycle base =
- let fun find_it result curr =
- let val tinfo = get_thyinfo curr
- in if base = curr then
- error ("Cyclic dependency of theories: "
- ^ child ^ "->" ^ base ^ result)
- else if is_some tinfo then
- let val ThyInfo {children, ...} = the tinfo
- in seq (find_it ("->" ^ curr ^ result)) children
- end
- else ()
- end
- in find_it "" child end;
-
- (*Check if a cycle will be created by add_child *)
- fun find_cycle base =
- if base mem (list_descendants [child]) then show_cycle base
- else ();
-
- (*Add child to child list of base *)
- fun add_child base =
- let fun add (t :: loaded) =
- let val ThyInfo {name, path, children,
- thy_info, ml_info, theory} = t
- in if name = base then
- ThyInfo {name = name, path = path,
- children = child ins children,
- thy_info = thy_info, ml_info = ml_info,
- theory = theory} :: loaded
- else
- t :: (add loaded)
- end
- | add [] =
- [ThyInfo {name = base, path = "", children = [child],
- thy_info = None, ml_info = None, theory = None}]
- in loaded_thys := add (!loaded_thys) end;
-
- (*Load a base theory if not already done
- and no cycle would be created *)
- fun load base =
- let val thy_present = already_loaded base
- (*test this before child is added *)
- in
- if child = base then
- error ("Cyclic dependency of theories: " ^ child
- ^ "->" ^ child)
- else
- (find_cycle base;
- add_child base;
- if thy_present then ()
- else (writeln ("Autoloading theory " ^ (quote base)
- ^ " (used by " ^ (quote child) ^ ")");
- use_thy base)
- )
- end;
-
- (*Load all needed files and make a list of all real theories *)
- fun load_base (Thy b :: bs) =
- (load b;
- b :: (load_base bs))
- | load_base (File b :: bs) =
- (load b;
- load_base bs) (*don't add it to merge_theories' parameter *)
- | load_base [] = [];
-
- (*Get theory object for a loaded theory *)
- fun get_theory name =
- let val ThyInfo {theory, ...} = the (get_thyinfo name)
- in the theory end;
-
- val mergelist = (unlink_thy child;
- load_base bases);
- val (t :: ts) = if mergelist = [] then ["Pure"] else mergelist
- (*we have to return something *)
- in writeln ("Loading theory " ^ (quote child));
- foldl Thm.merge_theories (get_theory t, map get_theory ts) end;
-
-(*Change theory object for an existent item of loaded_thys
- or create a new item *)
-fun store_theory thy_name thy =
- let fun make_change (t :: loaded) =
- let val ThyInfo {name, path, children, thy_info, ml_info, ...} = t
- in if name = thy_name then
- ThyInfo {name = name, path = path, children = children,
- thy_info = thy_info, ml_info = ml_info,
- theory = Some thy} :: loaded
- else
- t :: (make_change loaded)
- end
- | make_change [] =
- [ThyInfo {name = thy_name, path = "", children = [],
- thy_info = Some "", ml_info = Some "",
- theory = Some thy}]
- in loaded_thys := make_change (!loaded_thys) end;
-
-end;
--- a/src/Pure/Thy/scan.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,172 +0,0 @@
-(* Title: Pure/Thy/scan
- ID: $Id$
- Author: Sonia Mahjoub / Tobias Nipkow
- Copyright 1992 TU Muenchen
-
- modified December 1993 by Max Breitling (Type-variables added)
-
-The scanner. Adapted from Larry Paulson's ML for the Working Programmer.
-*)
-
-signature LEXICAL =
-sig
-
-
-datatype token = Id of string
- | Key of string
- | Nat of string
- | Stg of string
- | Txt of string
- | TypVar of string
-
-val scan : string list -> (token * int) list
-end;
-
-signature KEYWORD =
-sig
-val alphas : string list
-val symbols : string list
-end;
-
-
-functor LexicalFUN (Keyword: KEYWORD): LEXICAL =
-
-struct
-
-
-
-datatype token = Id of string
- | Key of string
- | Nat of string
- | Stg of string
- | Txt of string
- | TypVar of string;
-
-
-fun lexerr(n,s) =
- error("Lexical error on line " ^ (string_of_int n) ^ ": " ^ s);
-
-val specials = explode"!{}@#$%^&*()+-=[]:\";,./?`_~<>|\\";
-
-fun is_symbol c = "_" = c orelse "'" = c;
-
-fun alphanum (id, c::cs) =
- if is_letter c orelse is_digit c orelse is_symbol c
- then alphanum (id ^ c , cs)
- else (id , c :: cs)
- | alphanum (id ,[]) = (id ,[]);
-
-fun numeric (nat, c::cs) =
- if is_digit c
- then numeric (nat^c, cs)
- else (nat, c::cs)
- | numeric (nat, []) = (nat,[]);
-
-fun tokenof (a, n) =
- if a mem Keyword.alphas
- then (Key a, n)
- else (Id a, n);
-
-fun symbolic (sy, c::cs) =
- if (sy mem Keyword.symbols) andalso
- not((sy^c) mem Keyword.symbols)
- orelse not (c mem specials)
- then (sy, c::cs)
- else symbolic(sy^c, cs)
- | symbolic (sy, []) = (sy, []);
-
-fun stringerr(n) = lexerr(n, "No matching quote found on this line");
-
-fun is_control_chr ([],_,n) = stringerr(n)
- | is_control_chr (c::cs,s,n) =
- let val m = ord c
- in if (m >= 64 andalso m <= 95)
- then (cs, s^c, n)
- else stringerr(n)
- end;
-
-fun is_3_dgt (c1::c2::cs, c,n) =
- let val s = c^c1^c2
- in if (s >= "000" andalso s <= "255")
- then (cs, s)
- else stringerr(n)
- end
- | is_3_dgt (_,_,n) = stringerr(n);
-
-fun is_imprt_seq ([],_,n) = stringerr(n)
- | is_imprt_seq ((c::cs),s,n) =
- if c = "\\" then (cs,s^"\\",n)
- else if c = "\n"
- then is_imprt_seq (cs,s^"\n",n+1)
- else if (c = "\t") orelse (c = " ")
- then is_imprt_seq (cs,s^c,n)
- else stringerr(n);
-
-fun is_escape_seq ([],_,n) = stringerr(n)
- | is_escape_seq ((c::cs),s,n) =
- if c = "\\" then (cs,s^"\\",n)
- else if c = "\n"
- then is_imprt_seq (cs,s^"\n",n+1)
- else if (c = "\t") orelse (c = " ")
- then is_imprt_seq (cs,s^c,n)
- else if c = "^"
- then is_control_chr (cs,s^"^",n)
- else if ("0" <= c andalso c <= "2")
- then let val (cs',s') =
- is_3_dgt(cs,c,n)
- in (cs',s^s',n)
- end
- else stringerr(n);
-
-
-fun string (_,[],_,n) = stringerr(n)
- | string (toks, c::cs, s, n) =
- if c = "\"" then ((Stg s, n)::toks , cs, n)
- else if c = "\\"
- then let val (cs',s',n') =
- is_escape_seq (cs, s^"\\",n)
- in string (toks,cs',s',n') end
- else string (toks,cs,s^c,n);
-
-
-fun comment ((c1::c2::cs), n) =
- if c1 = "*" andalso c2 = ")" then (cs,n) else
- if c1 = "\n" then comment((c2::cs), n+1)
- else comment((c2::cs), n)
- | comment (_, n) = lexerr(n, "Missing end of comment");
-
-fun scanning (toks , [], n) = rev toks
- | scanning (toks , c :: cs, n) =
- if is_letter c
- then let val (id , cs2) = alphanum (c , cs)
- in if id = "ML"
- then let val text = implode cs2
- in scanning ((Txt text,n) :: toks , [], n)
- end
- else scanning (tokenof(id,n) :: toks , cs2, n)
- end
- else if is_digit c
- then let val (nat , cs2) = numeric(c , cs)
- in scanning ((Nat nat,n) :: toks , cs2, n) end
-
- else if c = "'" andalso is_letter(hd cs)
- then let val (var, cs2) = alphanum (hd cs, tl cs)
- in scanning((TypVar (c^var),n) :: toks, cs2, n) end
-
- else if c mem specials
- then if c = "\""
- then let val (toks', cs', n') = string (toks, cs, "", n)
- in scanning (toks', cs', n') end
- else let val (sy , cs2) = symbolic (c , cs)
- in if sy = "(*"
- then let val (cs3,n2) = comment(cs2,n)
- in scanning (toks , cs3, n2) end
- else scanning ((Key sy,n) :: toks, cs2, n)
- end
- else if c = "\n" then scanning (toks, cs, n+1)
- else if c = " " orelse c = "\t" then scanning (toks , cs, n)
- else lexerr(n,"Illegal character " ^ c);
-
-fun scan a = scanning ([] , a, 1);
-
-end;
--- a/src/Pure/Thy/syntax.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,403 +0,0 @@
-(* Title: Pure/Thy/syntax.ML
- ID: $Id$
- Author: Sonia Mahjoub and Tobias Nipkow and Markus Wenzel, TU Muenchen
-
-Definition of theory syntax together with translation to ML code.
-*)
-
-signature THYSYN =
- sig
- datatype basetype = Thy of string
- | File of string
-
- val read: string list -> string
- end;
-
-
-
-functor ThySynFUN (Parse: PARSE): THYSYN =
-struct
-
-
-(*-------------- OBJECT TO STRING TRANSLATION ---------------*)
-
-fun parent s = "(" ^ s ^ ")";
-
-fun pair(a, b) = parent(a ^ ", " ^ b);
-
-fun triple(a, b, c) = parent(a ^ ", " ^ b ^ ", " ^ c);
-
-fun pair_quote(a, b) = pair(quote a, quote b);
-
-fun pair_quote2(a, b) = pair(a, quote b);
-
-fun bracket s = "[" ^ s ^ "]";
-
-val comma = space_implode ", ";
-
-val bracket_comma = bracket o comma;
-
-val big_bracket_comma = bracket o space_implode ",\n";
-
-fun big_bracket_comma_ind ind strs = bracket (space_implode (",\n" ^ ind) strs);
-
-val bracket_comma_quote = bracket_comma o (map quote);
-
-
-(*------------------- ABSTRACT SYNTAX FUNCTIONS ---------------------*)
-
-datatype mixfix = Mixfix of string * string * string
- | Delimfix of string
- | Infixl of string
- | Infixr of string
- | Binder of string * string
- | TInfixl of string
- | TInfixr of string;
-
-
-datatype pfix_or_mfix = Pref of string | Mixf of string;
-datatype type_or_abbr = Typed of pfix_or_mfix | Abbrd of pfix_or_mfix;
-
-fun pm_proj(Pref s) = s
- | pm_proj(Mixf s) = s;
-
-fun ta_proj(Typed s) = s
- | ta_proj(Abbrd s) = s;
-
-fun split_decls l =
- let val (p, m) = partition (fn Pref _ => true | _ => false) l;
- in (big_bracket_comma_ind " " (map pm_proj p), map pm_proj m) end;
-
-fun split_decls_type l =
- let val (t,a) = partition (fn Typed _ => true | _ => false) l
- val (tp,tm) = partition (fn Pref _ => true | _ => false) (map ta_proj t)
- val (ap,am) = partition (fn Pref _ => true | _ => false) (map ta_proj a)
- in (big_bracket_comma_ind " " (map pm_proj tp),
- big_bracket_comma_ind " " (map pm_proj ap),
- (map pm_proj tm) @ (map pm_proj am))
- end;
-
-
-fun delim_mix (s, None) = Delimfix(s)
- | delim_mix (s, Some(l, n)) = Mixfix(s, l, n);
-
-fun mixfix (sy, c, ty, l, n) = "Mixfix(" ^ comma[quote sy, c, ty, l, n] ^ ")";
-
-fun infixrl(ty, c, n) = parent(comma[ty, c, n]);
-
-fun binder(sy, c, ty, n) = "Binder(" ^ comma[quote sy, c, ty, "0", n] ^ ")";
-
-fun delimfix (sy, c, ty) = "Delimfix(" ^ comma[quote sy, c, ty] ^ ")";
-
-fun tinfixrl (ty, n) = "(" ^ comma[ty, ty, n] ^ ")";
-
-fun mk_mfix((c, ty), mfix) =
- let val cs = quote c and tys = quote ty
- in case mfix of
- Mixfix(sy, l, n) => mixfix (sy, tys, cs, l, n)
- | Infixr(n) => "Infixr" ^ infixrl(cs, tys, n)
- | Infixl(n) => "Infixl" ^ infixrl(cs, tys, n)
- | Binder(sy, n) => binder(sy, tys, cs, n)
- | TInfixl(n) => "TInfixl" ^ tinfixrl(cs, n)
- | TInfixr(n) => "TInfixr" ^ tinfixrl(cs, n)
- | Delimfix(sy) => delimfix(sy, tys, cs)
- end;
-
-
-fun mk_mixfix((cs, ty), None) =
- [Pref(pair(bracket_comma_quote cs, quote ty))]
- | mk_mixfix((c::cs, ty), Some(mfix)) =
- Mixf(mk_mfix((c, ty), mfix)) :: mk_mixfix((cs, ty), Some(mfix))
- | mk_mixfix(([], _), _) = [];
-
-fun mk_type_decl((ts, n), None) = [Typed(Pref(pair(bracket_comma_quote ts, n)))]
- | mk_type_decl((t::ts, n), Some(tinfix)) =
- [Typed(Pref(pair(bracket(quote t), n))), Typed(Mixf(mk_mfix((t, n), tinfix)))] @
- mk_type_decl((ts, n), Some(tinfix))
- | mk_type_decl(([], n), Some(tinfix)) = [];
-
-fun mk_abbr_decl(((ts, a), b), None) =
- [Abbrd(Pref(triple(quote a, ts, quote b)))]
- | mk_abbr_decl(((ts, a), b), Some(tinfix)) =
- [Abbrd(Pref(triple(quote a, ts, quote b))), Abbrd(Mixf(mk_mfix((a, "0"), tinfix)))];
-
-fun mk_extension (((((((cl, def), (ty, ab, tinfix)), ar), (co, mfix)), tr), ax), ml) =
- ((cl, def, ty, ab, ar, co, ax), big_bracket_comma_ind " " tinfix,
- big_bracket_comma_ind " " mfix, big_bracket_comma_ind " " tr, ml);
-
-fun add_val((id, _), s) = "val " ^ id ^ " = get_axiom thy " ^ quote id ^ "\n" ^ s;
-
-fun mk_rules ps =
- let
- val axs = big_bracket_comma_ind " " (map pair_quote ps);
- val vals = foldr add_val (ps, "")
- in
- axs ^ "\n\n" ^ vals
- end;
-
-fun mk_struct (id, s) = "structure " ^ id ^ " =\nstruct\n" ^ s ^ "\nend;\n";
-
-
-fun mk_sext mfix trans =
- "Some (NewSext {\n\
-\ mixfix =\n " ^ mfix ^ ",\n\
-\ xrules =\n " ^ trans ^ ",\n\
-\ parse_ast_translation = parse_ast_translation,\n\
-\ parse_translation = parse_translation,\n\
-\ print_translation = print_translation,\n\
-\ print_ast_translation = print_ast_translation})";
-
-fun mk_simple_sext mfix =
- "Some (Syntax.simple_sext\n " ^ mfix ^ ")";
-
-fun mk_ext ((cl, def, ty, ab, ar, co, ax), sext) =
- " (" ^ space_implode ",\n " [cl, def, ty, ab, ar, co, sext] ^ ")\n " ^ ax ^ "\n";
-
-fun mk_ext_thy (base, name, ext, sext) =
- "extend_theory (" ^ base ^ ")\n " ^ quote name ^ "\n" ^ mk_ext (ext, sext);
-
-val preamble =
- "\nlocal\n\
- \ val parse_ast_translation = []\n\
- \ val parse_translation = []\n\
- \ val print_translation = []\n\
- \ val print_ast_translation = []\n\
- \in\n\n\
- \(**** begin of user section ****)\n";
-
-val postamble = "\n(**** end of user section ****)\n";
-
-fun mk_structure ((name, base), Some (ext, tinfix, mfix, trans, ml)) =
- let
- val noext = ("[]", "[]", "[]", "[]", "[]", "[]", "[]");
- val basethy =
- if tinfix = "[]" then base ^ (quote name)
- else mk_ext_thy (base ^ (quote name), name ^ "(type infix)", noext, mk_simple_sext tinfix);
- val sext =
- if mfix = "[]" andalso trans = "[]" andalso ml = "" then "None"
- else mk_sext mfix trans;
- val thy = "val thy = " ^ mk_ext_thy (basethy, name, ext, sext);
- in
- mk_struct (name, preamble ^ ml ^ postamble ^ thy ^ "\nend")
- end
- | mk_structure ((name, base), None) =
- mk_struct (name, "\nval thy = " ^ base ^ (quote name));
-
-datatype basetype = Thy of string
- | File of string;
-
-fun merge thys =
- let fun make_list (Thy t :: ts) =
- ("Thy \"" ^ t ^ "\"") :: make_list ts
- | make_list (File t :: ts) =
- ("File \"" ^ t ^ "\"") :: make_list ts
- | make_list [] = []
- in "base_on " ^ (bracket (space_implode "," (make_list thys))) ^ " " end;
-
-
-
-(*------------------------ PARSERS -------------------------*)
-
-
-open Parse
-
-(*------------------- VARIOUS PARSERS ----------------------*)
-
-val emptyl = empty >> K "[]";
-
-val ids = list_of1 id >> bracket_comma_quote;
-(* -> "[id1, id2, ..., idn]" *)
-
-val stgorids = list_of1 (stg || id);
-val stgorid = stg || id;
-
-val sort = id >> (bracket o quote)
- || "{" $$-- (ids || emptyl) --$$ "}";
-(* -> "[id]"
- -> "[id1, ..., idn]" *)
-
-val infxl = "infixl" $$-- !! nat
-and infxr = "infixr" $$-- !! nat
-
-
-(*------------------- CLASSES PARSER ----------------------*)
-
-
-
-
-val class = (id >> quote) -- ( "<" $$-- (!! ids) || emptyl) >> pair;
-
-(* -> "(id, [id1, ..., idn])"
- ||
- -> "(id, [])" *)
-
-
-val classes = "classes" $$-- !!(repeat1 class) >> bracket_comma
- || emptyl;
-
-
-(* "[(id, [..]), ..., (id, [...])]" *)
-
-
-
-(*------------------- DEFAULT PARSER ---------------------*)
-
-
-val default = "default" $$-- !!sort
- || emptyl;
-
-(* -> "[]"
- -> "[id]"
- -> "[id1, ..., idn]" *)
-
-
-(*-------------------- TYPES PARSER ----------------------*)
-
-val xtypevar = typevar >> quote;
-
-val type_vars_decl = xtypevar >> (fn t => [t])
- || "(" $$-- list_of1(xtypevar) --$$ ")"
- || empty >> K [];
-
-val abbr_vars_decl = xtypevar >> bracket
- || "(" $$-- list_of1(xtypevar) --$$ ")" >> bracket_comma
- || empty >> K "[]";
-
-val type_decl = stgorids -- nat
- || type_vars_decl -- stgorid
- >> (fn (ns,t) => ([t], string_of_int(length(ns))));
-
-val abbr_decl = abbr_vars_decl -- stgorid --$$ "=" -- stg;
-
-val tyinfix = infxl >> (Some o TInfixl)
- || infxr >> (Some o TInfixr);
-
-val type_infix = "(" $$-- tyinfix --$$ ")"
- || empty >> K None;
-
-val types = "types" $$--
- !! (repeat1 ((abbr_decl -- type_infix >> mk_abbr_decl)
- || (type_decl -- type_infix >> mk_type_decl)))
- >> (split_decls_type o flat)
- || empty >> (K ("[]", "[]", []));
-
- (* ==> ("[(id, nat), ... ]", "[(id, typevars, stg), ...]", [strg, ...]) *)
-
-
-
-(*-------------------- ARITIES PARSER ----------------------*)
-
-
-val sorts = list_of sort >> bracket_comma;
-
-(* -> "[[id1, ...], ..., [id, ...]]" *)
-
-
-val arity = id >> (fn s => pair("[]", quote s))
- || "(" $$-- sorts --$$")" -- id >> (fn (l, s) => pair(l, quote s));
-
-(* -> "([], id)"
- -> "([[id, ..], ..., [id, ..]], id)" *)
-
-val tys = stgorids >> bracket_comma_quote;
-
-val arities = "arities" $$-- !! (repeat1 (tys --$$ "::" -- arity >> pair))
- >> bracket_comma
- || emptyl;
-
-(* -> "[([id, ..], ([[id, ...], ...], id))]" *)
-
-
-(*--------------------- CONSTS PARSER ---------------------*)
-
-val natlist = "[" $$-- !!(list_of nat --$$ "]") >> bracket_comma
- || empty >> K "[]";
-
-
- (* "[nat, ...]" || "[]" *)
-
-
-val prio_opt = natlist -- nat >> Some
- || empty >> K None;
-
-val mfix = stg -- !! prio_opt >> delim_mix
- || infxl >> Infixl
- || infxr >> Infixr
- || "binder" $$-- !!(stg -- nat) >> Binder
-
-val const_decl = stgorids -- !! ("::" $$-- stg);
-
-(*("[exid, ...]", stg) *)
-
-
-val mixfix = "(" $$-- !! (mfix --$$ ")") >> Some
- || empty >> K None;
-
-(* (s, e, l, n) *)
-
-
-val consts = "consts" $$--
- !! (repeat1 (const_decl -- mixfix >> mk_mixfix))
- >> (split_decls o flat)
- || empty >> K ("[]", []);
-
-(* ("[([exid, ...], stg), ....]", [strg, ..]) *)
-
-
-(*---------------- TRANSLATIONS PARSER --------------------*)
-
-val xpat = "(" $$-- id --$$ ")" -- stg >> pair_quote
- || stg >> (fn s => pair_quote ("logic", s));
-
-val arrow = $$ "=>" >> K " |-> "
- || $$ "<=" >> K " <-| "
- || $$ "==" >> K " <-> ";
-
-val xrule = xpat -- !! (arrow -- xpat) >> (fn (xp1, (a, xp2)) => xp1 ^ a ^ xp2);
-
-val translations = "translations" $$-- !! (repeat1 xrule)
- || empty;
-
-
-(*------------------- RULES PARSER -----------------------*)
-
-val rules = "rules" $$-- !! (repeat1 (id -- !! stg) >> mk_rules)
- || emptyl;
-
-(* "[(id, stg), ...]" *)
-
-(*----------------------- BASE PARSER -------------------------*)
-
-
-fun base toks =
- let fun make_thy (b, toks) = (Thy b, toks);
-
- fun make_file (b, toks) = (File b, toks);
-
- val (b, toks) = make_thy (id toks)
- handle _ => make_file (stg toks)
- in (b, toks) end;
-
-
-(*----------------------- ML_TEXT -------------------------*)
-
-val mltxt = txt || empty >> K "";
-
-
-(*---------------------------------------------------------*)
-
-val extension = "+" $$-- !! (classes -- default -- types -- arities
- -- consts -- translations -- rules --$$ "end" -- mltxt)
- >> (Some o mk_extension)
- || empty >> K None;
-
-
-val bases = base -- repeat("+" $$-- base) >> op:: ;
-
-val theoryDef = !!(id --$$ "=" -- (bases >> merge) -- extension)
- >> mk_structure;
-
-val read = reader theoryDef
-
-end;
-
--- a/src/ZF/Fin.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,106 +0,0 @@
-(* Title: ZF/ex/Fin.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1994 University of Cambridge
-
-Finite powerset operator
-
-prove X:Fin(A) ==> |X| < nat
-
-prove: b: Fin(A) ==> inj(b,b)<=surj(b,b)
-*)
-
-structure Fin = Inductive_Fun
- (val thy = Arith.thy |> add_consts [("Fin", "i=>i", NoSyn)]
- val thy_name = "Fin"
- val rec_doms = [("Fin","Pow(A)")]
- val sintrs = ["0 : Fin(A)",
- "[| a: A; b: Fin(A) |] ==> cons(a,b) : Fin(A)"]
- val monos = []
- val con_defs = []
- val type_intrs = [empty_subsetI, cons_subsetI, PowI]
- val type_elims = [make_elim PowD]);
-
-val [Fin_0I, Fin_consI] = Fin.intrs;
-
-
-goalw Fin.thy Fin.defs "!!A B. A<=B ==> Fin(A) <= Fin(B)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac Fin.bnd_mono 1));
-by (REPEAT (ares_tac (Pow_mono::basic_monos) 1));
-val Fin_mono = result();
-
-(* A : Fin(B) ==> A <= B *)
-val FinD = Fin.dom_subset RS subsetD RS PowD;
-
-(** Induction on finite sets **)
-
-(*Discharging x~:y entails extra work*)
-val major::prems = goal Fin.thy
- "[| b: Fin(A); \
-\ P(0); \
-\ !!x y. [| x: A; y: Fin(A); x~:y; P(y) |] ==> P(cons(x,y)) \
-\ |] ==> P(b)";
-by (rtac (major RS Fin.induct) 1);
-by (excluded_middle_tac "a:b" 2);
-by (etac (cons_absorb RS ssubst) 3 THEN assume_tac 3); (*backtracking!*)
-by (REPEAT (ares_tac prems 1));
-val Fin_induct = result();
-
-(** Simplification for Fin **)
-val Fin_ss = arith_ss addsimps Fin.intrs;
-
-(*The union of two finite sets is finite.*)
-val major::prems = goal Fin.thy
- "[| b: Fin(A); c: Fin(A) |] ==> b Un c : Fin(A)";
-by (rtac (major RS Fin_induct) 1);
-by (ALLGOALS (asm_simp_tac (Fin_ss addsimps (prems@[Un_0, Un_cons]))));
-val Fin_UnI = result();
-
-(*The union of a set of finite sets is finite.*)
-val [major] = goal Fin.thy "C : Fin(Fin(A)) ==> Union(C) : Fin(A)";
-by (rtac (major RS Fin_induct) 1);
-by (ALLGOALS (asm_simp_tac (Fin_ss addsimps [Union_0, Union_cons, Fin_UnI])));
-val Fin_UnionI = result();
-
-(*Every subset of a finite set is finite.*)
-goal Fin.thy "!!b A. b: Fin(A) ==> ALL z. z<=b --> z: Fin(A)";
-by (etac Fin_induct 1);
-by (simp_tac (Fin_ss addsimps [subset_empty_iff]) 1);
-by (safe_tac (ZF_cs addSDs [subset_cons_iff RS iffD1]));
-by (eres_inst_tac [("b","z")] (cons_Diff RS subst) 2);
-by (ALLGOALS (asm_simp_tac Fin_ss));
-val Fin_subset_lemma = result();
-
-goal Fin.thy "!!c b A. [| c<=b; b: Fin(A) |] ==> c: Fin(A)";
-by (REPEAT (ares_tac [Fin_subset_lemma RS spec RS mp] 1));
-val Fin_subset = result();
-
-val major::prems = goal Fin.thy
- "[| c: Fin(A); b: Fin(A); \
-\ P(b); \
-\ !!x y. [| x: A; y: Fin(A); x:y; P(y) |] ==> P(y-{x}) \
-\ |] ==> c<=b --> P(b-c)";
-by (rtac (major RS Fin_induct) 1);
-by (rtac (Diff_cons RS ssubst) 2);
-by (ALLGOALS (asm_simp_tac (Fin_ss addsimps (prems@[Diff_0, cons_subset_iff,
- Diff_subset RS Fin_subset]))));
-val Fin_0_induct_lemma = result();
-
-val prems = goal Fin.thy
- "[| b: Fin(A); \
-\ P(b); \
-\ !!x y. [| x: A; y: Fin(A); x:y; P(y) |] ==> P(y-{x}) \
-\ |] ==> P(0)";
-by (rtac (Diff_cancel RS subst) 1);
-by (rtac (Fin_0_induct_lemma RS mp) 1);
-by (REPEAT (ares_tac (subset_refl::prems) 1));
-val Fin_0_induct = result();
-
-(*Functions from a finite ordinal*)
-val prems = goal Fin.thy "n: nat ==> n->A <= Fin(nat*A)";
-by (nat_ind_tac "n" prems 1);
-by (simp_tac (ZF_ss addsimps [Pi_empty1, Fin_0I, subset_iff, cons_iff]) 1);
-by (asm_simp_tac (ZF_ss addsimps [succ_def, mem_not_refl RS cons_fun_eq]) 1);
-by (fast_tac (ZF_cs addSIs [Fin_consI]) 1);
-val nat_fun_subset_Fin = result();
--- a/src/ZF/Fin.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-Fin = Arith + "inductive" + "equalities"
--- a/src/ZF/IMP/Aexp.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-(* Title: ZF/IMP/Aexp.ML
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-structure Aexp = Datatype_Fun
- (
- val thy = Univ.thy |> add_consts [("loc", "i", NoSyn)]
- val thy_name = "Aexp"
- val rec_specs =
- [(
- "aexp", "univ(loc Un (nat->nat) Un ((nat*nat) -> nat) )",
- [
- (["N","X"], "i => i", NoSyn),
- (["Op1"], "[i,i] => i", NoSyn),
- (["Op2"], "[i,i,i] => i", NoSyn)
- ]
- )];
-
- val rec_styp = "i";
- val ext = None;
-
- val sintrs =
- [
- "n:nat ==> N(n) : aexp",
- "x:loc ==> X(x) : aexp",
- "[| f: nat -> nat; a : aexp |] ==> Op1(f,a) : aexp",
- "[| f: (nat * nat) -> nat; a0 : aexp; a1: aexp |] \
-\ ==> Op2(f,a0,a1) : aexp"
- ];
- val monos = [];
- val type_intrs = datatype_intrs;
- val type_elims = datatype_elims;
- );
--- a/src/ZF/IMP/Aexp.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(* Title: ZF/IMP/Aexp.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-
-Dummy theory merely recording dependence
-*)
-
-Aexp = Univ
--- a/src/ZF/IMP/Assign.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-(* Title: ZF/IMP/Assign.ML
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-open Assign;
-
-val assign_type = prove_goalw Assign.thy [assign_def]
- "[| sigma:loc -> nat; n:nat |] ==> sigma[n/x] : loc -> nat"
- (fn prems => [(fast_tac
- (ZF_cs addIs [apply_type,lam_type,if_type]@prems) 1)]);
--- a/src/ZF/IMP/Assign.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,13 +0,0 @@
-(* Title: ZF/IMP/Assign.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-Assign = Aexp +
-consts
- "assign" :: "[i,i,i] => i" ("_[_'/_]" [900,0,0] 900)
-
-rules
- assign_def "sigma[m/x] == lam y:loc. if(y=x,m,sigma`y)"
-end
--- a/src/ZF/IMP/Bexp.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,38 +0,0 @@
-(* Title: ZF/IMP/Bexp.ML
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-structure Bexp = Datatype_Fun
- (
- val thy = Aexp.thy;
- val thy_name = "Bexp"
- val rec_specs =
- [
- (
- "bexp", "univ(aexp Un ((nat*nat)->bool) )",
- [
- ( ["true","false"], "i", NoSyn),
- ( ["noti"], "i => i", NoSyn),
- ( ["andi"], "[i,i]=>i", Infixl 60),
- ( ["ori"], "[i,i]=>i", Infixl 60),
- ( ["ROp"], "[i,i,i] => i", NoSyn)
- ]
- )
- ];
-
- val rec_styp = "i";
- val sintrs =
- [
- "true : bexp",
- "false : bexp",
- "[| a0 : aexp; a1 : aexp; f: (nat*nat)->bool |] ==> ROp(f,a0,a1) : bexp",
- "b : bexp ==> noti(b) : bexp",
- "[| b0 : bexp; b1 : bexp |] ==> b0 andi b1 : bexp",
- "[| b0 : bexp; b1 : bexp |] ==> b0 ori b1 : bexp"
- ];
- val monos = [];
- val type_intrs = datatype_intrs;
- val type_elims = datatype_elims;
- );
--- a/src/ZF/IMP/Bexp.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(* Title: ZF/IMP/Bexp.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-
-Dummy theory merely recording dependence
-*)
-
-Bexp = Aexp
--- a/src/ZF/IMP/Evala.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-(* Title: ZF/IMP/Evala.ML
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-structure Evala = Inductive_Fun
- (
- val thy = Evala0.thy;
- val thy_name="Evala";
- val rec_doms = [("evala","aexp * (loc -> nat) * nat")];
- val sintrs =
- [
- "[| n:nat ; sigma:loc->nat |] ==> <N(n),sigma> -a-> n",
- "[| x:loc; sigma:loc->nat |] ==> <X(x),sigma> -a-> sigma`x",
- "[| <e,sigma> -a-> n; f: nat -> nat |] \
-\ ==> <Op1(f,e),sigma> -a-> f`n" ,
- "[| <e0,sigma> -a-> n0; <e1,sigma> -a-> n1; \
-\ f: (nat * nat) -> nat |] \
-\ ==> <Op2(f,e0,e1),sigma> -a-> f`<n0,n1>" ];
-
- val monos = [];
- val con_defs = [];
- val type_intrs = Aexp.intrs@[apply_funtype];
- val type_elims = []
- );
--- a/src/ZF/IMP/Evala.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(* Title: ZF/IMP/Evala.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-
-Dummy theory merely recording dependence
-*)
-
-Evala = Evala0
--- a/src/ZF/IMP/Evala0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,14 +0,0 @@
-(* Title: ZF/IMP/Evala0.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-Evala0 = Aexp +
-
-consts evala :: "i"
- "@evala" :: "[i,i,i] => o" ("<_,_>/ -a-> _")
-
-translations
- "<ae,sig> -a-> n" == "<ae,sig,n> : evala"
-end
--- a/src/ZF/IMP/Evalb.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
-(* Title: ZF/IMP/Evalb.ML
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-structure Evalb = Inductive_Fun
- (
- val thy = Evalb0.thy;
- val thy_name = "Evalb"
- val rec_doms = [("evalb","bexp * (loc -> nat) * bool")];
- val sintrs =
- [
- "[| sigma:loc -> nat |] ==> <true,sigma> -b-> 1",
- "[| sigma:loc -> nat |] ==> <false,sigma> -b-> 0",
- "[| <a0,sigma> -a-> n0; <a1,sigma> -a-> n1; f: (nat*nat)->bool |] \
-\ ==> <ROp(f,a0,a1),sigma> -b-> f`<n0,n1> ",
- "[| <b,sigma> -b-> w |] \
-\ ==> <noti(b),sigma> -b-> not(w)",
- "[| <b0,sigma> -b-> w0; <b1,sigma> -b-> w1 |] \
-\ ==> <b0 andi b1,sigma> -b-> (w0 and w1)",
- "[| <b0,sigma> -b-> w0; <b1,sigma> -b-> w1 |] \
-\ ==> <b0 ori b1,sigma> -b-> (w0 or w1)"
- ];
-
- val monos = [];
- val con_defs = [];
- val type_intrs = Bexp.intrs@[apply_funtype,and_type,or_type,
- bool_1I,bool_0I,not_type];
- val type_elims = [make_elim(Evala.dom_subset RS subsetD) ];
- );
--- a/src/ZF/IMP/Evalb.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(* Title: ZF/IMP/Evalb.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-
-Dummy theory merely recording dependence
-*)
-
-Evalb = Evalb0
--- a/src/ZF/IMP/Evalb0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-(* Title: ZF/IMP/Evalb0.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-Evalb0 = Evala + Bexp +
-
-consts
- evalb :: "i"
- "@evalb" :: "[i,i,i] => o" ("<_,_>/ -b-> _")
-
-translations
- "<be,sig> -b-> b" == "<be,sig,b> : evalb"
-end
--- a/src/ZF/IMP/Evalc.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-(* Title: ZF/IMP/Evalc.ML
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-structure Evalc = Inductive_Fun
- (
- val thy = Evalc0.thy;
- val thy_name = "Evalc"
- val rec_doms = [("evalc","com * (loc -> nat) * (loc -> nat)")];
- val sintrs =
- [
- "[| sigma: loc -> nat |] ==> <skip,sigma> -c-> sigma",
- "[| m: nat; x: loc; a:aexp; <a,sigma> -a-> m |] ==> \
-\ <X(x) := a,sigma> -c-> sigma[m/x]" ,
- "[| <c0,sigma> -c-> sigma2; <c1,sigma2> -c-> sigma1 |] ==> \
-\ <c0 ; c1, sigma> -c-> sigma1",
- "[| b:bexp; c1:com; sigma:loc->nat;\
-\ <b,sigma> -b-> 1; <c0,sigma> -c-> sigma1 |] ==> \
-\ <ifc b then c0 else c1, sigma> -c-> sigma1 ",
- "[| b:bexp; c0:com; sigma:loc->nat;\
-\ <b,sigma> -b-> 0; <c1,sigma> -c-> sigma1 |] ==> \
-\ <ifc b then c0 else c1, sigma> -c-> sigma1 ",
- "[| b:bexp; c:com; <b, sigma> -b-> 0 |] ==> \
-\ <while b do c,sigma> -c-> sigma ",
- "[| b:bexp; c:com; <b,sigma> -b-> 1; <c,sigma> -c-> sigma2; \
-\ <while b do c, sigma2> -c-> sigma1 |] ==> \
-\ <while b do c, sigma> -c-> sigma1 "];
-
- val monos = [];
- val con_defs = [assign_def];
- val type_intrs = Bexp.intrs@Com.intrs@[if_type,lam_type,apply_type];
- val type_elims = [make_elim(Evala.dom_subset RS subsetD),
- make_elim(Evalb.dom_subset RS subsetD) ]);
--- a/src/ZF/IMP/Evalc.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(* Title: ZF/IMP/Evalc.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-
-Dummy theory merely recording dependence
-*)
-
-Evalc = Evalc0
--- a/src/ZF/IMP/Evalc0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-(* Title: ZF/IMP/Evalc0.thy
- ID: $Id$
- Author: Heiko Loetzbeyer & Robert Sandner, TUM
- Copyright 1994 TUM
-*)
-
-Evalc0 = Evalb + Com + Assign +
-
-consts
- evalc :: "i"
- "@evalc" :: "[i,i,i] => o" ("<_,_>/ -c-> _")
-
-translations
- "<ce,sig> -c-> s" == "<ce,sig,s> : evalc"
-end
--- a/src/ZF/ListFn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,366 +0,0 @@
-(* Title: ZF/list-fn.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For list-fn.thy. Lists in Zermelo-Fraenkel Set Theory
-*)
-
-open ListFn;
-
-(** hd and tl **)
-
-goalw ListFn.thy [hd_def] "hd(Cons(a,l)) = a";
-by (resolve_tac List.case_eqns 1);
-val hd_Cons = result();
-
-goalw ListFn.thy [tl_def] "tl(Nil) = Nil";
-by (resolve_tac List.case_eqns 1);
-val tl_Nil = result();
-
-goalw ListFn.thy [tl_def] "tl(Cons(a,l)) = l";
-by (resolve_tac List.case_eqns 1);
-val tl_Cons = result();
-
-goal ListFn.thy "!!l. l: list(A) ==> tl(l) : list(A)";
-by (etac List.elim 1);
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps (List.intrs @ [tl_Nil,tl_Cons]))));
-val tl_type = result();
-
-(** drop **)
-
-goalw ListFn.thy [drop_def] "drop(0, l) = l";
-by (rtac rec_0 1);
-val drop_0 = result();
-
-goalw ListFn.thy [drop_def] "!!i. i:nat ==> drop(i, Nil) = Nil";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [tl_Nil])));
-val drop_Nil = result();
-
-goalw ListFn.thy [drop_def]
- "!!i. i:nat ==> drop(succ(i), Cons(a,l)) = drop(i,l)";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [tl_Cons])));
-val drop_succ_Cons = result();
-
-goalw ListFn.thy [drop_def]
- "!!i l. [| i:nat; l: list(A) |] ==> drop(i,l) : list(A)";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [tl_type])));
-val drop_type = result();
-
-(** list_rec -- by Vset recursion **)
-
-goal ListFn.thy "list_rec(Nil,c,h) = c";
-by (rtac (list_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (ZF_ss addsimps List.case_eqns) 1);
-val list_rec_Nil = result();
-
-goal ListFn.thy "list_rec(Cons(a,l), c, h) = h(a, l, list_rec(l,c,h))";
-by (rtac (list_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (rank_ss addsimps (rank_Cons2::List.case_eqns)) 1);
-val list_rec_Cons = result();
-
-(*Type checking -- proved by induction, as usual*)
-val prems = goal ListFn.thy
- "[| l: list(A); \
-\ c: C(Nil); \
-\ !!x y r. [| x:A; y: list(A); r: C(y) |] ==> h(x,y,r): C(Cons(x,y)) \
-\ |] ==> list_rec(l,c,h) : C(l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac
- (ZF_ss addsimps (prems@[list_rec_Nil,list_rec_Cons]))));
-val list_rec_type = result();
-
-(** Versions for use with definitions **)
-
-val [rew] = goal ListFn.thy
- "[| !!l. j(l)==list_rec(l, c, h) |] ==> j(Nil) = c";
-by (rewtac rew);
-by (rtac list_rec_Nil 1);
-val def_list_rec_Nil = result();
-
-val [rew] = goal ListFn.thy
- "[| !!l. j(l)==list_rec(l, c, h) |] ==> j(Cons(a,l)) = h(a,l,j(l))";
-by (rewtac rew);
-by (rtac list_rec_Cons 1);
-val def_list_rec_Cons = result();
-
-fun list_recs def = map standard
- ([def] RL [def_list_rec_Nil, def_list_rec_Cons]);
-
-(** map **)
-
-val [map_Nil,map_Cons] = list_recs map_def;
-
-val prems = goalw ListFn.thy [map_def]
- "[| l: list(A); !!x. x: A ==> h(x): B |] ==> map(h,l) : list(B)";
-by (REPEAT (ares_tac (prems@[list_rec_type, NilI, ConsI]) 1));
-val map_type = result();
-
-val [major] = goal ListFn.thy "l: list(A) ==> map(h,l) : list({h(u). u:A})";
-by (rtac (major RS map_type) 1);
-by (etac RepFunI 1);
-val map_type2 = result();
-
-(** length **)
-
-val [length_Nil,length_Cons] = list_recs length_def;
-
-goalw ListFn.thy [length_def]
- "!!l. l: list(A) ==> length(l) : nat";
-by (REPEAT (ares_tac [list_rec_type, nat_0I, nat_succI] 1));
-val length_type = result();
-
-(** app **)
-
-val [app_Nil,app_Cons] = list_recs app_def;
-
-goalw ListFn.thy [app_def]
- "!!xs ys. [| xs: list(A); ys: list(A) |] ==> xs@ys : list(A)";
-by (REPEAT (ares_tac [list_rec_type, ConsI] 1));
-val app_type = result();
-
-(** rev **)
-
-val [rev_Nil,rev_Cons] = list_recs rev_def;
-
-val prems = goalw ListFn.thy [rev_def]
- "xs: list(A) ==> rev(xs) : list(A)";
-by (REPEAT (ares_tac (prems @ [list_rec_type, NilI, ConsI, app_type]) 1));
-val rev_type = result();
-
-
-(** flat **)
-
-val [flat_Nil,flat_Cons] = list_recs flat_def;
-
-val prems = goalw ListFn.thy [flat_def]
- "ls: list(list(A)) ==> flat(ls) : list(A)";
-by (REPEAT (ares_tac (prems @ [list_rec_type, NilI, ConsI, app_type]) 1));
-val flat_type = result();
-
-
-(** list_add **)
-
-val [list_add_Nil,list_add_Cons] = list_recs list_add_def;
-
-val prems = goalw ListFn.thy [list_add_def]
- "xs: list(nat) ==> list_add(xs) : nat";
-by (REPEAT (ares_tac (prems @ [list_rec_type, nat_0I, add_type]) 1));
-val list_add_type = result();
-
-(** ListFn simplification **)
-
-val list_typechecks =
- [NilI, ConsI, list_rec_type,
- map_type, map_type2, app_type, length_type, rev_type, flat_type,
- list_add_type];
-
-val list_ss = arith_ss
- addsimps List.case_eqns
- addsimps [list_rec_Nil, list_rec_Cons,
- map_Nil, map_Cons,
- app_Nil, app_Cons,
- length_Nil, length_Cons,
- rev_Nil, rev_Cons,
- flat_Nil, flat_Cons,
- list_add_Nil, list_add_Cons]
- setsolver (type_auto_tac list_typechecks);
-(*Could also rewrite using the list_typechecks...*)
-
-(*** theorems about map ***)
-
-val prems = goal ListFn.thy
- "l: list(A) ==> map(%u.u, l) = l";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_ident = result();
-
-val prems = goal ListFn.thy
- "l: list(A) ==> map(h, map(j,l)) = map(%u.h(j(u)), l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_compose = result();
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> map(h, xs@ys) = map(h,xs) @ map(h,ys)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_app_distrib = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> map(h, flat(ls)) = flat(map(map(h),ls))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [map_app_distrib])));
-val map_flat = result();
-
-val prems = goal ListFn.thy
- "l: list(A) ==> \
-\ list_rec(map(h,l), c, d) = \
-\ list_rec(l, c, %x xs r. d(h(x), map(h,xs), r))";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val list_rec_map = result();
-
-(** theorems about list(Collect(A,P)) -- used in ex/term.ML **)
-
-(* c : list(Collect(B,P)) ==> c : list(B) *)
-val list_CollectD = standard (Collect_subset RS list_mono RS subsetD);
-
-val prems = goal ListFn.thy
- "l: list({x:A. h(x)=j(x)}) ==> map(h,l) = map(j,l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_list_Collect = result();
-
-(*** theorems about length ***)
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> length(map(h,xs)) = length(xs)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val length_map = result();
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> length(xs@ys) = length(xs) #+ length(ys)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val length_app = result();
-
-(* [| m: nat; n: nat |] ==> m #+ succ(n) = succ(n) #+ m
- Used for rewriting below*)
-val add_commute_succ = nat_succI RSN (2,add_commute);
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> length(rev(xs)) = length(xs)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [length_app, add_commute_succ])));
-val length_rev = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> length(flat(ls)) = list_add(map(length,ls))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [length_app])));
-val length_flat = result();
-
-(** Length and drop **)
-
-(*Lemma for the inductive step of drop_length*)
-goal ListFn.thy
- "!!xs. xs: list(A) ==> \
-\ ALL x. EX z zs. drop(length(xs), Cons(x,xs)) = Cons(z,zs)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [drop_0,drop_succ_Cons])));
-by (fast_tac ZF_cs 1);
-val drop_length_Cons_lemma = result();
-val drop_length_Cons = standard (drop_length_Cons_lemma RS spec);
-
-goal ListFn.thy
- "!!l. l: list(A) ==> ALL i: length(l). EX z zs. drop(i,l) = Cons(z,zs)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps bquant_simps)));
-by (rtac conjI 1);
-by (etac drop_length_Cons 1);
-by (rtac ballI 1);
-by (rtac natE 1);
-by (etac ([asm_rl, length_type, Ord_nat] MRS Ord_trans) 1);
-by (assume_tac 1);
-by (asm_simp_tac (list_ss addsimps [drop_0]) 1);
-by (fast_tac ZF_cs 1);
-by (asm_simp_tac (list_ss addsimps [drop_succ_Cons]) 1);
-by (dtac bspec 1);
-by (fast_tac ZF_cs 2);
-by (fast_tac (ZF_cs addEs [succ_in_naturalD,length_type]) 1);
-val drop_length_lemma = result();
-val drop_length = standard (drop_length_lemma RS bspec);
-
-
-(*** theorems about app ***)
-
-val [major] = goal ListFn.thy "xs: list(A) ==> xs@Nil=xs";
-by (rtac (major RS List.induct) 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val app_right_Nil = result();
-
-val prems = goal ListFn.thy "xs: list(A) ==> (xs@ys)@zs = xs@(ys@zs)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val app_assoc = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> flat(ls@ms) = flat(ls)@flat(ms)";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [app_assoc])));
-val flat_app_distrib = result();
-
-(*** theorems about rev ***)
-
-val prems = goal ListFn.thy "l: list(A) ==> rev(map(h,l)) = map(h,rev(l))";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [map_app_distrib])));
-val rev_map_distrib = result();
-
-(*Simplifier needs the premises as assumptions because rewriting will not
- instantiate the variable ?A in the rules' typing conditions; note that
- rev_type does not instantiate ?A. Only the premises do.
-*)
-goal ListFn.thy
- "!!xs. [| xs: list(A); ys: list(A) |] ==> rev(xs@ys) = rev(ys)@rev(xs)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [app_right_Nil,app_assoc])));
-val rev_app_distrib = result();
-
-val prems = goal ListFn.thy "l: list(A) ==> rev(rev(l))=l";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [rev_app_distrib])));
-val rev_rev_ident = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> rev(flat(ls)) = flat(map(rev,rev(ls)))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps
- [map_app_distrib, flat_app_distrib, rev_app_distrib, app_right_Nil])));
-val rev_flat = result();
-
-
-(*** theorems about list_add ***)
-
-val prems = goal ListFn.thy
- "[| xs: list(nat); ys: list(nat) |] ==> \
-\ list_add(xs@ys) = list_add(ys) #+ list_add(xs)";
-by (cut_facts_tac prems 1);
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS
- (asm_simp_tac (list_ss addsimps [add_0_right, add_assoc RS sym])));
-by (rtac (add_commute RS subst_context) 1);
-by (REPEAT (ares_tac [refl, list_add_type] 1));
-val list_add_app = result();
-
-val prems = goal ListFn.thy
- "l: list(nat) ==> list_add(rev(l)) = list_add(l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS
- (asm_simp_tac (list_ss addsimps [list_add_app, add_0_right])));
-val list_add_rev = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(nat)) ==> list_add(flat(ls)) = list_add(map(list_add,ls))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [list_add_app])));
-by (REPEAT (ares_tac [refl, list_add_type, map_type, add_commute] 1));
-val list_add_flat = result();
-
-(** New induction rule **)
-
-val major::prems = goal ListFn.thy
- "[| l: list(A); \
-\ P(Nil); \
-\ !!x y. [| x: A; y: list(A); P(y) |] ==> P(y @ [x]) \
-\ |] ==> P(l)";
-by (rtac (major RS rev_rev_ident RS subst) 1);
-by (rtac (major RS rev_type RS List.induct) 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps prems)));
-val list_append_induct = result();
-
--- a/src/ZF/ListFn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,50 +0,0 @@
-(* Title: ZF/list-fn
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Functions for Lists in Zermelo-Fraenkel Set Theory
-
-map is a binding operator -- it applies to meta-level functions, not
-object-level functions. This simplifies the final form of term_rec_conv,
-although complicating its derivation.
-*)
-
-ListFn = List + "constructor" +
-consts
- "@" :: "[i,i]=>i" (infixr 60)
- list_rec :: "[i, i, [i,i,i]=>i] => i"
- map :: "[i=>i, i] => i"
- length,rev :: "i=>i"
- flat :: "i=>i"
- list_add :: "i=>i"
- hd,tl :: "i=>i"
- drop :: "[i,i]=>i"
-
- (* List Enumeration *)
- "[]" :: "i" ("[]")
- "@List" :: "is => i" ("[(_)]")
-
-
-translations
- "[x, xs]" == "Cons(x, [xs])"
- "[x]" == "Cons(x, [])"
- "[]" == "Nil"
-
-
-rules
-
- hd_def "hd(l) == list_case(0, %x xs.x, l)"
- tl_def "tl(l) == list_case(Nil, %x xs.xs, l)"
- drop_def "drop(i,l) == rec(i, l, %j r. tl(r))"
-
- list_rec_def
- "list_rec(l,c,h) == Vrec(l, %l g.list_case(c, %x xs. h(x, xs, g`xs), l))"
-
- map_def "map(f,l) == list_rec(l, Nil, %x xs r. Cons(f(x), r))"
- length_def "length(l) == list_rec(l, 0, %x xs r. succ(r))"
- app_def "xs@ys == list_rec(xs, ys, %x xs r. Cons(x,r))"
- rev_def "rev(l) == list_rec(l, Nil, %x xs r. r @ [x])"
- flat_def "flat(ls) == list_rec(ls, Nil, %l ls r. l @ r)"
- list_add_def "list_add(l) == list_rec(l, 0, %x xs r. x#+r)"
-end
--- a/src/ZF/Ord.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,524 +0,0 @@
-(* Title: ZF/ordinal.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For ordinal.thy. Ordinals in Zermelo-Fraenkel Set Theory
-*)
-
-open Ord;
-
-(*** Rules for Transset ***)
-
-(** Two neat characterisations of Transset **)
-
-goalw Ord.thy [Transset_def] "Transset(A) <-> A<=Pow(A)";
-by (fast_tac ZF_cs 1);
-val Transset_iff_Pow = result();
-
-goalw Ord.thy [Transset_def] "Transset(A) <-> Union(succ(A)) = A";
-by (fast_tac (eq_cs addSEs [equalityE]) 1);
-val Transset_iff_Union_succ = result();
-
-(** Consequences of downwards closure **)
-
-goalw Ord.thy [Transset_def]
- "!!C a b. [| Transset(C); {a,b}: C |] ==> a:C & b: C";
-by (fast_tac ZF_cs 1);
-val Transset_doubleton_D = result();
-
-val [prem1,prem2] = goalw Ord.thy [Pair_def]
- "[| Transset(C); <a,b>: C |] ==> a:C & b: C";
-by (cut_facts_tac [prem2] 1);
-by (fast_tac (ZF_cs addSDs [prem1 RS Transset_doubleton_D]) 1);
-val Transset_Pair_D = result();
-
-val prem1::prems = goal Ord.thy
- "[| Transset(C); A*B <= C; b: B |] ==> A <= C";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addSDs [prem1 RS Transset_Pair_D]) 1);
-val Transset_includes_domain = result();
-
-val prem1::prems = goal Ord.thy
- "[| Transset(C); A*B <= C; a: A |] ==> B <= C";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addSDs [prem1 RS Transset_Pair_D]) 1);
-val Transset_includes_range = result();
-
-val [prem1,prem2] = goalw (merge_theories(Ord.thy,Sum.thy)) [sum_def]
- "[| Transset(C); A+B <= C |] ==> A <= C & B <= C";
-by (rtac (prem2 RS (Un_subset_iff RS iffD1) RS conjE) 1);
-by (REPEAT (etac (prem1 RS Transset_includes_range) 1
- ORELSE resolve_tac [conjI, singletonI] 1));
-val Transset_includes_summands = result();
-
-val [prem] = goalw (merge_theories(Ord.thy,Sum.thy)) [sum_def]
- "Transset(C) ==> (A+B) Int C <= (A Int C) + (B Int C)";
-by (rtac (Int_Un_distrib RS ssubst) 1);
-by (fast_tac (ZF_cs addSDs [prem RS Transset_Pair_D]) 1);
-val Transset_sum_Int_subset = result();
-
-(** Closure properties **)
-
-goalw Ord.thy [Transset_def] "Transset(0)";
-by (fast_tac ZF_cs 1);
-val Transset_0 = result();
-
-goalw Ord.thy [Transset_def]
- "!!i j. [| Transset(i); Transset(j) |] ==> Transset(i Un j)";
-by (fast_tac ZF_cs 1);
-val Transset_Un = result();
-
-goalw Ord.thy [Transset_def]
- "!!i j. [| Transset(i); Transset(j) |] ==> Transset(i Int j)";
-by (fast_tac ZF_cs 1);
-val Transset_Int = result();
-
-goalw Ord.thy [Transset_def] "!!i. Transset(i) ==> Transset(succ(i))";
-by (fast_tac ZF_cs 1);
-val Transset_succ = result();
-
-goalw Ord.thy [Transset_def] "!!i. Transset(i) ==> Transset(Pow(i))";
-by (fast_tac ZF_cs 1);
-val Transset_Pow = result();
-
-goalw Ord.thy [Transset_def] "!!A. Transset(A) ==> Transset(Union(A))";
-by (fast_tac ZF_cs 1);
-val Transset_Union = result();
-
-val [Transprem] = goalw Ord.thy [Transset_def]
- "[| !!i. i:A ==> Transset(i) |] ==> Transset(Union(A))";
-by (fast_tac (ZF_cs addEs [Transprem RS bspec RS subsetD]) 1);
-val Transset_Union_family = result();
-
-val [prem,Transprem] = goalw Ord.thy [Transset_def]
- "[| j:A; !!i. i:A ==> Transset(i) |] ==> Transset(Inter(A))";
-by (cut_facts_tac [prem] 1);
-by (fast_tac (ZF_cs addEs [Transprem RS bspec RS subsetD]) 1);
-val Transset_Inter_family = result();
-
-(*** Natural Deduction rules for Ord ***)
-
-val prems = goalw Ord.thy [Ord_def]
- "[| Transset(i); !!x. x:i ==> Transset(x) |] ==> Ord(i) ";
-by (REPEAT (ares_tac (prems@[ballI,conjI]) 1));
-val OrdI = result();
-
-val [major] = goalw Ord.thy [Ord_def]
- "Ord(i) ==> Transset(i)";
-by (rtac (major RS conjunct1) 1);
-val Ord_is_Transset = result();
-
-val [major,minor] = goalw Ord.thy [Ord_def]
- "[| Ord(i); j:i |] ==> Transset(j) ";
-by (rtac (minor RS (major RS conjunct2 RS bspec)) 1);
-val Ord_contains_Transset = result();
-
-(*** Lemmas for ordinals ***)
-
-goalw Ord.thy [Ord_def,Transset_def] "!!i j. [| Ord(i); j:i |] ==> Ord(j) ";
-by (fast_tac ZF_cs 1);
-val Ord_in_Ord = result();
-
-(* Ord(succ(j)) ==> Ord(j) *)
-val Ord_succD = succI1 RSN (2, Ord_in_Ord);
-
-goal Ord.thy "!!i j. [| Ord(i); Transset(j); j<=i |] ==> Ord(j)";
-by (REPEAT (ares_tac [OrdI] 1
- ORELSE eresolve_tac [Ord_contains_Transset, subsetD] 1));
-val Ord_subset_Ord = result();
-
-goalw Ord.thy [Ord_def,Transset_def] "!!i j. [| j:i; Ord(i) |] ==> j<=i";
-by (fast_tac ZF_cs 1);
-val OrdmemD = result();
-
-goal Ord.thy "!!i j k. [| i:j; j:k; Ord(k) |] ==> i:k";
-by (REPEAT (ares_tac [OrdmemD RS subsetD] 1));
-val Ord_trans = result();
-
-goal Ord.thy "!!i j. [| i:j; Ord(j) |] ==> succ(i) <= j";
-by (REPEAT (ares_tac [OrdmemD RSN (2,succ_subsetI)] 1));
-val Ord_succ_subsetI = result();
-
-
-(*** The construction of ordinals: 0, succ, Union ***)
-
-goal Ord.thy "Ord(0)";
-by (REPEAT (ares_tac [OrdI,Transset_0] 1 ORELSE etac emptyE 1));
-val Ord_0 = result();
-
-goal Ord.thy "!!i. Ord(i) ==> Ord(succ(i))";
-by (REPEAT (ares_tac [OrdI,Transset_succ] 1
- ORELSE eresolve_tac [succE,ssubst,Ord_is_Transset,
- Ord_contains_Transset] 1));
-val Ord_succ = result();
-
-goal Ord.thy "Ord(succ(i)) <-> Ord(i)";
-by (fast_tac (ZF_cs addIs [Ord_succ] addDs [Ord_succD]) 1);
-val Ord_succ_iff = result();
-
-goalw Ord.thy [Ord_def] "!!i j. [| Ord(i); Ord(j) |] ==> Ord(i Un j)";
-by (fast_tac (ZF_cs addSIs [Transset_Un]) 1);
-val Ord_Un = result();
-
-goalw Ord.thy [Ord_def] "!!i j. [| Ord(i); Ord(j) |] ==> Ord(i Int j)";
-by (fast_tac (ZF_cs addSIs [Transset_Int]) 1);
-val Ord_Int = result();
-
-val nonempty::prems = goal Ord.thy
- "[| j:A; !!i. i:A ==> Ord(i) |] ==> Ord(Inter(A))";
-by (rtac (nonempty RS Transset_Inter_family RS OrdI) 1);
-by (rtac Ord_is_Transset 1);
-by (REPEAT (ares_tac ([Ord_contains_Transset,nonempty]@prems) 1
- ORELSE etac InterD 1));
-val Ord_Inter = result();
-
-val jmemA::prems = goal Ord.thy
- "[| j:A; !!x. x:A ==> Ord(B(x)) |] ==> Ord(INT x:A. B(x))";
-by (rtac (jmemA RS RepFunI RS Ord_Inter) 1);
-by (etac RepFunE 1);
-by (etac ssubst 1);
-by (eresolve_tac prems 1);
-val Ord_INT = result();
-
-
-(*** < is 'less than' for ordinals ***)
-
-goalw Ord.thy [lt_def] "!!i j. [| i:j; Ord(j) |] ==> i<j";
-by (REPEAT (ares_tac [conjI] 1));
-val ltI = result();
-
-val major::prems = goalw Ord.thy [lt_def]
- "[| i<j; [| i:j; Ord(i); Ord(j) |] ==> P |] ==> P";
-by (rtac (major RS conjE) 1);
-by (REPEAT (ares_tac (prems@[Ord_in_Ord]) 1));
-val ltE = result();
-
-goal Ord.thy "!!i j. i<j ==> i:j";
-by (etac ltE 1);
-by (assume_tac 1);
-val ltD = result();
-
-goalw Ord.thy [lt_def] "~ i<0";
-by (fast_tac ZF_cs 1);
-val not_lt0 = result();
-
-(* i<0 ==> R *)
-val lt0E = standard (not_lt0 RS notE);
-
-goal Ord.thy "!!i j k. [| i<j; j<k |] ==> i<k";
-by (fast_tac (ZF_cs addSIs [ltI] addSEs [ltE, Ord_trans]) 1);
-val lt_trans = result();
-
-goalw Ord.thy [lt_def] "!!i j. [| i<j; j<i |] ==> P";
-by (REPEAT (eresolve_tac [asm_rl, conjE, mem_anti_sym] 1));
-val lt_anti_sym = result();
-
-val lt_anti_refl = prove_goal Ord.thy "i<i ==> P"
- (fn [major]=> [ (rtac (major RS (major RS lt_anti_sym)) 1) ]);
-
-val lt_not_refl = prove_goal Ord.thy "~ i<i"
- (fn _=> [ (rtac notI 1), (etac lt_anti_refl 1) ]);
-
-(** le is less than or equals; recall i le j abbrevs i<succ(j) !! **)
-
-goalw Ord.thy [lt_def] "i le j <-> i<j | (i=j & Ord(j))";
-by (fast_tac (ZF_cs addSIs [Ord_succ] addSDs [Ord_succD]) 1);
-val le_iff = result();
-
-goal Ord.thy "!!i j. i<j ==> i le j";
-by (asm_simp_tac (ZF_ss addsimps [le_iff]) 1);
-val leI = result();
-
-goal Ord.thy "!!i. [| i=j; Ord(j) |] ==> i le j";
-by (asm_simp_tac (ZF_ss addsimps [le_iff]) 1);
-val le_eqI = result();
-
-val le_refl = refl RS le_eqI;
-
-val [prem] = goal Ord.thy "(~ (i=j & Ord(j)) ==> i<j) ==> i le j";
-by (rtac (disjCI RS (le_iff RS iffD2)) 1);
-by (etac prem 1);
-val leCI = result();
-
-val major::prems = goal Ord.thy
- "[| i le j; i<j ==> P; [| i=j; Ord(j) |] ==> P |] ==> P";
-by (rtac (major RS (le_iff RS iffD1 RS disjE)) 1);
-by (DEPTH_SOLVE (ares_tac prems 1 ORELSE etac conjE 1));
-val leE = result();
-
-goal Ord.thy "!!i j. [| i le j; j le i |] ==> i=j";
-by (asm_full_simp_tac (ZF_ss addsimps [le_iff]) 1);
-by (fast_tac (ZF_cs addEs [lt_anti_sym]) 1);
-val le_asym = result();
-
-goal Ord.thy "i le 0 <-> i=0";
-by (fast_tac (ZF_cs addSIs [Ord_0 RS le_refl] addSEs [leE, lt0E]) 1);
-val le0_iff = result();
-
-val le0D = standard (le0_iff RS iffD1);
-
-val lt_cs =
- ZF_cs addSIs [le_refl, leCI]
- addSDs [le0D]
- addSEs [lt_anti_refl, lt0E, leE];
-
-
-(*** Natural Deduction rules for Memrel ***)
-
-goalw Ord.thy [Memrel_def] "<a,b> : Memrel(A) <-> a:b & a:A & b:A";
-by (fast_tac ZF_cs 1);
-val Memrel_iff = result();
-
-val prems = goal Ord.thy "[| a: b; a: A; b: A |] ==> <a,b> : Memrel(A)";
-by (REPEAT (resolve_tac (prems@[conjI, Memrel_iff RS iffD2]) 1));
-val MemrelI = result();
-
-val [major,minor] = goal Ord.thy
- "[| <a,b> : Memrel(A); \
-\ [| a: A; b: A; a:b |] ==> P \
-\ |] ==> P";
-by (rtac (major RS (Memrel_iff RS iffD1) RS conjE) 1);
-by (etac conjE 1);
-by (rtac minor 1);
-by (REPEAT (assume_tac 1));
-val MemrelE = result();
-
-(*The membership relation (as a set) is well-founded.
- Proof idea: show A<=B by applying the foundation axiom to A-B *)
-goalw Ord.thy [wf_def] "wf(Memrel(A))";
-by (EVERY1 [rtac (foundation RS disjE RS allI),
- etac disjI1,
- etac bexE,
- rtac (impI RS allI RS bexI RS disjI2),
- etac MemrelE,
- etac bspec,
- REPEAT o assume_tac]);
-val wf_Memrel = result();
-
-(*** Transfinite induction ***)
-
-(*Epsilon induction over a transitive set*)
-val major::prems = goalw Ord.thy [Transset_def]
- "[| i: k; Transset(k); \
-\ !!x.[| x: k; ALL y:x. P(y) |] ==> P(x) \
-\ |] ==> P(i)";
-by (rtac (major RS (wf_Memrel RS wf_induct2)) 1);
-by (fast_tac (ZF_cs addEs [MemrelE]) 1);
-by (resolve_tac prems 1);
-by (assume_tac 1);
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addIs [MemrelI]) 1);
-val Transset_induct = result();
-
-(*Induction over an ordinal*)
-val Ord_induct = Ord_is_Transset RSN (2, Transset_induct);
-
-(*Induction over the class of ordinals -- a useful corollary of Ord_induct*)
-val [major,indhyp] = goal Ord.thy
- "[| Ord(i); \
-\ !!x.[| Ord(x); ALL y:x. P(y) |] ==> P(x) \
-\ |] ==> P(i)";
-by (rtac (major RS Ord_succ RS (succI1 RS Ord_induct)) 1);
-by (rtac indhyp 1);
-by (rtac (major RS Ord_succ RS Ord_in_Ord) 1);
-by (REPEAT (assume_tac 1));
-val trans_induct = result();
-
-(*Perform induction on i, then prove the Ord(i) subgoal using prems. *)
-fun trans_ind_tac a prems i =
- EVERY [res_inst_tac [("i",a)] trans_induct i,
- rename_last_tac a ["1"] (i+1),
- ares_tac prems i];
-
-
-(*** Fundamental properties of the epsilon ordering (< on ordinals) ***)
-
-(*Finds contradictions for the following proof*)
-val Ord_trans_tac = EVERY' [etac notE, etac Ord_trans, REPEAT o atac];
-
-(** Proving that < is a linear ordering on the ordinals **)
-
-val prems = goal Ord.thy
- "Ord(i) ==> (ALL j. Ord(j) --> i:j | i=j | j:i)";
-by (trans_ind_tac "i" prems 1);
-by (rtac (impI RS allI) 1);
-by (trans_ind_tac "j" [] 1);
-by (DEPTH_SOLVE (swap_res_tac [disjCI,equalityI,subsetI] 1
- ORELSE ball_tac 1
- ORELSE eresolve_tac [impE,disjE,allE] 1
- ORELSE hyp_subst_tac 1
- ORELSE Ord_trans_tac 1));
-val Ord_linear_lemma = result();
-
-(*The trichotomy law for ordinals!*)
-val ordi::ordj::prems = goalw Ord.thy [lt_def]
- "[| Ord(i); Ord(j); i<j ==> P; i=j ==> P; j<i ==> P |] ==> P";
-by (rtac ([ordi,ordj] MRS (Ord_linear_lemma RS spec RS impE)) 1);
-by (REPEAT (FIRSTGOAL (etac disjE)));
-by (DEPTH_SOLVE (ares_tac ([ordi,ordj,conjI] @ prems) 1));
-val Ord_linear_lt = result();
-
-val prems = goal Ord.thy
- "[| Ord(i); Ord(j); i le j ==> P; j le i ==> P |] ==> P";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_lt 1);
-by (DEPTH_SOLVE (ares_tac ([leI,le_eqI] @ prems) 1));
-val Ord_linear_le = result();
-
-goal Ord.thy "!!i j. j le i ==> ~ i<j";
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 1);
-val le_imp_not_lt = result();
-
-goal Ord.thy "!!i j. [| ~ i<j; Ord(i); Ord(j) |] ==> j le i";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_le 1);
-by (REPEAT (SOMEGOAL assume_tac));
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 1);
-val not_lt_imp_le = result();
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> ~ i<j <-> j le i";
-by (REPEAT (ares_tac [iffI, le_imp_not_lt, not_lt_imp_le] 1));
-val not_lt_iff_le = result();
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> ~ i le j <-> j<i";
-by (asm_simp_tac (ZF_ss addsimps [not_lt_iff_le RS iff_sym]) 1);
-val not_le_iff_lt = result();
-
-goal Ord.thy "!!i. Ord(i) ==> 0 le i";
-by (etac (not_lt_iff_le RS iffD1) 1);
-by (REPEAT (resolve_tac [Ord_0, not_lt0] 1));
-val Ord_0_le = result();
-
-goal Ord.thy "!!i. [| Ord(i); i~=0 |] ==> 0<i";
-by (etac (not_le_iff_lt RS iffD1) 1);
-by (rtac Ord_0 1);
-by (fast_tac lt_cs 1);
-val Ord_0_lt = result();
-
-(*** Results about less-than or equals ***)
-
-(** For ordinals, j<=i (subset) implies j le i (less-than or equals) **)
-
-goal Ord.thy "!!i j. [| j<=i; Ord(i); Ord(j) |] ==> j le i";
-by (rtac (not_lt_iff_le RS iffD1) 1);
-by (assume_tac 1);
-by (assume_tac 1);
-by (fast_tac (ZF_cs addEs [ltE, mem_anti_refl]) 1);
-val subset_imp_le = result();
-
-goal Ord.thy "!!i j. i le j ==> i<=j";
-by (etac leE 1);
-by (fast_tac ZF_cs 2);
-by (fast_tac (subset_cs addIs [OrdmemD] addEs [ltE]) 1);
-val le_imp_subset = result();
-
-goal Ord.thy "j le i <-> j<=i & Ord(i) & Ord(j)";
-by (fast_tac (ZF_cs addSEs [subset_imp_le, le_imp_subset]
- addEs [ltE, make_elim Ord_succD]) 1);
-val le_subset_iff = result();
-
-goal Ord.thy "i le succ(j) <-> i le j | i=succ(j) & Ord(i)";
-by (simp_tac (ZF_ss addsimps [le_iff]) 1);
-by (fast_tac (ZF_cs addIs [Ord_succ] addDs [Ord_succD]) 1);
-val le_succ_iff = result();
-
-goal Ord.thy "!!i j. [| i le j; j<k |] ==> i<k";
-by (fast_tac (ZF_cs addEs [leE, lt_trans]) 1);
-val lt_trans1 = result();
-
-goal Ord.thy "!!i j. [| i<j; j le k |] ==> i<k";
-by (fast_tac (ZF_cs addEs [leE, lt_trans]) 1);
-val lt_trans2 = result();
-
-goal Ord.thy "!!i j. [| i le j; j le k |] ==> i le k";
-by (REPEAT (ares_tac [lt_trans1] 1));
-val le_trans = result();
-
-goal Ord.thy "!!i j. i<j ==> succ(i) le j";
-by (rtac (not_lt_iff_le RS iffD1) 1);
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 3);
-by (ALLGOALS (fast_tac (ZF_cs addEs [ltE] addIs [Ord_succ])));
-val succ_leI = result();
-
-goal Ord.thy "!!i j. succ(i) le j ==> i<j";
-by (rtac (not_le_iff_lt RS iffD1) 1);
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 3);
-by (ALLGOALS (fast_tac (ZF_cs addEs [ltE, make_elim Ord_succD])));
-val succ_leE = result();
-
-goal Ord.thy "succ(i) le j <-> i<j";
-by (REPEAT (ares_tac [iffI,succ_leI,succ_leE] 1));
-val succ_le_iff = result();
-
-(** Union and Intersection **)
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> i le i Un j";
-by (rtac (Un_upper1 RS subset_imp_le) 1);
-by (REPEAT (ares_tac [Ord_Un] 1));
-val Un_upper1_le = result();
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> j le i Un j";
-by (rtac (Un_upper2 RS subset_imp_le) 1);
-by (REPEAT (ares_tac [Ord_Un] 1));
-val Un_upper2_le = result();
-
-(*Replacing k by succ(k') yields the similar rule for le!*)
-goal Ord.thy "!!i j k. [| i<k; j<k |] ==> i Un j < k";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_le 1);
-by (rtac (Un_commute RS ssubst) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Un_iff]) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Un_iff]) 3);
-by (REPEAT (eresolve_tac [asm_rl, ltE] 1));
-val Un_least_lt = result();
-
-(*Replacing k by succ(k') yields the similar rule for le!*)
-goal Ord.thy "!!i j k. [| i<k; j<k |] ==> i Int j < k";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_le 1);
-by (rtac (Int_commute RS ssubst) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Int_iff]) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Int_iff]) 3);
-by (REPEAT (eresolve_tac [asm_rl, ltE] 1));
-val Int_greatest_lt = result();
-
-(*** Results about limits ***)
-
-val prems = goal Ord.thy "[| !!i. i:A ==> Ord(i) |] ==> Ord(Union(A))";
-by (rtac (Ord_is_Transset RS Transset_Union_family RS OrdI) 1);
-by (REPEAT (etac UnionE 1 ORELSE ares_tac ([Ord_contains_Transset]@prems) 1));
-val Ord_Union = result();
-
-val prems = goal Ord.thy "[| !!x. x:A ==> Ord(B(x)) |] ==> Ord(UN x:A. B(x))";
-by (rtac Ord_Union 1);
-by (etac RepFunE 1);
-by (etac ssubst 1);
-by (eresolve_tac prems 1);
-val Ord_UN = result();
-
-(* No < version; consider (UN i:nat.i)=nat *)
-val [ordi,limit] = goal Ord.thy
- "[| Ord(i); !!x. x:A ==> b(x) le i |] ==> (UN x:A. b(x)) le i";
-by (rtac (le_imp_subset RS UN_least RS subset_imp_le) 1);
-by (REPEAT (ares_tac [ordi, Ord_UN, limit] 1 ORELSE etac (limit RS ltE) 1));
-val UN_least_le = result();
-
-val [jlti,limit] = goal Ord.thy
- "[| j<i; !!x. x:A ==> b(x)<j |] ==> (UN x:A. succ(b(x))) < i";
-by (rtac (jlti RS ltE) 1);
-by (rtac (UN_least_le RS lt_trans2) 1);
-by (REPEAT (ares_tac [jlti, succ_leI, limit] 1));
-val UN_succ_least_lt = result();
-
-val prems = goal Ord.thy
- "[| a: A; i le b(a); !!x. x:A ==> Ord(b(x)) |] ==> i le (UN x:A. b(x))";
-by (resolve_tac (prems RL [ltE]) 1);
-by (rtac (le_imp_subset RS subset_trans RS subset_imp_le) 1);
-by (REPEAT (ares_tac (prems @ [UN_upper, Ord_UN]) 1));
-val UN_upper_le = result();
-
-goal Ord.thy "!!i. Ord(i) ==> (UN y:i. succ(y)) = i";
-by (fast_tac (eq_cs addEs [Ord_trans]) 1);
-val Ord_equality = result();
-
-(*Holds for all transitive sets, not just ordinals*)
-goal Ord.thy "!!i. Ord(i) ==> Union(i) <= i";
-by (fast_tac (ZF_cs addSEs [Ord_trans]) 1);
-val Ord_Union_subset = result();
--- a/src/ZF/Ord.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,25 +0,0 @@
-(* Title: ZF/ordinal.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Ordinals in Zermelo-Fraenkel Set Theory
-*)
-
-Ord = WF + "simpdata" + "equalities" +
-consts
- Memrel :: "i=>i"
- Transset,Ord :: "i=>o"
- "<" :: "[i,i] => o" (infixl 50) (*less than on ordinals*)
- "le" :: "[i,i] => o" (infixl 50) (*less than or equals*)
-
-translations
- "x le y" == "x < succ(y)"
-
-rules
- Memrel_def "Memrel(A) == {z: A*A . EX x y. z=<x,y> & x:y }"
- Transset_def "Transset(i) == ALL x:i. x<=i"
- Ord_def "Ord(i) == Transset(i) & (ALL x:i. Transset(x))"
- lt_def "i<j == i:j & Ord(j)"
-
-end
--- a/src/ZF/Pair.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,146 +0,0 @@
-(* Title: ZF/pair
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Ordered pairs in Zermelo-Fraenkel Set Theory
-*)
-
-(** Lemmas for showing that <a,b> uniquely determines a and b **)
-
-val doubleton_iff = prove_goal ZF.thy
- "{a,b} = {c,d} <-> (a=c & b=d) | (a=d & b=c)"
- (fn _=> [ (resolve_tac [extension RS iff_trans] 1),
- (fast_tac upair_cs 1) ]);
-
-val Pair_iff = prove_goalw ZF.thy [Pair_def]
- "<a,b> = <c,d> <-> a=c & b=d"
- (fn _=> [ (simp_tac (FOL_ss addsimps [doubleton_iff]) 1),
- (fast_tac FOL_cs 1) ]);
-
-val Pair_inject = standard (Pair_iff RS iffD1 RS conjE);
-
-val Pair_inject1 = prove_goal ZF.thy "<a,b> = <c,d> ==> a=c"
- (fn [major]=>
- [ (rtac (major RS Pair_inject) 1), (assume_tac 1) ]);
-
-val Pair_inject2 = prove_goal ZF.thy "<a,b> = <c,d> ==> b=d"
- (fn [major]=>
- [ (rtac (major RS Pair_inject) 1), (assume_tac 1) ]);
-
-val Pair_neq_0 = prove_goalw ZF.thy [Pair_def] "<a,b>=0 ==> P"
- (fn [major]=>
- [ (rtac (major RS equalityD1 RS subsetD RS emptyE) 1),
- (rtac consI1 1) ]);
-
-val Pair_neq_fst = prove_goalw ZF.thy [Pair_def] "<a,b>=a ==> P"
- (fn [major]=>
- [ (rtac (consI1 RS mem_anti_sym RS FalseE) 1),
- (rtac (major RS subst) 1),
- (rtac consI1 1) ]);
-
-val Pair_neq_snd = prove_goalw ZF.thy [Pair_def] "<a,b>=b ==> P"
- (fn [major]=>
- [ (rtac (consI1 RS consI2 RS mem_anti_sym RS FalseE) 1),
- (rtac (major RS subst) 1),
- (rtac (consI1 RS consI2) 1) ]);
-
-
-(*** Sigma: Disjoint union of a family of sets
- Generalizes Cartesian product ***)
-
-val SigmaI = prove_goalw ZF.thy [Sigma_def]
- "[| a:A; b:B(a) |] ==> <a,b> : Sigma(A,B)"
- (fn prems=> [ (REPEAT (resolve_tac (prems@[singletonI,UN_I]) 1)) ]);
-
-(*The general elimination rule*)
-val SigmaE = prove_goalw ZF.thy [Sigma_def]
- "[| c: Sigma(A,B); \
-\ !!x y.[| x:A; y:B(x); c=<x,y> |] ==> P \
-\ |] ==> P"
- (fn major::prems=>
- [ (cut_facts_tac [major] 1),
- (REPEAT (eresolve_tac [UN_E, singletonE] 1 ORELSE ares_tac prems 1)) ]);
-
-(** Elimination of <a,b>:A*B -- introduces no eigenvariables **)
-val SigmaD1 = prove_goal ZF.thy "<a,b> : Sigma(A,B) ==> a : A"
- (fn [major]=>
- [ (rtac (major RS SigmaE) 1),
- (REPEAT (eresolve_tac [asm_rl,Pair_inject,ssubst] 1)) ]);
-
-val SigmaD2 = prove_goal ZF.thy "<a,b> : Sigma(A,B) ==> b : B(a)"
- (fn [major]=>
- [ (rtac (major RS SigmaE) 1),
- (REPEAT (eresolve_tac [asm_rl,Pair_inject,ssubst] 1)) ]);
-
-(*Also provable via
- rule_by_tactic (REPEAT_FIRST (etac Pair_inject ORELSE' bound_hyp_subst_tac)
- THEN prune_params_tac)
- (read_instantiate [("c","<a,b>")] SigmaE); *)
-val SigmaE2 = prove_goal ZF.thy
- "[| <a,b> : Sigma(A,B); \
-\ [| a:A; b:B(a) |] ==> P \
-\ |] ==> P"
- (fn [major,minor]=>
- [ (rtac minor 1),
- (rtac (major RS SigmaD1) 1),
- (rtac (major RS SigmaD2) 1) ]);
-
-val Sigma_cong = prove_goalw ZF.thy [Sigma_def]
- "[| A=A'; !!x. x:A' ==> B(x)=B'(x) |] ==> \
-\ Sigma(A,B) = Sigma(A',B')"
- (fn prems=> [ (simp_tac (FOL_ss addsimps prems addcongs [RepFun_cong]) 1) ]);
-
-val Sigma_empty1 = prove_goal ZF.thy "Sigma(0,B) = 0"
- (fn _ => [ (fast_tac (lemmas_cs addIs [equalityI] addSEs [SigmaE]) 1) ]);
-
-val Sigma_empty2 = prove_goal ZF.thy "A*0 = 0"
- (fn _ => [ (fast_tac (lemmas_cs addIs [equalityI] addSEs [SigmaE]) 1) ]);
-
-
-(*** Eliminator - split ***)
-
-val split = prove_goalw ZF.thy [split_def]
- "split(%x y.c(x,y), <a,b>) = c(a,b)"
- (fn _ =>
- [ (fast_tac (upair_cs addIs [the_equality] addEs [Pair_inject]) 1) ]);
-
-val split_type = prove_goal ZF.thy
- "[| p:Sigma(A,B); \
-\ !!x y.[| x:A; y:B(x) |] ==> c(x,y):C(<x,y>) \
-\ |] ==> split(%x y.c(x,y), p) : C(p)"
- (fn major::prems=>
- [ (rtac (major RS SigmaE) 1),
- (etac ssubst 1),
- (REPEAT (ares_tac (prems @ [split RS ssubst]) 1)) ]);
-
-(*** conversions for fst and snd ***)
-
-val fst_conv = prove_goalw ZF.thy [fst_def] "fst(<a,b>) = a"
- (fn _=> [ (rtac split 1) ]);
-
-val snd_conv = prove_goalw ZF.thy [snd_def] "snd(<a,b>) = b"
- (fn _=> [ (rtac split 1) ]);
-
-
-(*** split for predicates: result type o ***)
-
-goalw ZF.thy [fsplit_def] "!!R a b. R(a,b) ==> fsplit(R, <a,b>)";
-by (REPEAT (ares_tac [refl,exI,conjI] 1));
-val fsplitI = result();
-
-val major::prems = goalw ZF.thy [fsplit_def]
- "[| fsplit(R,z); !!x y. [| z = <x,y>; R(x,y) |] ==> P |] ==> P";
-by (cut_facts_tac [major] 1);
-by (REPEAT (eresolve_tac (prems@[asm_rl,exE,conjE]) 1));
-val fsplitE = result();
-
-goal ZF.thy "!!R a b. fsplit(R,<a,b>) ==> R(a,b)";
-by (REPEAT (eresolve_tac [asm_rl,fsplitE,Pair_inject,ssubst] 1));
-val fsplitD = result();
-
-val pair_cs = upair_cs
- addSIs [SigmaI]
- addSEs [SigmaE2, SigmaE, Pair_inject, make_elim succ_inject,
- Pair_neq_0, sym RS Pair_neq_0, succ_neq_0, sym RS succ_neq_0];
-
--- a/src/ZF/Pair.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-pair = "upair"
--- a/src/ZF/Zorn0.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-(* Title: ZF/Zorn0.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1994 University of Cambridge
-
-Preamble to proofs from the paper
- Abrial & Laffitte,
- Towards the Mechanization of the Proofs of Some
- Classical Theorems of Set Theory.
-*)
-
-
-(*** Section 1. Mathematical Preamble ***)
-
-goal ZF.thy "!!A B C. (ALL x:C. x<=A | B<=x) ==> Union(C)<=A | B<=Union(C)";
-by (fast_tac ZF_cs 1);
-val Union_lemma0 = result();
-
-goal ZF.thy
- "!!A B C. [| c:C; ALL x:C. A<=x | x<=B |] ==> A<=Inter(C) | Inter(C)<=B";
-by (fast_tac ZF_cs 1);
-val Inter_lemma0 = result();
-
-open Zorn0;
-
-(*** Section 2. The Transfinite Construction ***)
-
-goalw Zorn0.thy [increasing_def]
- "!!f A. f: increasing(A) ==> f: Pow(A)->Pow(A)";
-by (eresolve_tac [CollectD1] 1);
-val increasingD1 = result();
-
-goalw Zorn0.thy [increasing_def]
- "!!f A. [| f: increasing(A); x<=A |] ==> x <= f`x";
-by (eresolve_tac [CollectD2 RS spec RS mp] 1);
-by (assume_tac 1);
-val increasingD2 = result();
-
-goal Zorn0.thy
- "!!next S. [| X : Pow(S); next: increasing(S) |] ==> next`X : Pow(S)";
-by (eresolve_tac [increasingD1 RS apply_type] 1);
-by (assume_tac 1);
-val next_bounded = result();
-
-(*Trivial to prove here; hard to prove within Inductive_Fun*)
-goal ZF.thy "!!Y. Y : Pow(Pow(A)) ==> Union(Y) : Pow(A)";
-by (fast_tac ZF_cs 1);
-val Union_in_Pow = result();
-
-(** We could make the inductive definition conditional on next: increasing(S)
- but instead we make this a side-condition of an introduction rule. Thus
- the induction rule lets us assume that condition! Many inductive proofs
- are therefore unconditional.
-**)
-
-
--- a/src/ZF/Zorn0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,28 +0,0 @@
-(* Title: ZF/Zorn0.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1994 University of Cambridge
-
-Based upon the article
- Abrial & Laffitte,
- Towards the Mechanization of the Proofs of Some
- Classical Theorems of Set Theory.
-*)
-
-Zorn0 = OrderArith + AC + "inductive" +
-
-consts
- Subset_rel :: "i=>i"
- increasing :: "i=>i"
- chain, maxchain :: "i=>i"
- super :: "[i,i]=>i"
-
-rules
- Subset_rel_def "Subset_rel(A) == {z: A*A . EX x y. z=<x,y> & x<=y & x~=y}"
- increasing_def "increasing(A) == {f: Pow(A)->Pow(A). ALL x. x<=A --> x<=f`x}"
-
- chain_def "chain(A) == {F: Pow(A). ALL X:F. ALL Y:F. X<=Y | Y<=X}"
- super_def "super(A,c) == {d: chain(A). c<=d & c~=d}"
- maxchain_def "maxchain(A) == {c: chain(A). super(A,c)=0}"
-
-end
--- a/src/ZF/arith.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,378 +0,0 @@
-(* Title: ZF/arith.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For arith.thy. Arithmetic operators and their definitions
-
-Proofs about elementary arithmetic: addition, multiplication, etc.
-
-Could prove def_rec_0, def_rec_succ...
-*)
-
-open Arith;
-
-(*"Difference" is subtraction of natural numbers.
- There are no negative numbers; we have
- m #- n = 0 iff m<=n and m #- n = succ(k) iff m>n.
- Also, rec(m, 0, %z w.z) is pred(m).
-*)
-
-(** rec -- better than nat_rec; the succ case has no type requirement! **)
-
-val rec_trans = rec_def RS def_transrec RS trans;
-
-goal Arith.thy "rec(0,a,b) = a";
-by (rtac rec_trans 1);
-by (rtac nat_case_0 1);
-val rec_0 = result();
-
-goal Arith.thy "rec(succ(m),a,b) = b(m, rec(m,a,b))";
-by (rtac rec_trans 1);
-by (simp_tac (ZF_ss addsimps [nat_case_succ, nat_succI]) 1);
-val rec_succ = result();
-
-val major::prems = goal Arith.thy
- "[| n: nat; \
-\ a: C(0); \
-\ !!m z. [| m: nat; z: C(m) |] ==> b(m,z): C(succ(m)) \
-\ |] ==> rec(n,a,b) : C(n)";
-by (rtac (major RS nat_induct) 1);
-by (ALLGOALS
- (asm_simp_tac (ZF_ss addsimps (prems@[rec_0,rec_succ]))));
-val rec_type = result();
-
-val nat_le_refl = naturals_are_ordinals RS le_refl;
-
-val nat_typechecks = [rec_type, nat_0I, nat_1I, nat_succI, Ord_nat];
-
-val nat_simps = [rec_0, rec_succ, not_lt0, nat_0_le, le0_iff, succ_le_iff,
- nat_le_refl];
-
-val nat_ss = ZF_ss addsimps (nat_simps @ nat_typechecks);
-
-
-(** Addition **)
-
-val add_type = prove_goalw Arith.thy [add_def]
- "[| m:nat; n:nat |] ==> m #+ n : nat"
- (fn prems=> [ (typechk_tac (prems@nat_typechecks@ZF_typechecks)) ]);
-
-val add_0 = prove_goalw Arith.thy [add_def]
- "0 #+ n = n"
- (fn _ => [ (rtac rec_0 1) ]);
-
-val add_succ = prove_goalw Arith.thy [add_def]
- "succ(m) #+ n = succ(m #+ n)"
- (fn _=> [ (rtac rec_succ 1) ]);
-
-(** Multiplication **)
-
-val mult_type = prove_goalw Arith.thy [mult_def]
- "[| m:nat; n:nat |] ==> m #* n : nat"
- (fn prems=>
- [ (typechk_tac (prems@[add_type]@nat_typechecks@ZF_typechecks)) ]);
-
-val mult_0 = prove_goalw Arith.thy [mult_def]
- "0 #* n = 0"
- (fn _ => [ (rtac rec_0 1) ]);
-
-val mult_succ = prove_goalw Arith.thy [mult_def]
- "succ(m) #* n = n #+ (m #* n)"
- (fn _ => [ (rtac rec_succ 1) ]);
-
-(** Difference **)
-
-val diff_type = prove_goalw Arith.thy [diff_def]
- "[| m:nat; n:nat |] ==> m #- n : nat"
- (fn prems=> [ (typechk_tac (prems@nat_typechecks@ZF_typechecks)) ]);
-
-val diff_0 = prove_goalw Arith.thy [diff_def]
- "m #- 0 = m"
- (fn _ => [ (rtac rec_0 1) ]);
-
-val diff_0_eq_0 = prove_goalw Arith.thy [diff_def]
- "n:nat ==> 0 #- n = 0"
- (fn [prem]=>
- [ (rtac (prem RS nat_induct) 1),
- (ALLGOALS (asm_simp_tac nat_ss)) ]);
-
-(*Must simplify BEFORE the induction!! (Else we get a critical pair)
- succ(m) #- succ(n) rewrites to pred(succ(m) #- n) *)
-val diff_succ_succ = prove_goalw Arith.thy [diff_def]
- "[| m:nat; n:nat |] ==> succ(m) #- succ(n) = m #- n"
- (fn prems=>
- [ (asm_simp_tac (nat_ss addsimps prems) 1),
- (nat_ind_tac "n" prems 1),
- (ALLGOALS (asm_simp_tac (nat_ss addsimps prems))) ]);
-
-val prems = goal Arith.thy
- "[| m:nat; n:nat |] ==> m #- n le m";
-by (rtac (prems MRS diff_induct) 1);
-by (etac leE 3);
-by (ALLGOALS
- (asm_simp_tac
- (nat_ss addsimps (prems @ [le_iff, diff_0, diff_0_eq_0,
- diff_succ_succ, naturals_are_ordinals]))));
-val diff_le_self = result();
-
-(*** Simplification over add, mult, diff ***)
-
-val arith_typechecks = [add_type, mult_type, diff_type];
-val arith_simps = [add_0, add_succ,
- mult_0, mult_succ,
- diff_0, diff_0_eq_0, diff_succ_succ];
-
-val arith_ss = nat_ss addsimps (arith_simps@arith_typechecks);
-
-(*** Addition ***)
-
-(*Associative law for addition*)
-val add_assoc = prove_goal Arith.thy
- "m:nat ==> (m #+ n) #+ k = m #+ (n #+ k)"
- (fn prems=>
- [ (nat_ind_tac "m" prems 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps prems))) ]);
-
-(*The following two lemmas are used for add_commute and sometimes
- elsewhere, since they are safe for rewriting.*)
-val add_0_right = prove_goal Arith.thy
- "m:nat ==> m #+ 0 = m"
- (fn prems=>
- [ (nat_ind_tac "m" prems 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps prems))) ]);
-
-val add_succ_right = prove_goal Arith.thy
- "m:nat ==> m #+ succ(n) = succ(m #+ n)"
- (fn prems=>
- [ (nat_ind_tac "m" prems 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps prems))) ]);
-
-(*Commutative law for addition*)
-val add_commute = prove_goal Arith.thy
- "[| m:nat; n:nat |] ==> m #+ n = n #+ m"
- (fn prems=>
- [ (nat_ind_tac "n" prems 1),
- (ALLGOALS
- (asm_simp_tac
- (arith_ss addsimps (prems@[add_0_right, add_succ_right])))) ]);
-
-(*Cancellation law on the left*)
-val [knat,eqn] = goal Arith.thy
- "[| k:nat; k #+ m = k #+ n |] ==> m=n";
-by (rtac (eqn RS rev_mp) 1);
-by (nat_ind_tac "k" [knat] 1);
-by (ALLGOALS (simp_tac arith_ss));
-by (fast_tac ZF_cs 1);
-val add_left_cancel = result();
-
-(*** Multiplication ***)
-
-(*right annihilation in product*)
-val mult_0_right = prove_goal Arith.thy
- "m:nat ==> m #* 0 = 0"
- (fn prems=>
- [ (nat_ind_tac "m" prems 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps prems))) ]);
-
-(*right successor law for multiplication*)
-val mult_succ_right = prove_goal Arith.thy
- "!!m n. [| m:nat; n:nat |] ==> m #* succ(n) = m #+ (m #* n)"
- (fn _=>
- [ (nat_ind_tac "m" [] 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps [add_assoc RS sym]))),
- (*The final goal requires the commutative law for addition*)
- (rtac (add_commute RS subst_context) 1),
- (REPEAT (assume_tac 1)) ]);
-
-(*Commutative law for multiplication*)
-val mult_commute = prove_goal Arith.thy
- "[| m:nat; n:nat |] ==> m #* n = n #* m"
- (fn prems=>
- [ (nat_ind_tac "m" prems 1),
- (ALLGOALS (asm_simp_tac
- (arith_ss addsimps (prems@[mult_0_right, mult_succ_right])))) ]);
-
-(*addition distributes over multiplication*)
-val add_mult_distrib = prove_goal Arith.thy
- "!!m n. [| m:nat; k:nat |] ==> (m #+ n) #* k = (m #* k) #+ (n #* k)"
- (fn _=>
- [ (etac nat_induct 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps [add_assoc RS sym]))) ]);
-
-(*Distributive law on the left; requires an extra typing premise*)
-val add_mult_distrib_left = prove_goal Arith.thy
- "[| m:nat; n:nat; k:nat |] ==> k #* (m #+ n) = (k #* m) #+ (k #* n)"
- (fn prems=>
- let val mult_commute' = read_instantiate [("m","k")] mult_commute
- val ss = arith_ss addsimps ([mult_commute',add_mult_distrib]@prems)
- in [ (simp_tac ss 1) ]
- end);
-
-(*Associative law for multiplication*)
-val mult_assoc = prove_goal Arith.thy
- "!!m n k. [| m:nat; n:nat; k:nat |] ==> (m #* n) #* k = m #* (n #* k)"
- (fn _=>
- [ (etac nat_induct 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps [add_mult_distrib]))) ]);
-
-
-(*** Difference ***)
-
-val diff_self_eq_0 = prove_goal Arith.thy
- "m:nat ==> m #- m = 0"
- (fn prems=>
- [ (nat_ind_tac "m" prems 1),
- (ALLGOALS (asm_simp_tac (arith_ss addsimps prems))) ]);
-
-(*Addition is the inverse of subtraction*)
-goal Arith.thy "!!m n. [| n le m; m:nat |] ==> n #+ (m#-n) = m";
-by (forward_tac [lt_nat_in_nat] 1);
-by (etac nat_succI 1);
-by (etac rev_mp 1);
-by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
-by (ALLGOALS (asm_simp_tac arith_ss));
-val add_diff_inverse = result();
-
-(*Subtraction is the inverse of addition. *)
-val [mnat,nnat] = goal Arith.thy
- "[| m:nat; n:nat |] ==> (n#+m) #-n = m";
-by (rtac (nnat RS nat_induct) 1);
-by (ALLGOALS (asm_simp_tac (arith_ss addsimps [mnat])));
-val diff_add_inverse = result();
-
-val [mnat,nnat] = goal Arith.thy
- "[| m:nat; n:nat |] ==> n #- (n#+m) = 0";
-by (rtac (nnat RS nat_induct) 1);
-by (ALLGOALS (asm_simp_tac (arith_ss addsimps [mnat])));
-val diff_add_0 = result();
-
-
-(*** Remainder ***)
-
-goal Arith.thy "!!m n. [| 0<n; n le m; m:nat |] ==> m #- n < m";
-by (forward_tac [lt_nat_in_nat] 1 THEN etac nat_succI 1);
-by (etac rev_mp 1);
-by (etac rev_mp 1);
-by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [diff_le_self,diff_succ_succ])));
-val div_termination = result();
-
-val div_rls = (*for mod and div*)
- nat_typechecks @
- [Ord_transrec_type, apply_type, div_termination RS ltD, if_type,
- naturals_are_ordinals, not_lt_iff_le RS iffD1];
-
-val div_ss = ZF_ss addsimps [naturals_are_ordinals, div_termination RS ltD,
- not_lt_iff_le RS iffD2];
-
-(*Type checking depends upon termination!*)
-goalw Arith.thy [mod_def] "!!m n. [| 0<n; m:nat; n:nat |] ==> m mod n : nat";
-by (REPEAT (ares_tac div_rls 1 ORELSE etac lt_trans 1));
-val mod_type = result();
-
-goal Arith.thy "!!m n. [| 0<n; m<n |] ==> m mod n = m";
-by (rtac (mod_def RS def_transrec RS trans) 1);
-by (asm_simp_tac div_ss 1);
-val mod_less = result();
-
-goal Arith.thy "!!m n. [| 0<n; n le m; m:nat |] ==> m mod n = (m#-n) mod n";
-by (forward_tac [lt_nat_in_nat] 1 THEN etac nat_succI 1);
-by (rtac (mod_def RS def_transrec RS trans) 1);
-by (asm_simp_tac div_ss 1);
-val mod_geq = result();
-
-(*** Quotient ***)
-
-(*Type checking depends upon termination!*)
-goalw Arith.thy [div_def]
- "!!m n. [| 0<n; m:nat; n:nat |] ==> m div n : nat";
-by (REPEAT (ares_tac div_rls 1 ORELSE etac lt_trans 1));
-val div_type = result();
-
-goal Arith.thy "!!m n. [| 0<n; m<n |] ==> m div n = 0";
-by (rtac (div_def RS def_transrec RS trans) 1);
-by (asm_simp_tac div_ss 1);
-val div_less = result();
-
-goal Arith.thy
- "!!m n. [| 0<n; n le m; m:nat |] ==> m div n = succ((m#-n) div n)";
-by (forward_tac [lt_nat_in_nat] 1 THEN etac nat_succI 1);
-by (rtac (div_def RS def_transrec RS trans) 1);
-by (asm_simp_tac div_ss 1);
-val div_geq = result();
-
-(*Main Result.*)
-goal Arith.thy
- "!!m n. [| 0<n; m:nat; n:nat |] ==> (m div n)#*n #+ m mod n = m";
-by (etac complete_induct 1);
-by (res_inst_tac [("Q","x<n")] (excluded_middle RS disjE) 1);
-(*case x<n*)
-by (asm_simp_tac (arith_ss addsimps [mod_less, div_less]) 2);
-(*case n le x*)
-by (asm_full_simp_tac
- (arith_ss addsimps [not_lt_iff_le, naturals_are_ordinals,
- mod_geq, div_geq, add_assoc,
- div_termination RS ltD, add_diff_inverse]) 1);
-val mod_div_equality = result();
-
-
-(**** Additional theorems about "le" ****)
-
-goal Arith.thy "!!m n. [| m:nat; n:nat |] ==> m le m #+ n";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac arith_ss));
-val add_le_self = result();
-
-goal Arith.thy "!!m n. [| m:nat; n:nat |] ==> m le n #+ m";
-by (rtac (add_commute RS ssubst) 1);
-by (REPEAT (ares_tac [add_le_self] 1));
-val add_le_self2 = result();
-
-(** Monotonicity of addition **)
-
-(*strict, in 1st argument*)
-goal Arith.thy "!!i j k. [| i<j; j:nat; k:nat |] ==> i#+k < j#+k";
-by (forward_tac [lt_nat_in_nat] 1);
-by (assume_tac 1);
-by (etac succ_lt_induct 1);
-by (ALLGOALS (asm_simp_tac (arith_ss addsimps [leI])));
-val add_lt_mono1 = result();
-
-(*strict, in both arguments*)
-goal Arith.thy "!!i j k l. [| i<j; k<l; j:nat; l:nat |] ==> i#+k < j#+l";
-by (rtac (add_lt_mono1 RS lt_trans) 1);
-by (REPEAT (eresolve_tac [asm_rl, lt_nat_in_nat] 1));
-by (EVERY [rtac (add_commute RS ssubst) 1,
- rtac (add_commute RS ssubst) 3,
- rtac add_lt_mono1 5]);
-by (REPEAT (eresolve_tac [asm_rl, lt_nat_in_nat] 1));
-val add_lt_mono = result();
-
-(*A [clumsy] way of lifting < monotonicity to le monotonicity *)
-val lt_mono::ford::prems = goal Ord.thy
- "[| !!i j. [| i<j; j:k |] ==> f(i) < f(j); \
-\ !!i. i:k ==> Ord(f(i)); \
-\ i le j; j:k \
-\ |] ==> f(i) le f(j)";
-by (cut_facts_tac prems 1);
-by (fast_tac (lt_cs addSIs [lt_mono,ford] addSEs [leE]) 1);
-val Ord_lt_mono_imp_le_mono = result();
-
-(*le monotonicity, 1st argument*)
-goal Arith.thy
- "!!i j k. [| i le j; j:nat; k:nat |] ==> i#+k le j#+k";
-by (res_inst_tac [("f", "%j.j#+k")] Ord_lt_mono_imp_le_mono 1);
-by (REPEAT (ares_tac [add_lt_mono1, add_type RS naturals_are_ordinals] 1));
-val add_le_mono1 = result();
-
-(* le monotonicity, BOTH arguments*)
-goal Arith.thy
- "!!i j k. [| i le j; k le l; j:nat; l:nat |] ==> i#+k le j#+l";
-by (rtac (add_le_mono1 RS le_trans) 1);
-by (REPEAT (eresolve_tac [asm_rl, lt_nat_in_nat, nat_succI] 1));
-by (EVERY [rtac (add_commute RS ssubst) 1,
- rtac (add_commute RS ssubst) 3,
- rtac add_le_mono1 5]);
-by (REPEAT (eresolve_tac [asm_rl, lt_nat_in_nat, nat_succI] 1));
-val add_le_mono = result();
--- a/src/ZF/arith.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-(* Title: ZF/arith.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Arithmetic operators and their definitions
-*)
-
-Arith = Epsilon + "simpdata" +
-consts
- rec :: "[i, i, [i,i]=>i]=>i"
- "#*" :: "[i,i]=>i" (infixl 70)
- div :: "[i,i]=>i" (infixl 70)
- mod :: "[i,i]=>i" (infixl 70)
- "#+" :: "[i,i]=>i" (infixl 65)
- "#-" :: "[i,i]=>i" (infixl 65)
-
-rules
- rec_def "rec(k,a,b) == transrec(k, %n f. nat_case(a, %m. b(m, f`m), n))"
-
- add_def "m#+n == rec(m, n, %u v.succ(v))"
- diff_def "m#-n == rec(n, m, %u v. rec(v, 0, %x y.x))"
- mult_def "m#*n == rec(m, 0, %u v. n #+ v)"
- mod_def "m mod n == transrec(m, %j f. if(j<n, j, f`(j#-n)))"
- div_def "m div n == transrec(m, %j f. if(j<n, 0, succ(f`(j#-n))))"
-end
--- a/src/ZF/bool.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,159 +0,0 @@
-(* Title: ZF/bool
- ID: $Id$
- Author: Martin D Coen, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For ZF/bool.thy. Booleans in Zermelo-Fraenkel Set Theory
-*)
-
-open Bool;
-
-val bool_defs = [bool_def,cond_def];
-
-(* Introduction rules *)
-
-goalw Bool.thy bool_defs "1 : bool";
-by (rtac (consI1 RS consI2) 1);
-val bool_1I = result();
-
-goalw Bool.thy bool_defs "0 : bool";
-by (rtac consI1 1);
-val bool_0I = result();
-
-goalw Bool.thy bool_defs "1~=0";
-by (rtac succ_not_0 1);
-val one_not_0 = result();
-
-(** 1=0 ==> R **)
-val one_neq_0 = one_not_0 RS notE;
-
-val major::prems = goalw Bool.thy bool_defs
- "[| c: bool; c=1 ==> P; c=0 ==> P |] ==> P";
-by (rtac (major RS consE) 1);
-by (REPEAT (eresolve_tac (singletonE::prems) 1));
-val boolE = result();
-
-(** cond **)
-
-(*1 means true*)
-goalw Bool.thy bool_defs "cond(1,c,d) = c";
-by (rtac (refl RS if_P) 1);
-val cond_1 = result();
-
-(*0 means false*)
-goalw Bool.thy bool_defs "cond(0,c,d) = d";
-by (rtac (succ_not_0 RS not_sym RS if_not_P) 1);
-val cond_0 = result();
-
-val major::prems = goal Bool.thy
- "[| b: bool; c: A(1); d: A(0) |] ==> cond(b,c,d): A(b)";
-by (rtac (major RS boolE) 1);
-by (asm_simp_tac (ZF_ss addsimps (cond_1::prems)) 1);
-by (asm_simp_tac (ZF_ss addsimps (cond_0::prems)) 1);
-val cond_type = result();
-
-val [rew] = goal Bool.thy "[| !!b. j(b)==cond(b,c,d) |] ==> j(1) = c";
-by (rewtac rew);
-by (rtac cond_1 1);
-val def_cond_1 = result();
-
-val [rew] = goal Bool.thy "[| !!b. j(b)==cond(b,c,d) |] ==> j(0) = d";
-by (rewtac rew);
-by (rtac cond_0 1);
-val def_cond_0 = result();
-
-fun conds def = [standard (def RS def_cond_1), standard (def RS def_cond_0)];
-
-val [not_1,not_0] = conds not_def;
-
-val [and_1,and_0] = conds and_def;
-
-val [or_1,or_0] = conds or_def;
-
-val [xor_1,xor_0] = conds xor_def;
-
-val not_type = prove_goalw Bool.thy [not_def]
- "a:bool ==> not(a) : bool"
- (fn prems=> [ (typechk_tac (prems@[bool_1I, bool_0I, cond_type])) ]);
-
-val and_type = prove_goalw Bool.thy [and_def]
- "[| a:bool; b:bool |] ==> a and b : bool"
- (fn prems=> [ (typechk_tac (prems@[bool_1I, bool_0I, cond_type])) ]);
-
-val or_type = prove_goalw Bool.thy [or_def]
- "[| a:bool; b:bool |] ==> a or b : bool"
- (fn prems=> [ (typechk_tac (prems@[bool_1I, bool_0I, cond_type])) ]);
-
-val xor_type = prove_goalw Bool.thy [xor_def]
- "[| a:bool; b:bool |] ==> a xor b : bool"
- (fn prems=> [ (typechk_tac(prems@[bool_1I, bool_0I, cond_type, not_type])) ]);
-
-val bool_typechecks = [bool_1I, bool_0I, cond_type, not_type, and_type,
- or_type, xor_type]
-
-val bool_simps = [cond_1,cond_0,not_1,not_0,and_1,and_0,or_1,or_0,xor_1,xor_0];
-
-val bool_ss0 = ZF_ss addsimps bool_simps;
-
-fun bool0_tac i =
- EVERY [etac boolE i, asm_simp_tac bool_ss0 (i+1), asm_simp_tac bool_ss0 i];
-
-(*** Laws for 'not' ***)
-
-goal Bool.thy "!!a. a:bool ==> not(not(a)) = a";
-by (bool0_tac 1);
-val not_not = result();
-
-goal Bool.thy "!!a b. a:bool ==> not(a and b) = not(a) or not(b)";
-by (bool0_tac 1);
-val not_and = result();
-
-goal Bool.thy "!!a b. a:bool ==> not(a or b) = not(a) and not(b)";
-by (bool0_tac 1);
-val not_or = result();
-
-(*** Laws about 'and' ***)
-
-goal Bool.thy "!!a. a: bool ==> a and a = a";
-by (bool0_tac 1);
-val and_absorb = result();
-
-goal Bool.thy "!!a b. [| a: bool; b:bool |] ==> a and b = b and a";
-by (etac boolE 1);
-by (bool0_tac 1);
-by (bool0_tac 1);
-val and_commute = result();
-
-goal Bool.thy
- "!!a. a: bool ==> (a and b) and c = a and (b and c)";
-by (bool0_tac 1);
-val and_assoc = result();
-
-goal Bool.thy
- "!!a. [| a: bool; b:bool; c:bool |] ==> \
-\ (a or b) and c = (a and c) or (b and c)";
-by (REPEAT (bool0_tac 1));
-val and_or_distrib = result();
-
-(** binary orion **)
-
-goal Bool.thy "!!a. a: bool ==> a or a = a";
-by (bool0_tac 1);
-val or_absorb = result();
-
-goal Bool.thy "!!a b. [| a: bool; b:bool |] ==> a or b = b or a";
-by (etac boolE 1);
-by (bool0_tac 1);
-by (bool0_tac 1);
-val or_commute = result();
-
-goal Bool.thy "!!a. a: bool ==> (a or b) or c = a or (b or c)";
-by (bool0_tac 1);
-val or_assoc = result();
-
-goal Bool.thy
- "!!a b c. [| a: bool; b: bool; c: bool |] ==> \
-\ (a and b) or c = (a or c) and (b or c)";
-by (REPEAT (bool0_tac 1));
-val or_and_distrib = result();
-
--- a/src/ZF/bool.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,29 +0,0 @@
-(* Title: ZF/bool.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Booleans in Zermelo-Fraenkel Set Theory
-*)
-
-Bool = ZF + "simpdata" +
-consts
- "1" :: "i" ("1")
- bool :: "i"
- cond :: "[i,i,i]=>i"
- not :: "i=>i"
- and :: "[i,i]=>i" (infixl 70)
- or :: "[i,i]=>i" (infixl 65)
- xor :: "[i,i]=>i" (infixl 65)
-
-translations
- "1" == "succ(0)"
-
-rules
- bool_def "bool == {0,1}"
- cond_def "cond(b,c,d) == if(b=1,c,d)"
- not_def "not(b) == cond(b,0,1)"
- and_def "a and b == cond(a,b,0)"
- or_def "a or b == cond(a,1,b)"
- xor_def "a xor b == cond(a,not(b),b)"
-end
--- a/src/ZF/co-inductive.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-(* Title: ZF/co-inductive.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Co-inductive Definitions for Zermelo-Fraenkel Set Theory
-
-Uses greatest fixedpoints with Quine-inspired products and sums
-
-Sums are used only for mutual recursion;
-Products are used only to derive "streamlined" induction rules for relations
-*)
-
-structure Gfp =
- struct
- val oper = Const("gfp", [iT,iT-->iT]--->iT)
- val bnd_mono = Const("bnd_mono", [iT,iT-->iT]--->oT)
- val bnd_monoI = bnd_monoI
- val subs = def_gfp_subset
- val Tarski = def_gfp_Tarski
- val induct = def_Collect_coinduct
- end;
-
-structure Quine_Prod =
- struct
- val sigma = Const("QSigma", [iT, iT-->iT]--->iT)
- val pair = Const("QPair", [iT,iT]--->iT)
- val split_const = Const("qsplit", [[iT,iT]--->iT, iT]--->iT)
- val fsplit_const = Const("qfsplit", [[iT,iT]--->oT, iT]--->oT)
- val pair_iff = QPair_iff
- val split_eq = qsplit
- val fsplitI = qfsplitI
- val fsplitD = qfsplitD
- val fsplitE = qfsplitE
- end;
-
-structure Quine_Sum =
- struct
- val sum = Const("op <+>", [iT,iT]--->iT)
- val inl = Const("QInl", iT-->iT)
- val inr = Const("QInr", iT-->iT)
- val elim = Const("qcase", [iT-->iT, iT-->iT, iT]--->iT)
- val case_inl = qcase_QInl
- val case_inr = qcase_QInr
- val inl_iff = QInl_iff
- val inr_iff = QInr_iff
- val distinct = QInl_QInr_iff
- val distinct' = QInr_QInl_iff
- end;
-
-signature CO_INDRULE =
- sig
- val co_induct : thm
- end;
-
-
-functor Co_Inductive_Fun (Ind: INDUCTIVE)
- : sig include INTR_ELIM CO_INDRULE end =
-struct
-structure Intr_elim =
- Intr_elim_Fun(structure Ind=Ind and Fp=Gfp and
- Pr=Quine_Prod and Su=Quine_Sum);
-
-open Intr_elim
-val co_induct = raw_induct
-end;
-
--- a/src/ZF/coinductive.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-(* Title: ZF/coinductive.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Coinductive Definitions for Zermelo-Fraenkel Set Theory
-
-Uses greatest fixedpoints with Quine-inspired products and sums
-
-Sums are used only for mutual recursion;
-Products are used only to derive "streamlined" induction rules for relations
-*)
-
-structure Gfp =
- struct
- val oper = Const("gfp", [iT,iT-->iT]--->iT)
- val bnd_mono = Const("bnd_mono", [iT,iT-->iT]--->oT)
- val bnd_monoI = bnd_monoI
- val subs = def_gfp_subset
- val Tarski = def_gfp_Tarski
- val induct = def_Collect_coinduct
- end;
-
-structure Quine_Prod =
- struct
- val sigma = Const("QSigma", [iT, iT-->iT]--->iT)
- val pair = Const("QPair", [iT,iT]--->iT)
- val split_const = Const("qsplit", [[iT,iT]--->iT, iT]--->iT)
- val fsplit_const = Const("qfsplit", [[iT,iT]--->oT, iT]--->oT)
- val pair_iff = QPair_iff
- val split_eq = qsplit
- val fsplitI = qfsplitI
- val fsplitD = qfsplitD
- val fsplitE = qfsplitE
- end;
-
-structure Quine_Sum =
- struct
- val sum = Const("op <+>", [iT,iT]--->iT)
- val inl = Const("QInl", iT-->iT)
- val inr = Const("QInr", iT-->iT)
- val elim = Const("qcase", [iT-->iT, iT-->iT, iT]--->iT)
- val case_inl = qcase_QInl
- val case_inr = qcase_QInr
- val inl_iff = QInl_iff
- val inr_iff = QInr_iff
- val distinct = QInl_QInr_iff
- val distinct' = QInr_QInl_iff
- end;
-
-signature COINDRULE =
- sig
- val coinduct : thm
- end;
-
-
-functor CoInductive_Fun (Ind: INDUCTIVE)
- : sig include INTR_ELIM COINDRULE end =
-struct
-structure Intr_elim =
- Intr_elim_Fun(structure Ind=Ind and Fp=Gfp and
- Pr=Quine_Prod and Su=Quine_Sum);
-
-open Intr_elim
-val coinduct = raw_induct
-end;
-
--- a/src/ZF/coinductive.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-coinductive = "ind_syntax" + "intr_elim"
\ No newline at end of file
--- a/src/ZF/datatype.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,69 +0,0 @@
-(* Title: ZF/datatype.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-(Co)Datatype Definitions for Zermelo-Fraenkel Set Theory
-*)
-
-
-(*Datatype definitions use least fixedpoints, standard products and sums*)
-functor Datatype_Fun (Const: CONSTRUCTOR)
- : sig include CONSTRUCTOR_RESULT INTR_ELIM INDRULE end =
-struct
-structure Constructor = Constructor_Fun (structure Const=Const and
- Pr=Standard_Prod and Su=Standard_Sum);
-open Const Constructor;
-
-structure Inductive = Inductive_Fun
- (val thy = con_thy;
- val rec_doms = (map #1 rec_specs) ~~ (map #2 rec_specs);
- val sintrs = sintrs;
- val monos = monos;
- val con_defs = con_defs;
- val type_intrs = type_intrs;
- val type_elims = type_elims);
-
-open Inductive
-end;
-
-
-(*Codatatype definitions use greatest fixedpoints, Quine products and sums*)
-functor CoDatatype_Fun (Const: CONSTRUCTOR)
- : sig include CONSTRUCTOR_RESULT INTR_ELIM COINDRULE end =
-struct
-structure Constructor = Constructor_Fun (structure Const=Const and
- Pr=Quine_Prod and Su=Quine_Sum);
-open Const Constructor;
-
-structure CoInductive = CoInductive_Fun
- (val thy = con_thy;
- val rec_doms = (map #1 rec_specs) ~~ (map #2 rec_specs);
- val sintrs = sintrs;
- val monos = monos;
- val con_defs = con_defs;
- val type_intrs = type_intrs;
- val type_elims = type_elims);
-
-open CoInductive
-end;
-
-
-
-(*For most datatypes involving univ*)
-val datatype_intrs =
- [SigmaI, InlI, InrI,
- Pair_in_univ, Inl_in_univ, Inr_in_univ,
- zero_in_univ, A_into_univ, nat_into_univ, UnCI];
-
-(*Needed for mutual recursion*)
-val datatype_elims = [make_elim InlD, make_elim InrD];
-
-(*For most codatatypes involving quniv*)
-val codatatype_intrs =
- [QSigmaI, QInlI, QInrI,
- QPair_in_quniv, QInl_in_quniv, QInr_in_quniv,
- zero_in_quniv, A_into_quniv, nat_into_quniv, UnCI];
-
-val codatatype_elims = [make_elim QInlD, make_elim QInrD];
-
--- a/src/ZF/datatype.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,4 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-Datatype = "constructor" + "inductive" + "coinductive" + Univ + QUniv
- (*this must be capital to avoid conflicts with ML's "datatype" *)
\ No newline at end of file
--- a/src/ZF/epsilon.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,299 +0,0 @@
-(* Title: ZF/epsilon.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For epsilon.thy. Epsilon induction and recursion
-*)
-
-open Epsilon;
-
-(*** Basic closure properties ***)
-
-goalw Epsilon.thy [eclose_def] "A <= eclose(A)";
-by (rtac (nat_rec_0 RS equalityD2 RS subset_trans) 1);
-by (rtac (nat_0I RS UN_upper) 1);
-val arg_subset_eclose = result();
-
-val arg_into_eclose = arg_subset_eclose RS subsetD;
-
-goalw Epsilon.thy [eclose_def,Transset_def] "Transset(eclose(A))";
-by (rtac (subsetI RS ballI) 1);
-by (etac UN_E 1);
-by (rtac (nat_succI RS UN_I) 1);
-by (assume_tac 1);
-by (etac (nat_rec_succ RS ssubst) 1);
-by (etac UnionI 1);
-by (assume_tac 1);
-val Transset_eclose = result();
-
-(* x : eclose(A) ==> x <= eclose(A) *)
-val eclose_subset =
- standard (rewrite_rule [Transset_def] Transset_eclose RS bspec);
-
-(* [| A : eclose(B); c : A |] ==> c : eclose(B) *)
-val ecloseD = standard (eclose_subset RS subsetD);
-
-val arg_in_eclose_sing = arg_subset_eclose RS singleton_subsetD;
-val arg_into_eclose_sing = arg_in_eclose_sing RS ecloseD;
-
-(* This is epsilon-induction for eclose(A); see also eclose_induct_down...
- [| a: eclose(A); !!x. [| x: eclose(A); ALL y:x. P(y) |] ==> P(x)
- |] ==> P(a)
-*)
-val eclose_induct = standard (Transset_eclose RSN (2, Transset_induct));
-
-(*Epsilon induction*)
-val prems = goal Epsilon.thy
- "[| !!x. ALL y:x. P(y) ==> P(x) |] ==> P(a)";
-by (rtac (arg_in_eclose_sing RS eclose_induct) 1);
-by (eresolve_tac prems 1);
-val eps_induct = result();
-
-(*Perform epsilon-induction on i. *)
-fun eps_ind_tac a =
- EVERY' [res_inst_tac [("a",a)] eps_induct,
- rename_last_tac a ["1"]];
-
-
-(*** Leastness of eclose ***)
-
-(** eclose(A) is the least transitive set including A as a subset. **)
-
-goalw Epsilon.thy [Transset_def]
- "!!X A n. [| Transset(X); A<=X; n: nat |] ==> \
-\ nat_rec(n, A, %m r. Union(r)) <= X";
-by (etac nat_induct 1);
-by (asm_simp_tac (ZF_ss addsimps [nat_rec_0]) 1);
-by (asm_simp_tac (ZF_ss addsimps [nat_rec_succ]) 1);
-by (fast_tac ZF_cs 1);
-val eclose_least_lemma = result();
-
-goalw Epsilon.thy [eclose_def]
- "!!X A. [| Transset(X); A<=X |] ==> eclose(A) <= X";
-by (rtac (eclose_least_lemma RS UN_least) 1);
-by (REPEAT (assume_tac 1));
-val eclose_least = result();
-
-(*COMPLETELY DIFFERENT induction principle from eclose_induct!!*)
-val [major,base,step] = goal Epsilon.thy
- "[| a: eclose(b); \
-\ !!y. [| y: b |] ==> P(y); \
-\ !!y z. [| y: eclose(b); P(y); z: y |] ==> P(z) \
-\ |] ==> P(a)";
-by (rtac (major RSN (3, eclose_least RS subsetD RS CollectD2)) 1);
-by (rtac (CollectI RS subsetI) 2);
-by (etac (arg_subset_eclose RS subsetD) 2);
-by (etac base 2);
-by (rewtac Transset_def);
-by (fast_tac (ZF_cs addEs [step,ecloseD]) 1);
-val eclose_induct_down = result();
-
-goal Epsilon.thy "!!X. Transset(X) ==> eclose(X) = X";
-by (etac ([eclose_least, arg_subset_eclose] MRS equalityI) 1);
-by (rtac subset_refl 1);
-val Transset_eclose_eq_arg = result();
-
-
-(*** Epsilon recursion ***)
-
-(*Unused...*)
-goal Epsilon.thy "!!A B C. [| A: eclose(B); B: eclose(C) |] ==> A: eclose(C)";
-by (rtac ([Transset_eclose, eclose_subset] MRS eclose_least RS subsetD) 1);
-by (REPEAT (assume_tac 1));
-val mem_eclose_trans = result();
-
-(*Variant of the previous lemma in a useable form for the sequel*)
-goal Epsilon.thy
- "!!A B C. [| A: eclose({B}); B: eclose({C}) |] ==> A: eclose({C})";
-by (rtac ([Transset_eclose, singleton_subsetI] MRS eclose_least RS subsetD) 1);
-by (REPEAT (assume_tac 1));
-val mem_eclose_sing_trans = result();
-
-goalw Epsilon.thy [Transset_def]
- "!!i j. [| Transset(i); j:i |] ==> Memrel(i)-``{j} = j";
-by (fast_tac (eq_cs addSIs [MemrelI] addSEs [MemrelE]) 1);
-val under_Memrel = result();
-
-(* j : eclose(A) ==> Memrel(eclose(A)) -`` j = j *)
-val under_Memrel_eclose = Transset_eclose RS under_Memrel;
-
-val wfrec_ssubst = standard (wf_Memrel RS wfrec RS ssubst);
-
-val [kmemj,jmemi] = goal Epsilon.thy
- "[| k:eclose({j}); j:eclose({i}) |] ==> \
-\ wfrec(Memrel(eclose({i})), k, H) = wfrec(Memrel(eclose({j})), k, H)";
-by (rtac (kmemj RS eclose_induct) 1);
-by (rtac wfrec_ssubst 1);
-by (rtac wfrec_ssubst 1);
-by (asm_simp_tac (ZF_ss addsimps [under_Memrel_eclose,
- jmemi RSN (2,mem_eclose_sing_trans)]) 1);
-val wfrec_eclose_eq = result();
-
-val [prem] = goal Epsilon.thy
- "k: i ==> wfrec(Memrel(eclose({i})),k,H) = wfrec(Memrel(eclose({k})),k,H)";
-by (rtac (arg_in_eclose_sing RS wfrec_eclose_eq) 1);
-by (rtac (prem RS arg_into_eclose_sing) 1);
-val wfrec_eclose_eq2 = result();
-
-goalw Epsilon.thy [transrec_def]
- "transrec(a,H) = H(a, lam x:a. transrec(x,H))";
-by (rtac wfrec_ssubst 1);
-by (simp_tac (ZF_ss addsimps [wfrec_eclose_eq2, arg_in_eclose_sing,
- under_Memrel_eclose]) 1);
-val transrec = result();
-
-(*Avoids explosions in proofs; resolve it with a meta-level definition.*)
-val rew::prems = goal Epsilon.thy
- "[| !!x. f(x)==transrec(x,H) |] ==> f(a) = H(a, lam x:a. f(x))";
-by (rewtac rew);
-by (REPEAT (resolve_tac (prems@[transrec]) 1));
-val def_transrec = result();
-
-val prems = goal Epsilon.thy
- "[| !!x u. [| x:eclose({a}); u: Pi(x,B) |] ==> H(x,u) : B(x) \
-\ |] ==> transrec(a,H) : B(a)";
-by (res_inst_tac [("i", "a")] (arg_in_eclose_sing RS eclose_induct) 1);
-by (rtac (transrec RS ssubst) 1);
-by (REPEAT (ares_tac (prems @ [lam_type]) 1 ORELSE etac bspec 1));
-val transrec_type = result();
-
-goal Epsilon.thy "!!i. Ord(i) ==> eclose({i}) <= succ(i)";
-by (etac (Ord_is_Transset RS Transset_succ RS eclose_least) 1);
-by (rtac (succI1 RS singleton_subsetI) 1);
-val eclose_sing_Ord = result();
-
-val prems = goal Epsilon.thy
- "[| j: i; Ord(i); \
-\ !!x u. [| x: i; u: Pi(x,B) |] ==> H(x,u) : B(x) \
-\ |] ==> transrec(j,H) : B(j)";
-by (rtac transrec_type 1);
-by (resolve_tac prems 1);
-by (rtac (Ord_in_Ord RS eclose_sing_Ord RS subsetD RS succE) 1);
-by (DEPTH_SOLVE (ares_tac prems 1 ORELSE eresolve_tac [ssubst,Ord_trans] 1));
-val Ord_transrec_type = result();
-
-(*** Rank ***)
-
-(*NOT SUITABLE FOR REWRITING -- RECURSIVE!*)
-goal Epsilon.thy "rank(a) = (UN y:a. succ(rank(y)))";
-by (rtac (rank_def RS def_transrec RS ssubst) 1);
-by (simp_tac ZF_ss 1);
-val rank = result();
-
-goal Epsilon.thy "Ord(rank(a))";
-by (eps_ind_tac "a" 1);
-by (rtac (rank RS ssubst) 1);
-by (rtac (Ord_succ RS Ord_UN) 1);
-by (etac bspec 1);
-by (assume_tac 1);
-val Ord_rank = result();
-
-val [major] = goal Epsilon.thy "Ord(i) ==> rank(i) = i";
-by (rtac (major RS trans_induct) 1);
-by (rtac (rank RS ssubst) 1);
-by (asm_simp_tac (ZF_ss addsimps [Ord_equality]) 1);
-val rank_of_Ord = result();
-
-goal Epsilon.thy "!!a b. a:b ==> rank(a) < rank(b)";
-by (res_inst_tac [("a1","b")] (rank RS ssubst) 1);
-by (etac (UN_I RS ltI) 1);
-by (rtac succI1 1);
-by (REPEAT (ares_tac [Ord_UN, Ord_succ, Ord_rank] 1));
-val rank_lt = result();
-
-val [major] = goal Epsilon.thy "a: eclose(b) ==> rank(a) < rank(b)";
-by (rtac (major RS eclose_induct_down) 1);
-by (etac rank_lt 1);
-by (etac (rank_lt RS lt_trans) 1);
-by (assume_tac 1);
-val eclose_rank_lt = result();
-
-goal Epsilon.thy "!!a b. a<=b ==> rank(a) le rank(b)";
-by (rtac subset_imp_le 1);
-by (rtac (rank RS ssubst) 1);
-by (rtac (rank RS ssubst) 1);
-by (etac UN_mono 1);
-by (REPEAT (resolve_tac [subset_refl, Ord_rank] 1));
-val rank_mono = result();
-
-goal Epsilon.thy "rank(Pow(a)) = succ(rank(a))";
-by (rtac (rank RS trans) 1);
-by (rtac le_asym 1);
-by (DO_GOAL [rtac (Ord_rank RS Ord_succ RS UN_least_le),
- etac (PowD RS rank_mono RS succ_leI)] 1);
-by (DO_GOAL [rtac ([Pow_top, le_refl] MRS UN_upper_le),
- REPEAT o rtac (Ord_rank RS Ord_succ)] 1);
-val rank_Pow = result();
-
-goal Epsilon.thy "rank(0) = 0";
-by (rtac (rank RS trans) 1);
-by (fast_tac (ZF_cs addSIs [equalityI]) 1);
-val rank_0 = result();
-
-goal Epsilon.thy "rank(succ(x)) = succ(rank(x))";
-by (rtac (rank RS trans) 1);
-by (rtac ([UN_least, succI1 RS UN_upper] MRS equalityI) 1);
-by (etac succE 1);
-by (fast_tac ZF_cs 1);
-by (etac (rank_lt RS leI RS succ_leI RS le_imp_subset) 1);
-val rank_succ = result();
-
-goal Epsilon.thy "rank(Union(A)) = (UN x:A. rank(x))";
-by (rtac equalityI 1);
-by (rtac (rank_mono RS le_imp_subset RS UN_least) 2);
-by (etac Union_upper 2);
-by (rtac (rank RS ssubst) 1);
-by (rtac UN_least 1);
-by (etac UnionE 1);
-by (rtac subset_trans 1);
-by (etac (RepFunI RS Union_upper) 2);
-by (etac (rank_lt RS succ_leI RS le_imp_subset) 1);
-val rank_Union = result();
-
-goal Epsilon.thy "rank(eclose(a)) = rank(a)";
-by (rtac le_asym 1);
-by (rtac (arg_subset_eclose RS rank_mono) 2);
-by (res_inst_tac [("a1","eclose(a)")] (rank RS ssubst) 1);
-by (rtac (Ord_rank RS UN_least_le) 1);
-by (etac (eclose_rank_lt RS succ_leI) 1);
-val rank_eclose = result();
-
-goalw Epsilon.thy [Pair_def] "rank(a) < rank(<a,b>)";
-by (rtac (consI1 RS rank_lt RS lt_trans) 1);
-by (rtac (consI1 RS consI2 RS rank_lt) 1);
-val rank_pair1 = result();
-
-goalw Epsilon.thy [Pair_def] "rank(b) < rank(<a,b>)";
-by (rtac (consI1 RS consI2 RS rank_lt RS lt_trans) 1);
-by (rtac (consI1 RS consI2 RS rank_lt) 1);
-val rank_pair2 = result();
-
-goalw (merge_theories(Epsilon.thy,Sum.thy)) [Inl_def] "rank(a) < rank(Inl(a))";
-by (rtac rank_pair2 1);
-val rank_Inl = result();
-
-goalw (merge_theories(Epsilon.thy,Sum.thy)) [Inr_def] "rank(a) < rank(Inr(a))";
-by (rtac rank_pair2 1);
-val rank_Inr = result();
-
-(*** Corollaries of leastness ***)
-
-goal Epsilon.thy "!!A B. A:B ==> eclose(A)<=eclose(B)";
-by (rtac (Transset_eclose RS eclose_least) 1);
-by (etac (arg_into_eclose RS eclose_subset) 1);
-val mem_eclose_subset = result();
-
-goal Epsilon.thy "!!A B. A<=B ==> eclose(A) <= eclose(B)";
-by (rtac (Transset_eclose RS eclose_least) 1);
-by (etac subset_trans 1);
-by (rtac arg_subset_eclose 1);
-val eclose_mono = result();
-
-(** Idempotence of eclose **)
-
-goal Epsilon.thy "eclose(eclose(A)) = eclose(A)";
-by (rtac equalityI 1);
-by (rtac ([Transset_eclose, subset_refl] MRS eclose_least) 1);
-by (rtac arg_subset_eclose 1);
-val eclose_idem = result();
--- a/src/ZF/epsilon.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,18 +0,0 @@
-(* Title: ZF/epsilon.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Epsilon induction and recursion
-*)
-
-Epsilon = Nat + "mono" +
-consts
- eclose,rank :: "i=>i"
- transrec :: "[i, [i,i]=>i] =>i"
-
-rules
- eclose_def "eclose(A) == UN n:nat. nat_rec(n, A, %m r. Union(r))"
- transrec_def "transrec(a,H) == wfrec(Memrel(eclose({a})), a, H)"
- rank_def "rank(a) == transrec(a, %x f. UN y:x. succ(f`y))"
-end
--- a/src/ZF/ex/BT_Fn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,128 +0,0 @@
-(* Title: ZF/bt.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For bt.thy. Binary trees
-*)
-
-open BT_Fn;
-
-
-
-(** bt_rec -- by Vset recursion **)
-
-goalw BT.thy BT.con_defs "rank(l) < rank(Br(a,l,r))";
-by (simp_tac rank_ss 1);
-val rank_Br1 = result();
-
-goalw BT.thy BT.con_defs "rank(r) < rank(Br(a,l,r))";
-by (simp_tac rank_ss 1);
-val rank_Br2 = result();
-
-goal BT_Fn.thy "bt_rec(Lf,c,h) = c";
-by (rtac (bt_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (ZF_ss addsimps BT.case_eqns) 1);
-val bt_rec_Lf = result();
-
-goal BT_Fn.thy
- "bt_rec(Br(a,l,r), c, h) = h(a, l, r, bt_rec(l,c,h), bt_rec(r,c,h))";
-by (rtac (bt_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (rank_ss addsimps (BT.case_eqns @ [rank_Br1, rank_Br2])) 1);
-val bt_rec_Br = result();
-
-(*Type checking -- proved by induction, as usual*)
-val prems = goal BT_Fn.thy
- "[| t: bt(A); \
-\ c: C(Lf); \
-\ !!x y z r s. [| x:A; y:bt(A); z:bt(A); r:C(y); s:C(z) |] ==> \
-\ h(x,y,z,r,s): C(Br(x,y,z)) \
-\ |] ==> bt_rec(t,c,h) : C(t)";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps
- (prems@[bt_rec_Lf,bt_rec_Br]))));
-val bt_rec_type = result();
-
-(** Versions for use with definitions **)
-
-val [rew] = goal BT_Fn.thy "[| !!t. j(t)==bt_rec(t, c, h) |] ==> j(Lf) = c";
-by (rewtac rew);
-by (rtac bt_rec_Lf 1);
-val def_bt_rec_Lf = result();
-
-val [rew] = goal BT_Fn.thy
- "[| !!t. j(t)==bt_rec(t, c, h) |] ==> j(Br(a,l,r)) = h(a,l,r,j(l),j(r))";
-by (rewtac rew);
-by (rtac bt_rec_Br 1);
-val def_bt_rec_Br = result();
-
-fun bt_recs def = map standard ([def] RL [def_bt_rec_Lf, def_bt_rec_Br]);
-
-(** n_nodes **)
-
-val [n_nodes_Lf,n_nodes_Br] = bt_recs n_nodes_def;
-
-val prems = goalw BT_Fn.thy [n_nodes_def]
- "xs: bt(A) ==> n_nodes(xs) : nat";
-by (REPEAT (ares_tac (prems @ [bt_rec_type, nat_0I, nat_succI, add_type]) 1));
-val n_nodes_type = result();
-
-
-(** n_leaves **)
-
-val [n_leaves_Lf,n_leaves_Br] = bt_recs n_leaves_def;
-
-val prems = goalw BT_Fn.thy [n_leaves_def]
- "xs: bt(A) ==> n_leaves(xs) : nat";
-by (REPEAT (ares_tac (prems @ [bt_rec_type, nat_0I, nat_succI, add_type]) 1));
-val n_leaves_type = result();
-
-(** bt_reflect **)
-
-val [bt_reflect_Lf, bt_reflect_Br] = bt_recs bt_reflect_def;
-
-val prems = goalw BT_Fn.thy [bt_reflect_def]
- "xs: bt(A) ==> bt_reflect(xs) : bt(A)";
-by (REPEAT (ares_tac (prems @ [bt_rec_type, LfI, BrI]) 1));
-val bt_reflect_type = result();
-
-
-(** BT_Fn simplification **)
-
-
-val bt_typechecks =
- [LfI, BrI, bt_rec_type, n_nodes_type, n_leaves_type, bt_reflect_type];
-
-val bt_ss = arith_ss
- addsimps BT.case_eqns
- addsimps bt_typechecks
- addsimps [bt_rec_Lf, bt_rec_Br,
- n_nodes_Lf, n_nodes_Br,
- n_leaves_Lf, n_leaves_Br,
- bt_reflect_Lf, bt_reflect_Br];
-
-
-(*** theorems about n_leaves ***)
-
-val prems = goal BT_Fn.thy
- "t: bt(A) ==> n_leaves(bt_reflect(t)) = n_leaves(t)";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac bt_ss));
-by (REPEAT (ares_tac [add_commute, n_leaves_type] 1));
-val n_leaves_reflect = result();
-
-val prems = goal BT_Fn.thy
- "t: bt(A) ==> n_leaves(t) = succ(n_nodes(t))";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac (bt_ss addsimps [add_succ_right])));
-val n_leaves_nodes = result();
-
-(*** theorems about bt_reflect ***)
-
-val prems = goal BT_Fn.thy
- "t: bt(A) ==> bt_reflect(bt_reflect(t))=t";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac bt_ss));
-val bt_reflect_bt_reflect_ident = result();
-
-
--- a/src/ZF/ex/BT_Fn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-(* Title: ZF/ex/bt-fn.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Binary trees
-*)
-
-BT_Fn = BT +
-consts
- bt_rec :: "[i, i, [i,i,i,i,i]=>i] => i"
- n_nodes :: "i=>i"
- n_leaves :: "i=>i"
- bt_reflect :: "i=>i"
-
-rules
- bt_rec_def
- "bt_rec(t,c,h) == Vrec(t, %t g.bt_case(c, %x y z. h(x,y,z,g`y,g`z), t))"
-
- n_nodes_def "n_nodes(t) == bt_rec(t, 0, %x y z r s. succ(r#+s))"
- n_leaves_def "n_leaves(t) == bt_rec(t, succ(0), %x y z r s. r#+s)"
- bt_reflect_def "bt_reflect(t) == bt_rec(t, Lf, %x y z r s. Br(x,s,r))"
-
-end
--- a/src/ZF/ex/BinFn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,450 +0,0 @@
-(* Title: ZF/ex/bin.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For bin.thy. Arithmetic on binary integers.
-*)
-
-open BinFn;
-
-
-(** bin_rec -- by Vset recursion **)
-
-goal BinFn.thy "bin_rec(Plus,a,b,h) = a";
-by (rtac (bin_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Bin.con_defs);
-by (simp_tac rank_ss 1);
-val bin_rec_Plus = result();
-
-goal BinFn.thy "bin_rec(Minus,a,b,h) = b";
-by (rtac (bin_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Bin.con_defs);
-by (simp_tac rank_ss 1);
-val bin_rec_Minus = result();
-
-goal BinFn.thy "bin_rec(w$$x,a,b,h) = h(w, x, bin_rec(w,a,b,h))";
-by (rtac (bin_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Bin.con_defs);
-by (simp_tac rank_ss 1);
-val bin_rec_Bcons = result();
-
-(*Type checking*)
-val prems = goal BinFn.thy
- "[| w: bin; \
-\ a: C(Plus); b: C(Minus); \
-\ !!w x r. [| w: bin; x: bool; r: C(w) |] ==> h(w,x,r): C(w$$x) \
-\ |] ==> bin_rec(w,a,b,h) : C(w)";
-by (bin_ind_tac "w" prems 1);
-by (ALLGOALS
- (asm_simp_tac (ZF_ss addsimps (prems@[bin_rec_Plus,bin_rec_Minus,
- bin_rec_Bcons]))));
-val bin_rec_type = result();
-
-(** Versions for use with definitions **)
-
-val [rew] = goal BinFn.thy
- "[| !!w. j(w)==bin_rec(w,a,b,h) |] ==> j(Plus) = a";
-by (rewtac rew);
-by (rtac bin_rec_Plus 1);
-val def_bin_rec_Plus = result();
-
-val [rew] = goal BinFn.thy
- "[| !!w. j(w)==bin_rec(w,a,b,h) |] ==> j(Minus) = b";
-by (rewtac rew);
-by (rtac bin_rec_Minus 1);
-val def_bin_rec_Minus = result();
-
-val [rew] = goal BinFn.thy
- "[| !!w. j(w)==bin_rec(w,a,b,h) |] ==> j(w$$x) = h(w,x,j(w))";
-by (rewtac rew);
-by (rtac bin_rec_Bcons 1);
-val def_bin_rec_Bcons = result();
-
-fun bin_recs def = map standard
- ([def] RL [def_bin_rec_Plus, def_bin_rec_Minus, def_bin_rec_Bcons]);
-
-(** Type checking **)
-
-val bin_typechecks0 = bin_rec_type :: Bin.intrs;
-
-goalw BinFn.thy [integ_of_bin_def]
- "!!w. w: bin ==> integ_of_bin(w) : integ";
-by (typechk_tac (bin_typechecks0@integ_typechecks@
- nat_typechecks@[bool_into_nat]));
-val integ_of_bin_type = result();
-
-goalw BinFn.thy [bin_succ_def]
- "!!w. w: bin ==> bin_succ(w) : bin";
-by (typechk_tac (bin_typechecks0@bool_typechecks));
-val bin_succ_type = result();
-
-goalw BinFn.thy [bin_pred_def]
- "!!w. w: bin ==> bin_pred(w) : bin";
-by (typechk_tac (bin_typechecks0@bool_typechecks));
-val bin_pred_type = result();
-
-goalw BinFn.thy [bin_minus_def]
- "!!w. w: bin ==> bin_minus(w) : bin";
-by (typechk_tac ([bin_pred_type]@bin_typechecks0@bool_typechecks));
-val bin_minus_type = result();
-
-goalw BinFn.thy [bin_add_def]
- "!!v w. [| v: bin; w: bin |] ==> bin_add(v,w) : bin";
-by (typechk_tac ([bin_succ_type,bin_pred_type]@bin_typechecks0@
- bool_typechecks@ZF_typechecks));
-val bin_add_type = result();
-
-goalw BinFn.thy [bin_mult_def]
- "!!v w. [| v: bin; w: bin |] ==> bin_mult(v,w) : bin";
-by (typechk_tac ([bin_minus_type,bin_add_type]@bin_typechecks0@
- bool_typechecks));
-val bin_mult_type = result();
-
-val bin_typechecks = bin_typechecks0 @
- [integ_of_bin_type, bin_succ_type, bin_pred_type,
- bin_minus_type, bin_add_type, bin_mult_type];
-
-val bin_ss = integ_ss
- addsimps([bool_1I, bool_0I,
- bin_rec_Plus, bin_rec_Minus, bin_rec_Bcons] @
- bin_recs integ_of_bin_def @ bool_simps @ bin_typechecks);
-
-val typechecks = bin_typechecks @ integ_typechecks @ nat_typechecks @
- [bool_subset_nat RS subsetD];
-
-(**** The carry/borrow functions, bin_succ and bin_pred ****)
-
-(** Lemmas **)
-
-goal Integ.thy
- "!!z v. [| z $+ v = z' $+ v'; \
-\ z: integ; z': integ; v: integ; v': integ; w: integ |] \
-\ ==> z $+ (v $+ w) = z' $+ (v' $+ w)";
-by (asm_simp_tac (integ_ss addsimps ([zadd_assoc RS sym])) 1);
-val zadd_assoc_cong = result();
-
-goal Integ.thy
- "!!z v w. [| z: integ; v: integ; w: integ |] \
-\ ==> z $+ (v $+ w) = v $+ (z $+ w)";
-by (REPEAT (ares_tac [zadd_commute RS zadd_assoc_cong] 1));
-val zadd_assoc_swap = result();
-
-val zadd_cong =
- read_instantiate_sg (sign_of Integ.thy) [("t","op $+")] subst_context2;
-
-val zadd_kill = (refl RS zadd_cong);
-val zadd_assoc_swap_kill = zadd_kill RSN (4, zadd_assoc_swap RS trans);
-
-(*Pushes 'constants' of the form $#m to the right -- LOOPS if two!*)
-val zadd_assoc_znat = standard (znat_type RS zadd_assoc_swap);
-
-goal Integ.thy
- "!!z w. [| z: integ; w: integ |] \
-\ ==> w $+ (z $+ (w $+ z)) = w $+ (w $+ (z $+ z))";
-by (REPEAT (ares_tac [zadd_kill, zadd_assoc_swap] 1));
-val zadd_swap_pairs = result();
-
-
-val carry_ss = bin_ss addsimps
- (bin_recs bin_succ_def @ bin_recs bin_pred_def);
-
-goal BinFn.thy
- "!!w. w: bin ==> integ_of_bin(bin_succ(w)) = $#1 $+ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac (carry_ss addsimps [zadd_0_right]) 1);
-by (simp_tac (carry_ss addsimps [zadd_zminus_inverse]) 1);
-by (etac boolE 1);
-by (ALLGOALS (asm_simp_tac (carry_ss addsimps [zadd_assoc])));
-by (REPEAT (ares_tac (zadd_swap_pairs::typechecks) 1));
-val integ_of_bin_succ = result();
-
-goal BinFn.thy
- "!!w. w: bin ==> integ_of_bin(bin_pred(w)) = $~ ($#1) $+ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac (carry_ss addsimps [zadd_0_right]) 1);
-by (simp_tac (carry_ss addsimps [zadd_zminus_inverse]) 1);
-by (etac boolE 1);
-by (ALLGOALS
- (asm_simp_tac
- (carry_ss addsimps [zadd_assoc RS sym,
- zadd_zminus_inverse, zadd_zminus_inverse2])));
-by (REPEAT (ares_tac ([zadd_commute, zadd_cong, refl]@typechecks) 1));
-val integ_of_bin_pred = result();
-
-(*These two results replace the definitions of bin_succ and bin_pred*)
-
-
-(*** bin_minus: (unary!) negation of binary integers ***)
-
-val bin_minus_ss =
- bin_ss addsimps (bin_recs bin_minus_def @
- [integ_of_bin_succ, integ_of_bin_pred]);
-
-goal BinFn.thy
- "!!w. w: bin ==> integ_of_bin(bin_minus(w)) = $~ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac (bin_minus_ss addsimps [zminus_0]) 1);
-by (simp_tac (bin_minus_ss addsimps [zadd_0_right]) 1);
-by (etac boolE 1);
-by (ALLGOALS
- (asm_simp_tac (bin_minus_ss addsimps [zminus_zadd_distrib, zadd_assoc])));
-val integ_of_bin_minus = result();
-
-
-(*** bin_add: binary addition ***)
-
-goalw BinFn.thy [bin_add_def] "!!w. w: bin ==> bin_add(Plus,w) = w";
-by (asm_simp_tac bin_ss 1);
-val bin_add_Plus = result();
-
-goalw BinFn.thy [bin_add_def] "!!w. w: bin ==> bin_add(Minus,w) = bin_pred(w)";
-by (asm_simp_tac bin_ss 1);
-val bin_add_Minus = result();
-
-goalw BinFn.thy [bin_add_def] "bin_add(v$$x,Plus) = v$$x";
-by (simp_tac bin_ss 1);
-val bin_add_Bcons_Plus = result();
-
-goalw BinFn.thy [bin_add_def] "bin_add(v$$x,Minus) = bin_pred(v$$x)";
-by (simp_tac bin_ss 1);
-val bin_add_Bcons_Minus = result();
-
-goalw BinFn.thy [bin_add_def]
- "!!w y. [| w: bin; y: bool |] ==> \
-\ bin_add(v$$x, w$$y) = \
-\ bin_add(v, cond(x and y, bin_succ(w), w)) $$ (x xor y)";
-by (asm_simp_tac bin_ss 1);
-val bin_add_Bcons_Bcons = result();
-
-val bin_add_rews = [bin_add_Plus, bin_add_Minus, bin_add_Bcons_Plus,
- bin_add_Bcons_Minus, bin_add_Bcons_Bcons,
- integ_of_bin_succ, integ_of_bin_pred];
-
-val bin_add_ss = bin_ss addsimps ([bool_subset_nat RS subsetD] @ bin_add_rews);
-
-goal BinFn.thy
- "!!v. v: bin ==> \
-\ ALL w: bin. integ_of_bin(bin_add(v,w)) = \
-\ integ_of_bin(v) $+ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac bin_add_ss 1);
-by (simp_tac bin_add_ss 1);
-by (rtac ballI 1);
-by (bin_ind_tac "wa" [] 1);
-by (asm_simp_tac (bin_add_ss addsimps [zadd_0_right]) 1);
-by (asm_simp_tac bin_add_ss 1);
-by (REPEAT (ares_tac (zadd_commute::typechecks) 1));
-by (etac boolE 1);
-by (asm_simp_tac (bin_add_ss addsimps [zadd_assoc, zadd_swap_pairs]) 2);
-by (REPEAT (ares_tac ([refl, zadd_kill, zadd_assoc_swap_kill]@typechecks) 2));
-by (etac boolE 1);
-by (ALLGOALS (asm_simp_tac (bin_add_ss addsimps [zadd_assoc,zadd_swap_pairs])));
-by (REPEAT (ares_tac ([refl, zadd_kill, zadd_assoc_swap_kill RS sym]@
- typechecks) 1));
-val integ_of_bin_add_lemma = result();
-
-val integ_of_bin_add = integ_of_bin_add_lemma RS bspec;
-
-
-(*** bin_add: binary multiplication ***)
-
-val bin_mult_ss =
- bin_ss addsimps (bin_recs bin_mult_def @
- [integ_of_bin_minus, integ_of_bin_add]);
-
-
-val major::prems = goal BinFn.thy
- "[| v: bin; w: bin |] ==> \
-\ integ_of_bin(bin_mult(v,w)) = \
-\ integ_of_bin(v) $* integ_of_bin(w)";
-by (cut_facts_tac prems 1);
-by (bin_ind_tac "v" [major] 1);
-by (asm_simp_tac (bin_mult_ss addsimps [zmult_0]) 1);
-by (asm_simp_tac (bin_mult_ss addsimps [zmult_1,zmult_zminus]) 1);
-by (etac boolE 1);
-by (asm_simp_tac (bin_mult_ss addsimps [zadd_zmult_distrib]) 2);
-by (asm_simp_tac
- (bin_mult_ss addsimps [zadd_zmult_distrib, zmult_1, zadd_assoc]) 1);
-by (REPEAT (ares_tac ([zadd_commute, zadd_assoc_swap_kill RS sym]@
- typechecks) 1));
-val integ_of_bin_mult = result();
-
-(**** Computations ****)
-
-(** extra rules for bin_succ, bin_pred **)
-
-val [bin_succ_Plus, bin_succ_Minus, _] = bin_recs bin_succ_def;
-val [bin_pred_Plus, bin_pred_Minus, _] = bin_recs bin_pred_def;
-
-goal BinFn.thy "bin_succ(w$$1) = bin_succ(w) $$ 0";
-by (simp_tac carry_ss 1);
-val bin_succ_Bcons1 = result();
-
-goal BinFn.thy "bin_succ(w$$0) = w$$1";
-by (simp_tac carry_ss 1);
-val bin_succ_Bcons0 = result();
-
-goal BinFn.thy "bin_pred(w$$1) = w$$0";
-by (simp_tac carry_ss 1);
-val bin_pred_Bcons1 = result();
-
-goal BinFn.thy "bin_pred(w$$0) = bin_pred(w) $$ 1";
-by (simp_tac carry_ss 1);
-val bin_pred_Bcons0 = result();
-
-(** extra rules for bin_minus **)
-
-val [bin_minus_Plus, bin_minus_Minus, _] = bin_recs bin_minus_def;
-
-goal BinFn.thy "bin_minus(w$$1) = bin_pred(bin_minus(w) $$ 0)";
-by (simp_tac bin_minus_ss 1);
-val bin_minus_Bcons1 = result();
-
-goal BinFn.thy "bin_minus(w$$0) = bin_minus(w) $$ 0";
-by (simp_tac bin_minus_ss 1);
-val bin_minus_Bcons0 = result();
-
-(** extra rules for bin_add **)
-
-goal BinFn.thy
- "!!w. w: bin ==> bin_add(v$$1, w$$1) = bin_add(v, bin_succ(w)) $$ 0";
-by (asm_simp_tac bin_add_ss 1);
-val bin_add_Bcons_Bcons11 = result();
-
-goal BinFn.thy
- "!!w. w: bin ==> bin_add(v$$1, w$$0) = bin_add(v,w) $$ 1";
-by (asm_simp_tac bin_add_ss 1);
-val bin_add_Bcons_Bcons10 = result();
-
-goal BinFn.thy
- "!!w y.[| w: bin; y: bool |] ==> bin_add(v$$0, w$$y) = bin_add(v,w) $$ y";
-by (asm_simp_tac bin_add_ss 1);
-val bin_add_Bcons_Bcons0 = result();
-
-(** extra rules for bin_mult **)
-
-val [bin_mult_Plus, bin_mult_Minus, _] = bin_recs bin_mult_def;
-
-goal BinFn.thy "bin_mult(v$$1, w) = bin_add(bin_mult(v,w)$$0, w)";
-by (simp_tac bin_mult_ss 1);
-val bin_mult_Bcons1 = result();
-
-goal BinFn.thy "bin_mult(v$$0, w) = bin_mult(v,w)$$0";
-by (simp_tac bin_mult_ss 1);
-val bin_mult_Bcons0 = result();
-
-
-(*** The computation simpset ***)
-
-val bin_comp_ss = integ_ss
- addsimps [bin_succ_Plus, bin_succ_Minus,
- bin_succ_Bcons1, bin_succ_Bcons0,
- bin_pred_Plus, bin_pred_Minus,
- bin_pred_Bcons1, bin_pred_Bcons0,
- bin_minus_Plus, bin_minus_Minus,
- bin_minus_Bcons1, bin_minus_Bcons0,
- bin_add_Plus, bin_add_Minus, bin_add_Bcons_Plus,
- bin_add_Bcons_Minus, bin_add_Bcons_Bcons0,
- bin_add_Bcons_Bcons10, bin_add_Bcons_Bcons11,
- bin_mult_Plus, bin_mult_Minus,
- bin_mult_Bcons1, bin_mult_Bcons0]
- setsolver (type_auto_tac ([bool_1I, bool_0I] @ bin_typechecks0));
-
-(*** Examples of performing binary arithmetic by simplification ***)
-
-proof_timing := true;
-(*All runtimes below are on a SPARCserver 10*)
-
-(* 13+19 = 32 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$1$$0$$1, Plus$$1$$0$$0$$1$$1) = Plus$$1$$0$$0$$0$$0$$0";
-by (simp_tac bin_comp_ss 1); (*0.6 secs*)
-result();
-
-bin_add(binary_of_int 13, binary_of_int 19);
-
-(* 1234+5678 = 6912 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$0$$0$$1$$1$$0$$1$$0$$0$$1$$0, \
-\ Plus$$1$$0$$1$$1$$0$$0$$0$$1$$0$$1$$1$$1$$0) = \
-\ Plus$$1$$1$$0$$1$$1$$0$$0$$0$$0$$0$$0$$0$$0";
-by (simp_tac bin_comp_ss 1); (*2.6 secs*)
-result();
-
-bin_add(binary_of_int 1234, binary_of_int 5678);
-
-(* 1359-2468 = ~1109 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$0$$1$$0$$1$$0$$0$$1$$1$$1$$1, \
-\ Minus$$0$$1$$1$$0$$0$$1$$0$$1$$1$$1$$0$$0) = \
-\ Minus$$1$$0$$1$$1$$1$$0$$1$$0$$1$$0$$1$$1";
-by (simp_tac bin_comp_ss 1); (*2.3 secs*)
-result();
-
-bin_add(binary_of_int 1359, binary_of_int ~2468);
-
-(* 93746-46375 = 47371 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$0$$1$$1$$0$$1$$1$$1$$0$$0$$0$$1$$1$$0$$0$$1$$0, \
-\ Minus$$0$$1$$0$$0$$1$$0$$1$$0$$1$$1$$0$$1$$1$$0$$0$$1) = \
-\ Plus$$0$$1$$0$$1$$1$$1$$0$$0$$1$$0$$0$$0$$0$$1$$0$$1$$1";
-by (simp_tac bin_comp_ss 1); (*3.9 secs*)
-result();
-
-bin_add(binary_of_int 93746, binary_of_int ~46375);
-
-(* negation of 65745 *)
-goal BinFn.thy
- "bin_minus(Plus$$1$$0$$0$$0$$0$$0$$0$$0$$0$$1$$1$$0$$1$$0$$0$$0$$1) = \
-\ Minus$$0$$1$$1$$1$$1$$1$$1$$1$$1$$0$$0$$1$$0$$1$$1$$1$$1";
-by (simp_tac bin_comp_ss 1); (*0.6 secs*)
-result();
-
-bin_minus(binary_of_int 65745);
-
-(* negation of ~54321 *)
-goal BinFn.thy
- "bin_minus(Minus$$0$$0$$1$$0$$1$$0$$1$$1$$1$$1$$0$$0$$1$$1$$1$$1) = \
-\ Plus$$0$$1$$1$$0$$1$$0$$1$$0$$0$$0$$0$$1$$1$$0$$0$$0$$1";
-by (simp_tac bin_comp_ss 1); (*0.7 secs*)
-result();
-
-bin_minus(binary_of_int ~54321);
-
-(* 13*19 = 247 *)
-goal BinFn.thy "bin_mult(Plus$$1$$1$$0$$1, Plus$$1$$0$$0$$1$$1) = \
-\ Plus$$1$$1$$1$$1$$0$$1$$1$$1";
-by (simp_tac bin_comp_ss 1); (*1.5 secs*)
-result();
-
-bin_mult(binary_of_int 13, binary_of_int 19);
-
-(* ~84 * 51 = ~4284 *)
-goal BinFn.thy
- "bin_mult(Minus$$0$$1$$0$$1$$1$$0$$0, Plus$$1$$1$$0$$0$$1$$1) = \
-\ Minus$$0$$1$$1$$1$$1$$0$$1$$0$$0$$0$$1$$0$$0";
-by (simp_tac bin_comp_ss 1); (*2.6 secs*)
-result();
-
-bin_mult(binary_of_int ~84, binary_of_int 51);
-
-(* 255*255 = 65025; the worst case for 8-bit operands *)
-goal BinFn.thy
- "bin_mult(Plus$$1$$1$$1$$1$$1$$1$$1$$1, \
-\ Plus$$1$$1$$1$$1$$1$$1$$1$$1) = \
-\ Plus$$1$$1$$1$$1$$1$$1$$1$$0$$0$$0$$0$$0$$0$$0$$0$$1";
-by (simp_tac bin_comp_ss 1); (*9.8 secs*)
-result();
-
-bin_mult(binary_of_int 255, binary_of_int 255);
-
-(* 1359 * ~2468 = ~3354012 *)
-goal BinFn.thy
- "bin_mult(Plus$$1$$0$$1$$0$$1$$0$$0$$1$$1$$1$$1, \
-\ Minus$$0$$1$$1$$0$$0$$1$$0$$1$$1$$1$$0$$0) = \
-\ Minus$$0$$0$$1$$1$$0$$0$$1$$1$$0$$1$$0$$0$$1$$0$$0$$1$$1$$0$$0$$1$$0$$0";
-by (simp_tac bin_comp_ss 1); (*13.7 secs*)
-result();
-
-bin_mult(binary_of_int 1359, binary_of_int ~2468);
--- a/src/ZF/ex/BinFn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,52 +0,0 @@
-(* Title: ZF/bin
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Arithmetic on binary integers.
-*)
-
-BinFn = Integ + Bin +
-consts
- bin_rec :: "[i, i, i, [i,i,i]=>i] => i"
- integ_of_bin :: "i=>i"
- bin_succ :: "i=>i"
- bin_pred :: "i=>i"
- bin_minus :: "i=>i"
- bin_add,bin_mult :: "[i,i]=>i"
-
-rules
-
- bin_rec_def
- "bin_rec(z,a,b,h) == \
-\ Vrec(z, %z g. bin_case(a, b, %w x. h(w, x, g`w), z))"
-
- integ_of_bin_def
- "integ_of_bin(w) == bin_rec(w, $#0, $~($#1), %w x r. $#x $+ r $+ r)"
-
- bin_succ_def
- "bin_succ(w0) == bin_rec(w0, Plus$$1, Plus, %w x r. cond(x, r$$0, w$$1))"
-
- bin_pred_def
- "bin_pred(w0) == \
-\ bin_rec(w0, Minus, Minus$$0, %w x r. cond(x, w$$0, r$$1))"
-
- bin_minus_def
- "bin_minus(w0) == \
-\ bin_rec(w0, Plus, Plus$$1, %w x r. cond(x, bin_pred(r$$0), r$$0))"
-
- bin_add_def
- "bin_add(v0,w0) == \
-\ bin_rec(v0, \
-\ lam w:bin. w, \
-\ lam w:bin. bin_pred(w), \
-\ %v x r. lam w1:bin. \
-\ bin_rec(w1, v$$x, bin_pred(v$$x), \
-\ %w y s. (r`cond(x and y, bin_succ(w), w)) \
-\ $$ (x xor y))) ` w0"
-
- bin_mult_def
- "bin_mult(v0,w) == \
-\ bin_rec(v0, Plus, bin_minus(w), \
-\ %v x r. cond(x, bin_add(r$$0,w), r$$0))"
-end
--- a/src/ZF/ex/Contract0.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,118 +0,0 @@
-(* Title: ZF/ex/Contract0.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-For ex/contract.thy.
-*)
-
-open Contract0;
-
-structure Contract = Inductive_Fun
- (val thy = Contract0.thy;
- val thy_name = "Contract";
- val rec_doms = [("contract","comb*comb")];
- val sintrs =
- ["[| p:comb; q:comb |] ==> K#p#q -1-> p",
- "[| p:comb; q:comb; r:comb |] ==> S#p#q#r -1-> (p#r)#(q#r)",
- "[| p-1->q; r:comb |] ==> p#r -1-> q#r",
- "[| p-1->q; r:comb |] ==> r#p -1-> r#q"];
- val monos = [];
- val con_defs = [];
- val type_intrs = Comb.intrs;
- val type_elims = []);
-
-val [K_contract,S_contract,Ap_contract1,Ap_contract2] = Contract.intrs;
-
-val contract_induct = standard
- (Contract.mutual_induct RS spec RS spec RSN (2,rev_mp));
-
-(*For type checking: replaces a-1->b by a,b:comb *)
-val contract_combE2 = Contract.dom_subset RS subsetD RS SigmaE2;
-val contract_combD1 = Contract.dom_subset RS subsetD RS SigmaD1;
-val contract_combD2 = Contract.dom_subset RS subsetD RS SigmaD2;
-
-goal Contract.thy "field(contract) = comb";
-by (fast_tac (ZF_cs addIs [equalityI,K_contract] addSEs [contract_combE2]) 1);
-val field_contract_eq = result();
-
-val reduction_refl = standard
- (field_contract_eq RS equalityD2 RS subsetD RS rtrancl_refl);
-
-val rtrancl_into_rtrancl2 = standard
- (r_into_rtrancl RS (trans_rtrancl RS transD));
-
-val reduction_rls = [reduction_refl, K_contract, S_contract,
- K_contract RS rtrancl_into_rtrancl2,
- S_contract RS rtrancl_into_rtrancl2,
- Ap_contract1 RS rtrancl_into_rtrancl2,
- Ap_contract2 RS rtrancl_into_rtrancl2];
-
-goalw Contract.thy [I_def] "!!p. p:comb ==> I#p ---> p";
-by (REPEAT (ares_tac (Comb.intrs @ reduction_rls) 1));
-val I_reduce = result();
-
-goalw Contract.thy [I_def] "I: comb";
-by (REPEAT (ares_tac Comb.intrs 1));
-val I_comb = result();
-
-(** Non-contraction results **)
-
-(*Derive a case for each combinator constructor*)
-val K_contract_case = Contract.mk_cases Comb.con_defs "K -1-> r";
-val S_contract_case = Contract.mk_cases Comb.con_defs "S -1-> r";
-val Ap_contract_case = Contract.mk_cases Comb.con_defs "p#q -1-> r";
-
-val contract_cs =
- ZF_cs addSIs Comb.intrs
- addIs Contract.intrs
- addSEs [contract_combD1,contract_combD2] (*type checking*)
- addSEs [K_contract_case, S_contract_case, Ap_contract_case]
- addSEs Comb.free_SEs;
-
-goalw Contract.thy [I_def] "!!r. I -1-> r ==> P";
-by (fast_tac contract_cs 1);
-val I_contract_case = result();
-
-goal Contract.thy "!!p r. K#p -1-> r ==> (EX q. r = K#q & p -1-> q)";
-by (fast_tac contract_cs 1);
-val K1_contractD = result();
-
-goal Contract.thy "!!p r. [| p ---> q; r: comb |] ==> p#r ---> q#r";
-by (forward_tac [rtrancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_contract_eq RS equalityD1 RS subsetD) 1);
-by (etac rtrancl_induct 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (etac (trans_rtrancl RS transD) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-val Ap_reduce1 = result();
-
-goal Contract.thy "!!p r. [| p ---> q; r: comb |] ==> r#p ---> r#q";
-by (forward_tac [rtrancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_contract_eq RS equalityD1 RS subsetD) 1);
-by (etac rtrancl_induct 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (etac (trans_rtrancl RS transD) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-val Ap_reduce2 = result();
-
-(** Counterexample to the diamond property for -1-> **)
-
-goal Contract.thy "K#I#(I#I) -1-> I";
-by (REPEAT (ares_tac [K_contract, I_comb, Ap_comb] 1));
-val KIII_contract1 = result();
-
-goalw Contract.thy [I_def] "K#I#(I#I) -1-> K#I#((K#I)#(K#I))";
-by (DEPTH_SOLVE (resolve_tac (Comb.intrs @ Contract.intrs) 1));
-val KIII_contract2 = result();
-
-goal Contract.thy "K#I#((K#I)#(K#I)) -1-> I";
-by (REPEAT (ares_tac (Comb.intrs @ [K_contract, I_comb]) 1));
-val KIII_contract3 = result();
-
-goalw Contract.thy [diamond_def] "~ diamond(contract)";
-by (fast_tac (ZF_cs addIs [KIII_contract1,KIII_contract2,KIII_contract3]
- addSEs [I_contract_case]) 1);
-val not_diamond_contract = result();
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/Contract0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,36 +0,0 @@
-(* Title: ZF/ex/contract.thy
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Inductive definition of (1-step) contractions and (mult-step) reductions
-*)
-
-Contract0 = Comb +
-consts
- diamond :: "i => o"
- I :: "i"
-
- contract :: "i"
- "-1->" :: "[i,i] => o" (infixl 50)
- "--->" :: "[i,i] => o" (infixl 50)
-
- parcontract :: "i"
- "=1=>" :: "[i,i] => o" (infixl 50)
- "===>" :: "[i,i] => o" (infixl 50)
-
-translations
- "p -1-> q" == "<p,q> : contract"
- "p ---> q" == "<p,q> : contract^*"
- "p =1=> q" == "<p,q> : parcontract"
- "p ===> q" == "<p,q> : parcontract^+"
-
-rules
-
- diamond_def "diamond(r) == ALL x y. <x,y>:r --> \
-\ (ALL y'. <x,y'>:r --> \
-\ (EX z. <y,z>:r & <y',z> : r))"
-
- I_def "I == S#K#K"
-
-end
--- a/src/ZF/ex/Equiv.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,268 +0,0 @@
-(* Title: ZF/ex/Equiv.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1994 University of Cambridge
-
-For Equiv.thy. Equivalence relations in Zermelo-Fraenkel Set Theory
-*)
-
-val RSLIST = curry (op MRS);
-
-open Equiv;
-
-(*** Suppes, Theorem 70: r is an equiv relation iff converse(r) O r = r ***)
-
-(** first half: equiv(A,r) ==> converse(r) O r = r **)
-
-goalw Equiv.thy [trans_def,sym_def]
- "!!r. [| sym(r); trans(r) |] ==> converse(r) O r <= r";
-by (fast_tac (ZF_cs addSEs [converseD,compE]) 1);
-val sym_trans_comp_subset = result();
-
-goalw Equiv.thy [refl_def]
- "!!A r. [| refl(A,r); r <= A*A |] ==> r <= converse(r) O r";
-by (fast_tac (ZF_cs addSIs [converseI] addIs [compI]) 1);
-val refl_comp_subset = result();
-
-goalw Equiv.thy [equiv_def]
- "!!A r. equiv(A,r) ==> converse(r) O r = r";
-by (rtac equalityI 1);
-by (REPEAT (ares_tac [sym_trans_comp_subset, refl_comp_subset] 1
- ORELSE etac conjE 1));
-val equiv_comp_eq = result();
-
-(*second half*)
-goalw Equiv.thy [equiv_def,refl_def,sym_def,trans_def]
- "!!A r. [| converse(r) O r = r; domain(r) = A |] ==> equiv(A,r)";
-by (etac equalityE 1);
-by (subgoal_tac "ALL x y. <x,y> : r --> <y,x> : r" 1);
-by (safe_tac ZF_cs);
-by (fast_tac (ZF_cs addSIs [converseI] addIs [compI]) 3);
-by (ALLGOALS (fast_tac
- (ZF_cs addSIs [converseI] addIs [compI] addSEs [compE])));
-by flexflex_tac;
-val comp_equivI = result();
-
-(** Equivalence classes **)
-
-(*Lemma for the next result*)
-goalw Equiv.thy [trans_def,sym_def]
- "!!A r. [| sym(r); trans(r); <a,b>: r |] ==> r``{a} <= r``{b}";
-by (fast_tac ZF_cs 1);
-val equiv_class_subset = result();
-
-goalw Equiv.thy [equiv_def]
- "!!A r. [| equiv(A,r); <a,b>: r |] ==> r``{a} = r``{b}";
-by (safe_tac (subset_cs addSIs [equalityI, equiv_class_subset]));
-by (rewrite_goals_tac [sym_def]);
-by (fast_tac ZF_cs 1);
-val equiv_class_eq = result();
-
-val prems = goalw Equiv.thy [equiv_def,refl_def]
- "[| equiv(A,r); a: A |] ==> a: r``{a}";
-by (cut_facts_tac prems 1);
-by (fast_tac ZF_cs 1);
-val equiv_class_self = result();
-
-(*Lemma for the next result*)
-goalw Equiv.thy [equiv_def,refl_def]
- "!!A r. [| equiv(A,r); r``{b} <= r``{a}; b: A |] ==> <a,b>: r";
-by (fast_tac ZF_cs 1);
-val subset_equiv_class = result();
-
-val prems = goal Equiv.thy
- "[| r``{a} = r``{b}; equiv(A,r); b: A |] ==> <a,b>: r";
-by (REPEAT (resolve_tac (prems @ [equalityD2, subset_equiv_class]) 1));
-val eq_equiv_class = result();
-
-(*thus r``{a} = r``{b} as well*)
-goalw Equiv.thy [equiv_def,trans_def,sym_def]
- "!!A r. [| equiv(A,r); x: (r``{a} Int r``{b}) |] ==> <a,b>: r";
-by (fast_tac ZF_cs 1);
-val equiv_class_nondisjoint = result();
-
-goalw Equiv.thy [equiv_def] "!!A r. equiv(A,r) ==> r <= A*A";
-by (safe_tac ZF_cs);
-val equiv_type = result();
-
-goal Equiv.thy
- "!!A r. equiv(A,r) ==> <x,y>: r <-> r``{x} = r``{y} & x:A & y:A";
-by (fast_tac (ZF_cs addIs [eq_equiv_class, equiv_class_eq]
- addDs [equiv_type]) 1);
-val equiv_class_eq_iff = result();
-
-goal Equiv.thy
- "!!A r. [| equiv(A,r); x: A; y: A |] ==> r``{x} = r``{y} <-> <x,y>: r";
-by (fast_tac (ZF_cs addIs [eq_equiv_class, equiv_class_eq]
- addDs [equiv_type]) 1);
-val eq_equiv_class_iff = result();
-
-(*** Quotients ***)
-
-(** Introduction/elimination rules -- needed? **)
-
-val prems = goalw Equiv.thy [quotient_def] "x:A ==> r``{x}: A/r";
-by (rtac RepFunI 1);
-by (resolve_tac prems 1);
-val quotientI = result();
-
-val major::prems = goalw Equiv.thy [quotient_def]
- "[| X: A/r; !!x. [| X = r``{x}; x:A |] ==> P |] \
-\ ==> P";
-by (rtac (major RS RepFunE) 1);
-by (eresolve_tac prems 1);
-by (assume_tac 1);
-val quotientE = result();
-
-goalw Equiv.thy [equiv_def,refl_def,quotient_def]
- "!!A r. equiv(A,r) ==> Union(A/r) = A";
-by (fast_tac eq_cs 1);
-val Union_quotient = result();
-
-goalw Equiv.thy [quotient_def]
- "!!A r. [| equiv(A,r); X: A/r; Y: A/r |] ==> X=Y | (X Int Y <= 0)";
-by (safe_tac (ZF_cs addSIs [equiv_class_eq]));
-by (assume_tac 1);
-by (rewrite_goals_tac [equiv_def,trans_def,sym_def]);
-by (fast_tac ZF_cs 1);
-val quotient_disj = result();
-
-(**** Defining unary operations upon equivalence classes ****)
-
-(** These proofs really require as local premises
- equiv(A,r); congruent(r,b)
-**)
-
-(*Conversion rule*)
-val prems as [equivA,bcong,_] = goal Equiv.thy
- "[| equiv(A,r); congruent(r,b); a: A |] ==> (UN x:r``{a}. b(x)) = b(a)";
-by (cut_facts_tac prems 1);
-by (rtac ([refl RS UN_cong, UN_constant] MRS trans) 1);
-by (etac equiv_class_self 2);
-by (assume_tac 2);
-by (rewrite_goals_tac [equiv_def,sym_def,congruent_def]);
-by (fast_tac ZF_cs 1);
-val UN_equiv_class = result();
-
-(*Resolve th against the "local" premises*)
-val localize = RSLIST [equivA,bcong];
-
-(*type checking of UN x:r``{a}. b(x) *)
-val _::_::prems = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); congruent(r,b); X: A/r; \
-\ !!x. x : A ==> b(x) : B |] \
-\ ==> (UN x:X. b(x)) : B";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (rtac (localize UN_equiv_class RS ssubst) 1);
-by (REPEAT (ares_tac prems 1));
-val UN_equiv_class_type = result();
-
-(*Sufficient conditions for injectiveness. Could weaken premises!
- major premise could be an inclusion; bcong could be !!y. y:A ==> b(y):B
-*)
-val _::_::prems = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); congruent(r,b); \
-\ (UN x:X. b(x))=(UN y:Y. b(y)); X: A/r; Y: A/r; \
-\ !!x y. [| x:A; y:A; b(x)=b(y) |] ==> <x,y>:r |] \
-\ ==> X=Y";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (rtac (equivA RS equiv_class_eq) 1);
-by (REPEAT (ares_tac prems 1));
-by (etac box_equals 1);
-by (REPEAT (ares_tac [localize UN_equiv_class] 1));
-val UN_equiv_class_inject = result();
-
-
-(**** Defining binary operations upon equivalence classes ****)
-
-
-goalw Equiv.thy [congruent_def,congruent2_def,equiv_def,refl_def]
- "!!A r. [| equiv(A,r); congruent2(r,b); a: A |] ==> congruent(r,b(a))";
-by (fast_tac ZF_cs 1);
-val congruent2_implies_congruent = result();
-
-val equivA::prems = goalw Equiv.thy [congruent_def]
- "[| equiv(A,r); congruent2(r,b); a: A |] ==> \
-\ congruent(r, %x1. UN x2:r``{a}. b(x1,x2))";
-by (cut_facts_tac (equivA::prems) 1);
-by (safe_tac ZF_cs);
-by (rtac (equivA RS equiv_type RS subsetD RS SigmaE2) 1);
-by (assume_tac 1);
-by (asm_simp_tac (ZF_ss addsimps [equivA RS UN_equiv_class,
- congruent2_implies_congruent]) 1);
-by (rewrite_goals_tac [congruent2_def,equiv_def,refl_def]);
-by (fast_tac ZF_cs 1);
-val congruent2_implies_congruent_UN = result();
-
-val prems as equivA::_ = goal Equiv.thy
- "[| equiv(A,r); congruent2(r,b); a1: A; a2: A |] \
-\ ==> (UN x1:r``{a1}. UN x2:r``{a2}. b(x1,x2)) = b(a1,a2)";
-by (cut_facts_tac prems 1);
-by (asm_simp_tac (ZF_ss addsimps [equivA RS UN_equiv_class,
- congruent2_implies_congruent,
- congruent2_implies_congruent_UN]) 1);
-val UN_equiv_class2 = result();
-
-(*type checking*)
-val prems = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); congruent2(r,b); \
-\ X1: A/r; X2: A/r; \
-\ !!x1 x2. [| x1: A; x2: A |] ==> b(x1,x2) : B |] \
-\ ==> (UN x1:X1. UN x2:X2. b(x1,x2)) : B";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (REPEAT (ares_tac (prems@[UN_equiv_class_type,
- congruent2_implies_congruent_UN,
- congruent2_implies_congruent, quotientI]) 1));
-val UN_equiv_class_type2 = result();
-
-
-(*Suggested by John Harrison -- the two subproofs may be MUCH simpler
- than the direct proof*)
-val prems = goalw Equiv.thy [congruent2_def,equiv_def,refl_def]
- "[| equiv(A,r); \
-\ !! y z w. [| w: A; <y,z> : r |] ==> b(y,w) = b(z,w); \
-\ !! y z w. [| w: A; <y,z> : r |] ==> b(w,y) = b(w,z) \
-\ |] ==> congruent2(r,b)";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (rtac trans 1);
-by (REPEAT (ares_tac prems 1
- ORELSE etac (subsetD RS SigmaE2) 1 THEN assume_tac 2 THEN assume_tac 1));
-val congruent2I = result();
-
-val [equivA,commute,congt] = goal Equiv.thy
- "[| equiv(A,r); \
-\ !! y z. [| y: A; z: A |] ==> b(y,z) = b(z,y); \
-\ !! y z w. [| w: A; <y,z>: r |] ==> b(w,y) = b(w,z) \
-\ |] ==> congruent2(r,b)";
-by (resolve_tac [equivA RS congruent2I] 1);
-by (rtac (commute RS trans) 1);
-by (rtac (commute RS trans RS sym) 3);
-by (rtac sym 5);
-by (REPEAT (ares_tac [congt] 1
- ORELSE etac (equivA RS equiv_type RS subsetD RS SigmaE2) 1));
-val congruent2_commuteI = result();
-
-(***OBSOLETE VERSION
-(*Rules congruentI and congruentD would simplify use of rewriting below*)
-val [equivA,ZinA,congt,commute] = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); Z: A/r; \
-\ !!w. [| w: A |] ==> congruent(r, %z.b(w,z)); \
-\ !!x y. [| x: A; y: A |] ==> b(y,x) = b(x,y) \
-\ |] ==> congruent(r, %w. UN z: Z. b(w,z))";
-val congt' = rewrite_rule [congruent_def] congt;
-by (cut_facts_tac [ZinA,congt] 1);
-by (rewtac congruent_def);
-by (safe_tac ZF_cs);
-by (rtac (equivA RS equiv_type RS subsetD RS SigmaE2) 1);
-by (assume_tac 1);
-by (asm_simp_tac (ZF_ss addsimps [congt RS (equivA RS UN_equiv_class)]) 1);
-by (rtac (commute RS trans) 1);
-by (rtac (commute RS trans RS sym) 3);
-by (rtac sym 5);
-by (REPEAT (ares_tac [congt' RS spec RS spec RS mp] 1));
-val congruent_commuteI = result();
-***)
--- a/src/ZF/ex/Equiv.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-(* Title: ZF/ex/Equiv.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1994 University of Cambridge
-
-Equivalence relations in Zermelo-Fraenkel Set Theory
-*)
-
-Equiv = Rel + Perm +
-consts
- "'/" :: "[i,i]=>i" (infixl 90) (*set of equiv classes*)
- congruent :: "[i,i=>i]=>o"
- congruent2 :: "[i,[i,i]=>i]=>o"
-
-rules
- quotient_def "A/r == {r``{x} . x:A}"
- congruent_def "congruent(r,b) == ALL y z. <y,z>:r --> b(y)=b(z)"
-
- congruent2_def
- "congruent2(r,b) == ALL y1 z1 y2 z2. \
-\ <y1,z1>:r --> <y2,z2>:r --> b(y1,y2) = b(z1,z2)"
-
-end
--- a/src/ZF/ex/LListFn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,98 +0,0 @@
-(* Title: ZF/ex/llist-fn.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Functions for Lazy Lists in Zermelo-Fraenkel Set Theory
-
-Examples of coinduction for type-checking and to prove llist equations
-*)
-
-open LListFn;
-
-(*** lconst -- defined directly using lfp, but equivalent to a LList_corec ***)
-
-goalw LListFn.thy LList.con_defs "bnd_mono(univ(a), %l. LCons(a,l))";
-by (rtac bnd_monoI 1);
-by (REPEAT (ares_tac [subset_refl, QInr_mono, QPair_mono] 2));
-by (REPEAT (ares_tac [subset_refl, A_subset_univ,
- QInr_subset_univ, QPair_subset_univ] 1));
-val lconst_fun_bnd_mono = result();
-
-(* lconst(a) = LCons(a,lconst(a)) *)
-val lconst = standard
- ([lconst_def, lconst_fun_bnd_mono] MRS def_lfp_Tarski);
-
-val lconst_subset = lconst_def RS def_lfp_subset;
-
-val member_subset_Union_eclose = standard (arg_into_eclose RS Union_upper);
-
-goal LListFn.thy "!!a A. a : A ==> lconst(a) : quniv(A)";
-by (rtac (lconst_subset RS subset_trans RS qunivI) 1);
-by (etac (arg_into_eclose RS eclose_subset RS univ_mono) 1);
-val lconst_in_quniv = result();
-
-goal LListFn.thy "!!a A. a:A ==> lconst(a): llist(A)";
-by (rtac (singletonI RS LList.coinduct) 1);
-by (fast_tac (ZF_cs addSIs [lconst_in_quniv]) 1);
-by (fast_tac (ZF_cs addSIs [lconst]) 1);
-val lconst_type = result();
-
-(*** flip --- equations merely assumed; certain consequences proved ***)
-
-val flip_ss = ZF_ss addsimps [flip_LNil, flip_LCons, not_type];
-
-goal QUniv.thy "!!b. b:bool ==> b Int X <= univ(eclose(A))";
-by (fast_tac (quniv_cs addSEs [boolE]) 1);
-val bool_Int_subset_univ = result();
-
-val flip_cs = quniv_cs addSIs [not_type]
- addIs [bool_Int_subset_univ];
-
-(*Reasoning borrowed from llist_eq.ML; a similar proof works for all
- "productive" functions -- cf Coquand's "Infinite Objects in Type Theory".*)
-goal LListFn.thy
- "!!i. Ord(i) ==> ALL l: llist(bool). flip(l) Int Vset(i) <= \
-\ univ(eclose(bool))";
-by (etac trans_induct 1);
-by (rtac ballI 1);
-by (etac LList.elim 1);
-by (asm_simp_tac flip_ss 1);
-by (asm_simp_tac flip_ss 2);
-by (rewrite_goals_tac ([QInl_def,QInr_def]@LList.con_defs));
-(*LNil case*)
-by (fast_tac flip_cs 1);
-(*LCons case*)
-by (safe_tac flip_cs);
-by (ALLGOALS (fast_tac (flip_cs addSEs [Ord_trans, make_elim bspec])));
-val flip_llist_quniv_lemma = result();
-
-goal LListFn.thy "!!l. l: llist(bool) ==> flip(l) : quniv(bool)";
-by (rtac (flip_llist_quniv_lemma RS bspec RS Int_Vset_subset RS qunivI) 1);
-by (REPEAT (assume_tac 1));
-val flip_in_quniv = result();
-
-val [prem] = goal LListFn.thy "l : llist(bool) ==> flip(l): llist(bool)";
-by (res_inst_tac [("X", "{flip(l) . l:llist(bool)}")]
- LList.coinduct 1);
-by (rtac (prem RS RepFunI) 1);
-by (fast_tac (ZF_cs addSIs [flip_in_quniv]) 1);
-by (etac RepFunE 1);
-by (etac LList.elim 1);
-by (asm_simp_tac flip_ss 1);
-by (asm_simp_tac flip_ss 1);
-by (fast_tac (ZF_cs addSIs [not_type]) 1);
-val flip_type = result();
-
-val [prem] = goal LListFn.thy
- "l : llist(bool) ==> flip(flip(l)) = l";
-by (res_inst_tac [("X1", "{<flip(flip(l)),l> . l:llist(bool)}")]
- (LList_Eq.coinduct RS lleq_implies_equal) 1);
-by (rtac (prem RS RepFunI) 1);
-by (fast_tac (ZF_cs addSIs [flip_type]) 1);
-by (etac RepFunE 1);
-by (etac LList.elim 1);
-by (asm_simp_tac flip_ss 1);
-by (asm_simp_tac (flip_ss addsimps [flip_type, not_not]) 1);
-by (fast_tac (ZF_cs addSIs [not_type]) 1);
-val flip_flip = result();
--- a/src/ZF/ex/LListFn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-(* Title: ZF/ex/llist-fn.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Functions for Lazy Lists in Zermelo-Fraenkel Set Theory
-
-STILL NEEDS:
-co_recursion for defining lconst, flip, etc.
-a typing rule for it, based on some notion of "productivity..."
-*)
-
-LListFn = LList + LList_Eq +
-consts
- lconst :: "i => i"
- flip :: "i => i"
-
-rules
- lconst_def "lconst(a) == lfp(univ(a), %l. LCons(a,l))"
-
- flip_LNil "flip(LNil) = LNil"
-
- flip_LCons "[| x:bool; l: llist(bool) |] ==> \
-\ flip(LCons(x,l)) = LCons(not(x), flip(l))"
-
-end
--- a/src/ZF/ex/LList_Eq.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,73 +0,0 @@
-(* Title: ZF/ex/llist_eq.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Equality for llist(A) as a greatest fixed point
-***)
-
-(*Previously used <*> in the domain and variant pairs as elements. But
- standard pairs work just as well. To use variant pairs, must change prefix
- a q/Q to the Sigma, Pair and converse rules.*)
-
-structure LList_Eq = CoInductive_Fun
- (val thy = LList.thy |> add_consts [("lleq","i=>i",NoSyn)]
- val thy_name = "LList_Eq"
- val rec_doms = [("lleq", "llist(A) * llist(A)")]
- val sintrs =
- ["<LNil, LNil> : lleq(A)",
- "[| a:A; <l,l'>: lleq(A) |] ==> <LCons(a,l), LCons(a,l')>: lleq(A)"]
- val monos = []
- val con_defs = []
- val type_intrs = LList.intrs
- val type_elims = []);
-
-(** Alternatives for above:
- val con_defs = LList.con_defs
- val type_intrs = codatatype_intrs
- val type_elims = [quniv_QPair_E]
-**)
-
-val lleq_cs = subset_cs
- addSIs [QPair_Int_Vset_subset_UN RS subset_trans, QPair_mono]
- addSEs [Ord_in_Ord, Pair_inject];
-
-(*Lemma for proving finality. Unfold the lazy list; use induction hypothesis*)
-goal LList_Eq.thy
- "!!i. Ord(i) ==> ALL l l'. <l,l'> : lleq(A) --> l Int Vset(i) <= l'";
-by (etac trans_induct 1);
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (etac LList_Eq.elim 1);
-by (rewrite_goals_tac (QInr_def::LList.con_defs));
-by (safe_tac lleq_cs);
-by (fast_tac (subset_cs addSEs [Ord_trans, make_elim bspec]) 1);
-val lleq_Int_Vset_subset_lemma = result();
-
-val lleq_Int_Vset_subset = standard
- (lleq_Int_Vset_subset_lemma RS spec RS spec RS mp);
-
-
-(*lleq(A) is a symmetric relation because qconverse(lleq(A)) is a fixedpoint*)
-val [prem] = goal LList_Eq.thy "<l,l'> : lleq(A) ==> <l',l> : lleq(A)";
-by (rtac (prem RS converseI RS LList_Eq.coinduct) 1);
-by (rtac (LList_Eq.dom_subset RS converse_type) 1);
-by (safe_tac converse_cs);
-by (etac LList_Eq.elim 1);
-by (ALLGOALS (fast_tac qconverse_cs));
-val lleq_symmetric = result();
-
-goal LList_Eq.thy "!!l l'. <l,l'> : lleq(A) ==> l=l'";
-by (rtac equalityI 1);
-by (REPEAT (ares_tac [lleq_Int_Vset_subset RS Int_Vset_subset] 1
- ORELSE etac lleq_symmetric 1));
-val lleq_implies_equal = result();
-
-val [eqprem,lprem] = goal LList_Eq.thy
- "[| l=l'; l: llist(A) |] ==> <l,l'> : lleq(A)";
-by (res_inst_tac [("X", "{<l,l>. l: llist(A)}")] LList_Eq.coinduct 1);
-by (rtac (lprem RS RepFunI RS (eqprem RS subst)) 1);
-by (safe_tac qpair_cs);
-by (etac LList.elim 1);
-by (ALLGOALS (fast_tac pair_cs));
-val equal_llist_implies_leq = result();
-
--- a/src/ZF/ex/ParContract.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,146 +0,0 @@
-(* Title: ZF/ex/parcontract.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Parallel contraction
-
-HOL system proofs may be found in
-/usr/groups/theory/hvg-aftp/contrib/rule-induction/cl.ml
-*)
-
-structure ParContract = Inductive_Fun
- (val thy = Contract.thy;
- val thy_name = "ParContract";
- val rec_doms = [("parcontract","comb*comb")];
- val sintrs =
- ["[| p:comb |] ==> p =1=> p",
- "[| p:comb; q:comb |] ==> K#p#q =1=> p",
- "[| p:comb; q:comb; r:comb |] ==> S#p#q#r =1=> (p#r)#(q#r)",
- "[| p=1=>q; r=1=>s |] ==> p#r =1=> q#s"];
- val monos = [];
- val con_defs = [];
- val type_intrs = Comb.intrs;
- val type_elims = []);
-
-val [parcontract_refl,K_parcontract,S_parcontract,Ap_parcontract] =
- ParContract.intrs;
-
-val parcontract_induct = standard
- (ParContract.mutual_induct RS spec RS spec RSN (2,rev_mp));
-
-(*For type checking: replaces a=1=>b by a,b:comb *)
-val parcontract_combE2 = ParContract.dom_subset RS subsetD RS SigmaE2;
-val parcontract_combD1 = ParContract.dom_subset RS subsetD RS SigmaD1;
-val parcontract_combD2 = ParContract.dom_subset RS subsetD RS SigmaD2;
-
-goal ParContract.thy "field(parcontract) = comb";
-by (fast_tac (ZF_cs addIs [equalityI,K_parcontract]
- addSEs [parcontract_combE2]) 1);
-val field_parcontract_eq = result();
-
-val parcontract_caseE = standard
- (ParContract.unfold RS equalityD1 RS subsetD RS CollectE);
-
-(*Derive a case for each combinator constructor*)
-val K_parcontract_case = ParContract.mk_cases Comb.con_defs "K =1=> r";
-val S_parcontract_case = ParContract.mk_cases Comb.con_defs "S =1=> r";
-val Ap_parcontract_case = ParContract.mk_cases Comb.con_defs "p#q =1=> r";
-
-val parcontract_cs =
- ZF_cs addSIs Comb.intrs
- addIs ParContract.intrs
- addSEs [Ap_E, K_parcontract_case, S_parcontract_case,
- Ap_parcontract_case]
- addSEs [parcontract_combD1, parcontract_combD2] (*type checking*)
- addSEs Comb.free_SEs;
-
-(*** Basic properties of parallel contraction ***)
-
-goal ParContract.thy "!!p r. K#p =1=> r ==> (EX p'. r = K#p' & p =1=> p')";
-by (fast_tac parcontract_cs 1);
-val K1_parcontractD = result();
-
-goal ParContract.thy "!!p r. S#p =1=> r ==> (EX p'. r = S#p' & p =1=> p')";
-by (fast_tac parcontract_cs 1);
-val S1_parcontractD = result();
-
-goal ParContract.thy
- "!!p q r. S#p#q =1=> r ==> (EX p' q'. r = S#p'#q' & p =1=> p' & q =1=> q')";
-by (fast_tac (parcontract_cs addSDs [S1_parcontractD]) 1);
-val S2_parcontractD = result();
-
-(*Church-Rosser property for parallel contraction*)
-goalw ParContract.thy [diamond_def] "diamond(parcontract)";
-by (rtac (impI RS allI RS allI) 1);
-by (etac parcontract_induct 1);
-by (ALLGOALS
- (fast_tac (parcontract_cs addSDs [K1_parcontractD,S2_parcontractD])));
-val diamond_parcontract = result();
-
-(*** Transitive closure preserves the Church-Rosser property ***)
-
-goalw ParContract.thy [diamond_def]
- "!!x y r. [| diamond(r); <x,y>:r^+ |] ==> \
-\ ALL y'. <x,y'>:r --> (EX z. <y',z>: r^+ & <y,z>: r)";
-by (etac trancl_induct 1);
-by (fast_tac (ZF_cs addIs [r_into_trancl]) 1);
-by (slow_best_tac (ZF_cs addSDs [spec RS mp]
- addIs [r_into_trancl, trans_trancl RS transD]) 1);
-val diamond_trancl_lemma = result();
-
-val diamond_lemmaE = diamond_trancl_lemma RS spec RS mp RS exE;
-
-val [major] = goal ParContract.thy "diamond(r) ==> diamond(r^+)";
-bw diamond_def; (*unfold only in goal, not in premise!*)
-by (rtac (impI RS allI RS allI) 1);
-by (etac trancl_induct 1);
-by (ALLGOALS
- (slow_best_tac (ZF_cs addIs [r_into_trancl, trans_trancl RS transD]
- addEs [major RS diamond_lemmaE])));
-val diamond_trancl = result();
-
-
-(*** Equivalence of p--->q and p===>q ***)
-
-goal ParContract.thy "!!p q. p-1->q ==> p=1=>q";
-by (etac contract_induct 1);
-by (ALLGOALS (fast_tac (parcontract_cs)));
-val contract_imp_parcontract = result();
-
-goal ParContract.thy "!!p q. p--->q ==> p===>q";
-by (forward_tac [rtrancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_contract_eq RS equalityD1 RS subsetD) 1);
-by (etac rtrancl_induct 1);
-by (fast_tac (parcontract_cs addIs [r_into_trancl]) 1);
-by (fast_tac (ZF_cs addIs [contract_imp_parcontract,
- r_into_trancl, trans_trancl RS transD]) 1);
-val reduce_imp_parreduce = result();
-
-
-goal ParContract.thy "!!p q. p=1=>q ==> p--->q";
-by (etac parcontract_induct 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (rtac (trans_rtrancl RS transD) 1);
-by (ALLGOALS
- (fast_tac
- (contract_cs addIs [Ap_reduce1, Ap_reduce2]
- addSEs [parcontract_combD1,parcontract_combD2])));
-val parcontract_imp_reduce = result();
-
-goal ParContract.thy "!!p q. p===>q ==> p--->q";
-by (forward_tac [trancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_parcontract_eq RS equalityD1 RS subsetD) 1);
-by (etac trancl_induct 1);
-by (etac parcontract_imp_reduce 1);
-by (etac (trans_rtrancl RS transD) 1);
-by (etac parcontract_imp_reduce 1);
-val parreduce_imp_reduce = result();
-
-goal ParContract.thy "p===>q <-> p--->q";
-by (REPEAT (ares_tac [iffI, parreduce_imp_reduce, reduce_imp_parreduce] 1));
-val parreduce_iff_reduce = result();
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/Primrec0.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,395 +0,0 @@
-(* Title: ZF/ex/primrec
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Primitive Recursive Functions
-
-Proof adopted from
-Nora Szasz,
-A Machine Checked Proof that Ackermann's Function is not Primitive Recursive,
-In: Huet & Plotkin, eds., Logical Environments (CUP, 1993), 317-338.
-
-See also E. Mendelson, Introduction to Mathematical Logic.
-(Van Nostrand, 1964), page 250, exercise 11.
-*)
-
-open Primrec0;
-
-val pr0_typechecks =
- nat_typechecks @ List.intrs @
- [lam_type, list_case_type, drop_type, map_type, apply_type, rec_type];
-
-(** Useful special cases of evaluation ***)
-
-val pr0_ss = arith_ss
- addsimps List.case_eqns
- addsimps [list_rec_Nil, list_rec_Cons,
- drop_0, drop_Nil, drop_succ_Cons,
- map_Nil, map_Cons]
- setsolver (type_auto_tac pr0_typechecks);
-
-goalw Primrec0.thy [SC_def]
- "!!x l. [| x:nat; l: list(nat) |] ==> SC ` (Cons(x,l)) = succ(x)";
-by (asm_simp_tac pr0_ss 1);
-val SC = result();
-
-goalw Primrec0.thy [CONST_def]
- "!!l. [| l: list(nat) |] ==> CONST(k) ` l = k";
-by (asm_simp_tac pr0_ss 1);
-val CONST = result();
-
-goalw Primrec0.thy [PROJ_def]
- "!!l. [| x: nat; l: list(nat) |] ==> PROJ(0) ` (Cons(x,l)) = x";
-by (asm_simp_tac pr0_ss 1);
-val PROJ_0 = result();
-
-goalw Primrec0.thy [COMP_def]
- "!!l. [| l: list(nat) |] ==> COMP(g,[f]) ` l = g` [f`l]";
-by (asm_simp_tac pr0_ss 1);
-val COMP_1 = result();
-
-goalw Primrec0.thy [PREC_def]
- "!!l. l: list(nat) ==> PREC(f,g) ` (Cons(0,l)) = f`l";
-by (asm_simp_tac pr0_ss 1);
-val PREC_0 = result();
-
-goalw Primrec0.thy [PREC_def]
- "!!l. [| x:nat; l: list(nat) |] ==> \
-\ PREC(f,g) ` (Cons(succ(x),l)) = \
-\ g ` Cons(PREC(f,g)`(Cons(x,l)), Cons(x,l))";
-by (asm_simp_tac pr0_ss 1);
-val PREC_succ = result();
-
-(*** Inductive definition of the PR functions ***)
-
-structure Primrec = Inductive_Fun
- (val thy = Primrec0.thy
- val thy_name = "Primrec"
- val rec_doms = [("primrec", "list(nat)->nat")]
- val sintrs =
- ["SC : primrec",
- "k: nat ==> CONST(k) : primrec",
- "i: nat ==> PROJ(i) : primrec",
- "[| g: primrec; fs: list(primrec) |] ==> COMP(g,fs): primrec",
- "[| f: primrec; g: primrec |] ==> PREC(f,g): primrec"]
- val monos = [list_mono]
- val con_defs = [SC_def,CONST_def,PROJ_def,COMP_def,PREC_def]
- val type_intrs = pr0_typechecks
- val type_elims = []);
-
-
-(* c: primrec ==> c: list(nat) -> nat *)
-val primrec_into_fun = Primrec.dom_subset RS subsetD;
-
-val pr_ss = pr0_ss
- setsolver (type_auto_tac ([primrec_into_fun] @
- pr0_typechecks @ Primrec.intrs));
-
-goalw Primrec.thy [ACK_def] "!!i. i:nat ==> ACK(i): primrec";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac pr_ss));
-val ACK_in_primrec = result();
-
-val ack_typechecks =
- [ACK_in_primrec, primrec_into_fun RS apply_type,
- add_type, list_add_type, nat_into_Ord] @
- nat_typechecks @ List.intrs @ Primrec.intrs;
-
-(*strict typechecking for the Ackermann proof; instantiates no vars*)
-fun tc_tac rls =
- REPEAT
- (SOMEGOAL (test_assume_tac ORELSE' match_tac (rls @ ack_typechecks)));
-
-goal Primrec.thy "!!i j. [| i:nat; j:nat |] ==> ack(i,j): nat";
-by (tc_tac []);
-val ack_type = result();
-
-(** Ackermann's function cases **)
-
-(*PROPERTY A 1*)
-goalw Primrec0.thy [ACK_def] "!!j. j:nat ==> ack(0,j) = succ(j)";
-by (asm_simp_tac (pr0_ss addsimps [SC]) 1);
-val ack_0 = result();
-
-(*PROPERTY A 2*)
-goalw Primrec0.thy [ACK_def] "ack(succ(i), 0) = ack(i,1)";
-by (asm_simp_tac (pr0_ss addsimps [CONST,PREC_0]) 1);
-val ack_succ_0 = result();
-
-(*PROPERTY A 3*)
-(*Could be proved in Primrec0, like the previous two cases, but using
- primrec_into_fun makes type-checking easier!*)
-goalw Primrec.thy [ACK_def]
- "!!i j. [| i:nat; j:nat |] ==> \
-\ ack(succ(i), succ(j)) = ack(i, ack(succ(i), j))";
-by (asm_simp_tac (pr_ss addsimps [CONST,PREC_succ,COMP_1,PROJ_0]) 1);
-val ack_succ_succ = result();
-
-val ack_ss =
- pr_ss addsimps [ack_0, ack_succ_0, ack_succ_succ,
- ack_type, nat_into_Ord];
-
-(*PROPERTY A 4*)
-goal Primrec.thy "!!i. i:nat ==> ALL j:nat. j < ack(i,j)";
-by (etac nat_induct 1);
-by (asm_simp_tac ack_ss 1);
-by (rtac ballI 1);
-by (eres_inst_tac [("n","j")] nat_induct 1);
-by (DO_GOAL [rtac (nat_0I RS nat_0_le RS lt_trans),
- asm_simp_tac ack_ss] 1);
-by (DO_GOAL [etac (succ_leI RS lt_trans1),
- asm_simp_tac ack_ss] 1);
-val lt_ack2_lemma = result();
-val lt_ack2 = standard (lt_ack2_lemma RS bspec);
-
-(*PROPERTY A 5-, the single-step lemma*)
-goal Primrec.thy "!!i j. [| i:nat; j:nat |] ==> ack(i,j) < ack(i, succ(j))";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (ack_ss addsimps [lt_ack2])));
-val ack_lt_ack_succ2 = result();
-
-(*PROPERTY A 5, monotonicity for < *)
-goal Primrec.thy "!!i j k. [| j<k; i:nat; k:nat |] ==> ack(i,j) < ack(i,k)";
-by (forward_tac [lt_nat_in_nat] 1 THEN assume_tac 1);
-by (etac succ_lt_induct 1);
-by (assume_tac 1);
-by (rtac lt_trans 2);
-by (REPEAT (ares_tac ([ack_lt_ack_succ2, ack_type] @ pr0_typechecks) 1));
-val ack_lt_mono2 = result();
-
-(*PROPERTY A 5', monotonicity for le *)
-goal Primrec.thy
- "!!i j k. [| j le k; i: nat; k:nat |] ==> ack(i,j) le ack(i,k)";
-by (res_inst_tac [("f", "%j.ack(i,j)")] Ord_lt_mono_imp_le_mono 1);
-by (REPEAT (ares_tac [ack_lt_mono2, ack_type RS nat_into_Ord] 1));
-val ack_le_mono2 = result();
-
-(*PROPERTY A 6*)
-goal Primrec.thy
- "!!i j. [| i:nat; j:nat |] ==> ack(i, succ(j)) le ack(succ(i), j)";
-by (nat_ind_tac "j" [] 1);
-by (ALLGOALS (asm_simp_tac ack_ss));
-by (rtac ack_le_mono2 1);
-by (rtac (lt_ack2 RS succ_leI RS le_trans) 1);
-by (REPEAT (ares_tac (ack_typechecks) 1));
-val ack2_le_ack1 = result();
-
-(*PROPERTY A 7-, the single-step lemma*)
-goal Primrec.thy "!!i j. [| i:nat; j:nat |] ==> ack(i,j) < ack(succ(i),j)";
-by (rtac (ack_lt_mono2 RS lt_trans2) 1);
-by (rtac ack2_le_ack1 4);
-by (REPEAT (ares_tac ([nat_le_refl, ack_type] @ pr0_typechecks) 1));
-val ack_lt_ack_succ1 = result();
-
-(*PROPERTY A 7, monotonicity for < *)
-goal Primrec.thy "!!i j k. [| i<j; j:nat; k:nat |] ==> ack(i,k) < ack(j,k)";
-by (forward_tac [lt_nat_in_nat] 1 THEN assume_tac 1);
-by (etac succ_lt_induct 1);
-by (assume_tac 1);
-by (rtac lt_trans 2);
-by (REPEAT (ares_tac ([ack_lt_ack_succ1, ack_type] @ pr0_typechecks) 1));
-val ack_lt_mono1 = result();
-
-(*PROPERTY A 7', monotonicity for le *)
-goal Primrec.thy
- "!!i j k. [| i le j; j:nat; k:nat |] ==> ack(i,k) le ack(j,k)";
-by (res_inst_tac [("f", "%j.ack(j,k)")] Ord_lt_mono_imp_le_mono 1);
-by (REPEAT (ares_tac [ack_lt_mono1, ack_type RS nat_into_Ord] 1));
-val ack_le_mono1 = result();
-
-(*PROPERTY A 8*)
-goal Primrec.thy "!!j. j:nat ==> ack(1,j) = succ(succ(j))";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac ack_ss));
-val ack_1 = result();
-
-(*PROPERTY A 9*)
-goal Primrec.thy "!!j. j:nat ==> ack(succ(1),j) = succ(succ(succ(j#+j)))";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (ack_ss addsimps [ack_1, add_succ_right])));
-val ack_2 = result();
-
-(*PROPERTY A 10*)
-goal Primrec.thy
- "!!i1 i2 j. [| i1:nat; i2:nat; j:nat |] ==> \
-\ ack(i1, ack(i2,j)) < ack(succ(succ(i1#+i2)), j)";
-by (rtac (ack2_le_ack1 RSN (2,lt_trans2)) 1);
-by (asm_simp_tac ack_ss 1);
-by (rtac (add_le_self RS ack_le_mono1 RS lt_trans1) 1);
-by (rtac (add_le_self2 RS ack_lt_mono1 RS ack_lt_mono2) 5);
-by (tc_tac []);
-val ack_nest_bound = result();
-
-(*PROPERTY A 11*)
-goal Primrec.thy
- "!!i1 i2 j. [| i1:nat; i2:nat; j:nat |] ==> \
-\ ack(i1,j) #+ ack(i2,j) < ack(succ(succ(succ(succ(i1#+i2)))), j)";
-by (res_inst_tac [("j", "ack(succ(1), ack(i1 #+ i2, j))")] lt_trans 1);
-by (asm_simp_tac (ack_ss addsimps [ack_2]) 1);
-by (rtac (ack_nest_bound RS lt_trans2) 2);
-by (asm_simp_tac ack_ss 5);
-by (rtac (add_le_mono RS leI RS leI) 1);
-by (REPEAT (ares_tac ([add_le_self, add_le_self2, ack_le_mono1] @
- ack_typechecks) 1));
-val ack_add_bound = result();
-
-(*PROPERTY A 12. Article uses existential quantifier but the ALF proof
- used k#+4. Quantified version must be nested EX k'. ALL i,j... *)
-goal Primrec.thy
- "!!i j k. [| i < ack(k,j); j:nat; k:nat |] ==> \
-\ i#+j < ack(succ(succ(succ(succ(k)))), j)";
-by (res_inst_tac [("j", "ack(k,j) #+ ack(0,j)")] lt_trans 1);
-by (rtac (ack_add_bound RS lt_trans2) 2);
-by (asm_simp_tac (ack_ss addsimps [add_0_right]) 5);
-by (REPEAT (ares_tac ([add_lt_mono, lt_ack2] @ ack_typechecks) 1));
-val ack_add_bound2 = result();
-
-(*** MAIN RESULT ***)
-
-val ack2_ss =
- ack_ss addsimps [list_add_Nil, list_add_Cons, list_add_type, nat_into_Ord];
-
-goalw Primrec.thy [SC_def]
- "!!l. l: list(nat) ==> SC ` l < ack(1, list_add(l))";
-by (etac List.elim 1);
-by (asm_simp_tac (ack2_ss addsimps [succ_iff]) 1);
-by (asm_simp_tac (ack2_ss addsimps [ack_1, add_le_self]) 1);
-val SC_case = result();
-
-(*PROPERTY A 4'? Extra lemma needed for CONST case, constant functions*)
-goal Primrec.thy "!!j. [| i:nat; j:nat |] ==> i < ack(i,j)";
-by (etac nat_induct 1);
-by (asm_simp_tac (ack_ss addsimps [nat_0_le]) 1);
-by (etac ([succ_leI, ack_lt_ack_succ1] MRS lt_trans1) 1);
-by (tc_tac []);
-val lt_ack1 = result();
-
-goalw Primrec.thy [CONST_def]
- "!!l. [| l: list(nat); k: nat |] ==> CONST(k) ` l < ack(k, list_add(l))";
-by (asm_simp_tac (ack2_ss addsimps [lt_ack1]) 1);
-val CONST_case = result();
-
-goalw Primrec.thy [PROJ_def]
- "!!l. l: list(nat) ==> ALL i:nat. PROJ(i) ` l < ack(0, list_add(l))";
-by (asm_simp_tac ack2_ss 1);
-by (etac List.induct 1);
-by (asm_simp_tac (ack2_ss addsimps [nat_0_le]) 1);
-by (asm_simp_tac ack2_ss 1);
-by (rtac ballI 1);
-by (eres_inst_tac [("n","x")] natE 1);
-by (asm_simp_tac (ack2_ss addsimps [add_le_self]) 1);
-by (asm_simp_tac ack2_ss 1);
-by (etac (bspec RS lt_trans2) 1);
-by (rtac (add_le_self2 RS succ_leI) 2);
-by (tc_tac []);
-val PROJ_case_lemma = result();
-val PROJ_case = PROJ_case_lemma RS bspec;
-
-(** COMP case **)
-
-goal Primrec.thy
- "!!fs. fs : list({f: primrec . \
-\ EX kf:nat. ALL l:list(nat). \
-\ f`l < ack(kf, list_add(l))}) \
-\ ==> EX k:nat. ALL l: list(nat). \
-\ list_add(map(%f. f ` l, fs)) < ack(k, list_add(l))";
-by (etac List.induct 1);
-by (DO_GOAL [res_inst_tac [("x","0")] bexI,
- asm_simp_tac (ack2_ss addsimps [lt_ack1, nat_0_le]),
- resolve_tac nat_typechecks] 1);
-by (safe_tac ZF_cs);
-by (asm_simp_tac ack2_ss 1);
-by (rtac (ballI RS bexI) 1);
-by (rtac (add_lt_mono RS lt_trans) 1);
-by (REPEAT (FIRSTGOAL (etac bspec)));
-by (rtac ack_add_bound 5);
-by (tc_tac []);
-val COMP_map_lemma = result();
-
-goalw Primrec.thy [COMP_def]
- "!!g. [| g: primrec; kg: nat; \
-\ ALL l:list(nat). g`l < ack(kg, list_add(l)); \
-\ fs : list({f: primrec . \
-\ EX kf:nat. ALL l:list(nat). \
-\ f`l < ack(kf, list_add(l))}) \
-\ |] ==> EX k:nat. ALL l: list(nat). COMP(g,fs)`l < ack(k, list_add(l))";
-by (asm_simp_tac ZF_ss 1);
-by (forward_tac [list_CollectD] 1);
-by (etac (COMP_map_lemma RS bexE) 1);
-by (rtac (ballI RS bexI) 1);
-by (etac (bspec RS lt_trans) 1);
-by (rtac lt_trans 2);
-by (rtac ack_nest_bound 3);
-by (etac (bspec RS ack_lt_mono2) 2);
-by (tc_tac [map_type]);
-val COMP_case = result();
-
-(** PREC case **)
-
-goalw Primrec.thy [PREC_def]
- "!!f g. [| ALL l:list(nat). f`l #+ list_add(l) < ack(kf, list_add(l)); \
-\ ALL l:list(nat). g`l #+ list_add(l) < ack(kg, list_add(l)); \
-\ f: primrec; kf: nat; \
-\ g: primrec; kg: nat; \
-\ l: list(nat) \
-\ |] ==> PREC(f,g)`l #+ list_add(l) < ack(succ(kf#+kg), list_add(l))";
-by (etac List.elim 1);
-by (asm_simp_tac (ack2_ss addsimps [[nat_le_refl, lt_ack2] MRS lt_trans]) 1);
-by (asm_simp_tac ack2_ss 1);
-by (etac ssubst 1); (*get rid of the needless assumption*)
-by (eres_inst_tac [("n","a")] nat_induct 1);
-(*base case*)
-by (DO_GOAL [asm_simp_tac ack2_ss, rtac lt_trans, etac bspec,
- assume_tac, rtac (add_le_self RS ack_lt_mono1),
- REPEAT o ares_tac (ack_typechecks)] 1);
-(*ind step*)
-by (asm_simp_tac (ack2_ss addsimps [add_succ_right]) 1);
-by (rtac (succ_leI RS lt_trans1) 1);
-by (res_inst_tac [("j", "g ` ?ll #+ ?mm")] lt_trans1 1);
-by (etac bspec 2);
-by (rtac (nat_le_refl RS add_le_mono) 1);
-by (tc_tac []);
-by (asm_simp_tac (ack2_ss addsimps [add_le_self2]) 1);
-(*final part of the simplification*)
-by (asm_simp_tac ack2_ss 1);
-by (rtac (add_le_self2 RS ack_le_mono1 RS lt_trans1) 1);
-by (etac ack_lt_mono2 5);
-by (tc_tac []);
-val PREC_case_lemma = result();
-
-goal Primrec.thy
- "!!f g. [| f: primrec; kf: nat; \
-\ g: primrec; kg: nat; \
-\ ALL l:list(nat). f`l < ack(kf, list_add(l)); \
-\ ALL l:list(nat). g`l < ack(kg, list_add(l)) \
-\ |] ==> EX k:nat. ALL l: list(nat). \
-\ PREC(f,g)`l< ack(k, list_add(l))";
-by (rtac (ballI RS bexI) 1);
-by (rtac ([add_le_self, PREC_case_lemma] MRS lt_trans1) 1);
-by (REPEAT
- (SOMEGOAL
- (FIRST' [test_assume_tac,
- match_tac (ack_typechecks),
- rtac (ack_add_bound2 RS ballI) THEN' etac bspec])));
-val PREC_case = result();
-
-goal Primrec.thy
- "!!f. f:primrec ==> EX k:nat. ALL l:list(nat). f`l < ack(k, list_add(l))";
-by (etac Primrec.induct 1);
-by (safe_tac ZF_cs);
-by (DEPTH_SOLVE
- (ares_tac ([SC_case, CONST_case, PROJ_case, COMP_case, PREC_case,
- bexI, ballI] @ nat_typechecks) 1));
-val ack_bounds_primrec = result();
-
-goal Primrec.thy
- "~ (lam l:list(nat). list_case(0, %x xs. ack(x,x), l)) : primrec";
-by (rtac notI 1);
-by (etac (ack_bounds_primrec RS bexE) 1);
-by (rtac lt_irrefl 1);
-by (dres_inst_tac [("x", "[x]")] bspec 1);
-by (asm_simp_tac ack2_ss 1);
-by (asm_full_simp_tac (ack2_ss addsimps [add_0_right]) 1);
-val ack_not_primrec = result();
-
--- a/src/ZF/ex/Primrec0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,49 +0,0 @@
-(* Title: ZF/ex/primrec.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Primitive Recursive Functions
-
-Proof adopted from
-Nora Szasz,
-A Machine Checked Proof that Ackermann's Function is not Primitive Recursive,
-In: Huet & Plotkin, eds., Logical Environments (CUP, 1993), 317-338.
-
-See also E. Mendelson, Introduction to Mathematical Logic.
-(Van Nostrand, 1964), page 250, exercise 11.
-*)
-
-Primrec0 = ListFn +
-consts
- SC :: "i"
- CONST :: "i=>i"
- PROJ :: "i=>i"
- COMP :: "[i,i]=>i"
- PREC :: "[i,i]=>i"
- primrec :: "i"
- ACK :: "i=>i"
- ack :: "[i,i]=>i"
-
-translations
- "ack(x,y)" == "ACK(x) ` [y]"
-
-rules
-
- SC_def "SC == lam l:list(nat).list_case(0, %x xs.succ(x), l)"
-
- CONST_def "CONST(k) == lam l:list(nat).k"
-
- PROJ_def "PROJ(i) == lam l:list(nat). list_case(0, %x xs.x, drop(i,l))"
-
- COMP_def "COMP(g,fs) == lam l:list(nat). g ` map(%f. f`l, fs)"
-
- (*Note that g is applied first to PREC(f,g)`y and then to y!*)
- PREC_def "PREC(f,g) == \
-\ lam l:list(nat). list_case(0, \
-\ %x xs. rec(x, f`xs, %y r. g ` Cons(r, Cons(y, xs))), l)"
-
- ACK_def "ACK(i) == rec(i, SC, \
-\ %z r. PREC (CONST (r`[1]), COMP(r,[PROJ(0)])))"
-
-end
--- a/src/ZF/ex/Prop.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,35 +0,0 @@
-(* Title: ZF/ex/prop.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Datatype definition of propositional logic formulae and inductive definition
-of the propositional tautologies.
-*)
-
-(*Example of a datatype with mixfix syntax for some constructors*)
-structure Prop = Datatype_Fun
- (val thy = Univ.thy;
- val thy_name = "Prop";
- val rec_specs =
- [("prop", "univ(0)",
- [(["Fls"], "i",NoSyn),
- (["Var"], "i=>i", Mixfix ("#_", [100], 100)),
- (["=>"], "[i,i]=>i", Infixr 90)])];
- val rec_styp = "i";
- val sintrs =
- ["Fls : prop",
- "n: nat ==> #n : prop",
- "[| p: prop; q: prop |] ==> p=>q : prop"];
- val monos = [];
- val type_intrs = datatype_intrs;
- val type_elims = []);
-
-val [FlsI,VarI,ImpI] = Prop.intrs;
-
-
-(** Type-checking rules **)
-
-val ImpE = Prop.mk_cases Prop.con_defs "p=>q : prop";
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/TF_Fn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,225 +0,0 @@
-(* Title: ZF/ex/tf.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For tf.thy. Trees & forests, a mutually recursive type definition.
-
-Still needs
-
-"TF_reflect == (%z. TF_rec(z, %x ts r. Tcons(x,r), 0,
- %t ts r1 r2. TF_of_list(list_of_TF(r2) @ <r1,0>)))"
-*)
-
-open TF_Fn;
-
-
-(*** TF_rec -- by Vset recursion ***)
-
-(** conversion rules **)
-
-goal TF_Fn.thy "TF_rec(Tcons(a,f), b, c, d) = b(a, f, TF_rec(f,b,c,d))";
-by (rtac (TF_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (simp_tac rank_ss 1);
-val TF_rec_Tcons = result();
-
-goal TF_Fn.thy "TF_rec(Fnil, b, c, d) = c";
-by (rtac (TF_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (simp_tac rank_ss 1);
-val TF_rec_Fnil = result();
-
-goal TF_Fn.thy "TF_rec(Fcons(t,f), b, c, d) = \
-\ d(t, f, TF_rec(t, b, c, d), TF_rec(f, b, c, d))";
-by (rtac (TF_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (simp_tac rank_ss 1);
-val TF_rec_Fcons = result();
-
-(*list_ss includes list operations as well as arith_ss*)
-val TF_rec_ss = list_ss addsimps
- [TF_rec_Tcons, TF_rec_Fnil, TF_rec_Fcons, TconsI, FnilI, FconsI];
-
-(** Type checking **)
-
-val major::prems = goal TF_Fn.thy
- "[| z: tree_forest(A); \
-\ !!x f r. [| x: A; f: forest(A); r: C(f) \
-\ |] ==> b(x,f,r): C(Tcons(x,f)); \
-\ c : C(Fnil); \
-\ !!t f r1 r2. [| t: tree(A); f: forest(A); r1: C(t); r2: C(f) \
-\ |] ==> d(t,f,r1,r2): C(Fcons(t,f)) \
-\ |] ==> TF_rec(z,b,c,d) : C(z)";
-by (rtac (major RS TF.induct) 1);
-by (ALLGOALS (asm_simp_tac (TF_rec_ss addsimps prems)));
-val TF_rec_type = result();
-
-(*Mutually recursive version*)
-val prems = goal TF_Fn.thy
- "[| !!x f r. [| x: A; f: forest(A); r: D(f) \
-\ |] ==> b(x,f,r): C(Tcons(x,f)); \
-\ c : D(Fnil); \
-\ !!t f r1 r2. [| t: tree(A); f: forest(A); r1: C(t); r2: D(f) \
-\ |] ==> d(t,f,r1,r2): D(Fcons(t,f)) \
-\ |] ==> (ALL t:tree(A). TF_rec(t,b,c,d) : C(t)) & \
-\ (ALL f: forest(A). TF_rec(f,b,c,d) : D(f))";
-by (rewtac Ball_def);
-by (rtac TF.mutual_induct 1);
-by (ALLGOALS (asm_simp_tac (TF_rec_ss addsimps prems)));
-val tree_forest_rec_type = result();
-
-
-(** Versions for use with definitions **)
-
-val [rew] = goal TF_Fn.thy
- "[| !!z. j(z)==TF_rec(z,b,c,d) |] ==> j(Tcons(a,f)) = b(a,f,j(f))";
-by (rewtac rew);
-by (rtac TF_rec_Tcons 1);
-val def_TF_rec_Tcons = result();
-
-val [rew] = goal TF_Fn.thy
- "[| !!z. j(z)==TF_rec(z,b,c,d) |] ==> j(Fnil) = c";
-by (rewtac rew);
-by (rtac TF_rec_Fnil 1);
-val def_TF_rec_Fnil = result();
-
-val [rew] = goal TF_Fn.thy
- "[| !!z. j(z)==TF_rec(z,b,c,d) |] ==> j(Fcons(t,f)) = d(t,f,j(t),j(f))";
-by (rewtac rew);
-by (rtac TF_rec_Fcons 1);
-val def_TF_rec_Fcons = result();
-
-fun TF_recs def = map standard
- ([def] RL [def_TF_rec_Tcons, def_TF_rec_Fnil, def_TF_rec_Fcons]);
-
-
-(** list_of_TF and TF_of_list **)
-
-val [list_of_TF_Tcons, list_of_TF_Fnil, list_of_TF_Fcons] =
- TF_recs list_of_TF_def;
-
-goalw TF_Fn.thy [list_of_TF_def]
- "!!z A. z: tree_forest(A) ==> list_of_TF(z) : list(tree(A))";
-by (REPEAT (ares_tac ([TF_rec_type,TconsI] @ list_typechecks) 1));
-val list_of_TF_type = result();
-
-val [TF_of_list_Nil,TF_of_list_Cons] = list_recs TF_of_list_def;
-
-goalw TF_Fn.thy [TF_of_list_def]
- "!!l A. l: list(tree(A)) ==> TF_of_list(l) : forest(A)";
-by (REPEAT (ares_tac [list_rec_type, FnilI, FconsI] 1));
-val TF_of_list_type = result();
-
-
-(** TF_map **)
-
-val [TF_map_Tcons, TF_map_Fnil, TF_map_Fcons] = TF_recs TF_map_def;
-
-val prems = goalw TF_Fn.thy [TF_map_def]
- "[| !!x. x: A ==> h(x): B |] ==> \
-\ (ALL t:tree(A). TF_map(h,t) : tree(B)) & \
-\ (ALL f: forest(A). TF_map(h,f) : forest(B))";
-by (REPEAT
- (ares_tac ([tree_forest_rec_type, TconsI, FnilI, FconsI] @ prems) 1));
-val TF_map_type = result();
-
-
-(** TF_size **)
-
-val [TF_size_Tcons, TF_size_Fnil, TF_size_Fcons] = TF_recs TF_size_def;
-
-goalw TF_Fn.thy [TF_size_def]
- "!!z A. z: tree_forest(A) ==> TF_size(z) : nat";
-by (REPEAT (ares_tac [TF_rec_type, add_type, nat_0I, nat_succI] 1));
-val TF_size_type = result();
-
-
-(** TF_preorder **)
-
-val [TF_preorder_Tcons, TF_preorder_Fnil, TF_preorder_Fcons] =
- TF_recs TF_preorder_def;
-
-goalw TF_Fn.thy [TF_preorder_def]
- "!!z A. z: tree_forest(A) ==> TF_preorder(z) : list(A)";
-by (REPEAT (ares_tac [TF_rec_type, app_type,NilI, ConsI] 1));
-val TF_preorder_type = result();
-
-
-(** Term simplification **)
-
-val treeI = tree_subset_TF RS subsetD
-and forestI = forest_subset_TF RS subsetD;
-
-val TF_typechecks =
- [TconsI, FnilI, FconsI, treeI, forestI,
- list_of_TF_type, TF_map_type, TF_size_type, TF_preorder_type];
-
-val TF_rewrites =
- [TF_rec_Tcons, TF_rec_Fnil, TF_rec_Fcons,
- list_of_TF_Tcons, list_of_TF_Fnil, list_of_TF_Fcons,
- TF_of_list_Nil,TF_of_list_Cons,
- TF_map_Tcons, TF_map_Fnil, TF_map_Fcons,
- TF_size_Tcons, TF_size_Fnil, TF_size_Fcons,
- TF_preorder_Tcons, TF_preorder_Fnil, TF_preorder_Fcons];
-
-val TF_ss = list_ss addsimps TF_rewrites
- setsolver type_auto_tac (list_typechecks@TF_typechecks);
-
-(** theorems about list_of_TF and TF_of_list **)
-
-(*essentially the same as list induction*)
-val major::prems = goal TF_Fn.thy
- "[| f: forest(A); \
-\ R(Fnil); \
-\ !!t f. [| t: tree(A); f: forest(A); R(f) |] ==> R(Fcons(t,f)) \
-\ |] ==> R(f)";
-by (rtac (major RS (TF.mutual_induct RS conjunct2 RS spec RSN (2,rev_mp))) 1);
-by (REPEAT (ares_tac (TrueI::prems) 1));
-val forest_induct = result();
-
-goal TF_Fn.thy "!!f A. f: forest(A) ==> TF_of_list(list_of_TF(f)) = f";
-by (etac forest_induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val forest_iso = result();
-
-goal TF_Fn.thy
- "!!ts. ts: list(tree(A)) ==> list_of_TF(TF_of_list(ts)) = ts";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val tree_list_iso = result();
-
-(** theorems about TF_map **)
-
-goal TF_Fn.thy "!!z A. z: tree_forest(A) ==> TF_map(%u.u, z) = z";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val TF_map_ident = result();
-
-goal TF_Fn.thy
- "!!z A. z: tree_forest(A) ==> TF_map(h, TF_map(j,z)) = TF_map(%u.h(j(u)), z)";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val TF_map_compose = result();
-
-(** theorems about TF_size **)
-
-goal TF_Fn.thy
- "!!z A. z: tree_forest(A) ==> TF_size(TF_map(h,z)) = TF_size(z)";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val TF_size_TF_map = result();
-
-goal TF_Fn.thy
- "!!z A. z: tree_forest(A) ==> TF_size(z) = length(TF_preorder(z))";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac (TF_ss addsimps [length_app])));
-val TF_size_length = result();
-
-(** theorems about TF_preorder **)
-
-goal TF_Fn.thy "!!z A. z: tree_forest(A) ==> \
-\ TF_preorder(TF_map(h,z)) = map(h, TF_preorder(z))";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac (TF_ss addsimps [map_app_distrib])));
-val TF_preorder_TF_map = result();
--- a/src/ZF/ex/TF_Fn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-(* Title: ZF/ex/TF.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Trees & forests, a mutually recursive type definition.
-*)
-
-TF_Fn = TF + ListFn +
-consts
- TF_rec :: "[i, [i,i,i]=>i, i, [i,i,i,i]=>i] => i"
- TF_map :: "[i=>i, i] => i"
- TF_size :: "i=>i"
- TF_preorder :: "i=>i"
- list_of_TF :: "i=>i"
- TF_of_list :: "i=>i"
-
-rules
- TF_rec_def
- "TF_rec(z,b,c,d) == Vrec(z, \
-\ %z r. tree_forest_case(%x f. b(x, f, r`f), \
-\ c, \
-\ %t f. d(t, f, r`t, r`f), z))"
-
- list_of_TF_def
- "list_of_TF(z) == TF_rec(z, %x f r. [Tcons(x,f)], [], \
-\ %t f r1 r2. Cons(t, r2))"
-
- TF_of_list_def
- "TF_of_list(f) == list_rec(f, Fnil, %t f r. Fcons(t,r))"
-
- TF_map_def
- "TF_map(h,z) == TF_rec(z, %x f r.Tcons(h(x),r), Fnil, \
-\ %t f r1 r2. Fcons(r1,r2))"
-
- TF_size_def
- "TF_size(z) == TF_rec(z, %x f r.succ(r), 0, %t f r1 r2. r1#+r2)"
-
- TF_preorder_def
- "TF_preorder(z) == TF_rec(z, %x f r.Cons(x,r), Nil, %t f r1 r2. r1@r2)"
-
-end
--- a/src/ZF/ex/TermFn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,186 +0,0 @@
-(* Title: ZF/ex/term
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Terms over a given alphabet -- function applications; illustrates list functor
- (essentially the same type as in Trees & Forests)
-*)
-
-writeln"File ZF/ex/term-fn.";
-
-open TermFn;
-
-(*** term_rec -- by Vset recursion ***)
-
-(*Lemma: map works correctly on the underlying list of terms*)
-val [major,ordi] = goal ListFn.thy
- "[| l: list(A); Ord(i) |] ==> \
-\ rank(l)<i --> map(%z. (lam x:Vset(i).h(x)) ` z, l) = map(h,l)";
-by (rtac (major RS List.induct) 1);
-by (simp_tac list_ss 1);
-by (rtac impI 1);
-by (forward_tac [rank_Cons1 RS lt_trans] 1);
-by (dtac (rank_Cons2 RS lt_trans) 1);
-by (asm_simp_tac (list_ss addsimps [ordi, VsetI]) 1);
-val map_lemma = result();
-
-(*Typing premise is necessary to invoke map_lemma*)
-val [prem] = goal TermFn.thy
- "ts: list(A) ==> \
-\ term_rec(Apply(a,ts), d) = d(a, ts, map (%z. term_rec(z,d), ts))";
-by (rtac (term_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Term.con_defs);
-val term_rec_ss = ZF_ss addsimps [Ord_rank, rank_pair2, prem RS map_lemma];
-by (simp_tac term_rec_ss 1);
-val term_rec = result();
-
-(*Slightly odd typing condition on r in the second premise!*)
-val major::prems = goal TermFn.thy
- "[| t: term(A); \
-\ !!x zs r. [| x: A; zs: list(term(A)); \
-\ r: list(UN t:term(A). C(t)) |] \
-\ ==> d(x, zs, r): C(Apply(x,zs)) \
-\ |] ==> term_rec(t,d) : C(t)";
-by (rtac (major RS Term.induct) 1);
-by (forward_tac [list_CollectD] 1);
-by (rtac (term_rec RS ssubst) 1);
-by (REPEAT (ares_tac prems 1));
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [term_rec])));
-by (etac CollectE 1);
-by (REPEAT (ares_tac [ConsI, UN_I] 1));
-val term_rec_type = result();
-
-val [rew,tslist] = goal TermFn.thy
- "[| !!t. j(t)==term_rec(t,d); ts: list(A) |] ==> \
-\ j(Apply(a,ts)) = d(a, ts, map(%Z.j(Z), ts))";
-by (rewtac rew);
-by (rtac (tslist RS term_rec) 1);
-val def_term_rec = result();
-
-val prems = goal TermFn.thy
- "[| t: term(A); \
-\ !!x zs r. [| x: A; zs: list(term(A)); r: list(C) |] \
-\ ==> d(x, zs, r): C \
-\ |] ==> term_rec(t,d) : C";
-by (REPEAT (ares_tac (term_rec_type::prems) 1));
-by (etac (subset_refl RS UN_least RS list_mono RS subsetD) 1);
-val term_rec_simple_type = result();
-
-
-(** term_map **)
-
-val term_map = standard (term_map_def RS def_term_rec);
-
-val prems = goalw TermFn.thy [term_map_def]
- "[| t: term(A); !!x. x: A ==> f(x): B |] ==> term_map(f,t) : term(B)";
-by (REPEAT (ares_tac ([term_rec_simple_type, ApplyI] @ prems) 1));
-val term_map_type = result();
-
-val [major] = goal TermFn.thy
- "t: term(A) ==> term_map(f,t) : term({f(u). u:A})";
-by (rtac (major RS term_map_type) 1);
-by (etac RepFunI 1);
-val term_map_type2 = result();
-
-
-(** term_size **)
-
-val term_size = standard (term_size_def RS def_term_rec);
-
-goalw TermFn.thy [term_size_def] "!!t A. t: term(A) ==> term_size(t) : nat";
-by (REPEAT (ares_tac [term_rec_simple_type, list_add_type, nat_succI] 1));
-val term_size_type = result();
-
-
-(** reflect **)
-
-val reflect = standard (reflect_def RS def_term_rec);
-
-goalw TermFn.thy [reflect_def] "!!t A. t: term(A) ==> reflect(t) : term(A)";
-by (REPEAT (ares_tac [term_rec_simple_type, rev_type, ApplyI] 1));
-val reflect_type = result();
-
-(** preorder **)
-
-val preorder = standard (preorder_def RS def_term_rec);
-
-goalw TermFn.thy [preorder_def]
- "!!t A. t: term(A) ==> preorder(t) : list(A)";
-by (REPEAT (ares_tac [term_rec_simple_type, ConsI, flat_type] 1));
-val preorder_type = result();
-
-
-(** Term simplification **)
-
-val term_typechecks =
- [ApplyI, term_map_type, term_map_type2, term_size_type, reflect_type,
- preorder_type];
-
-(*map_type2 and term_map_type2 instantiate variables*)
-val term_ss = list_ss
- addsimps [term_rec, term_map, term_size, reflect, preorder]
- setsolver type_auto_tac (list_typechecks@term_typechecks);
-
-
-(** theorems about term_map **)
-
-goal TermFn.thy "!!t A. t: term(A) ==> term_map(%u.u, t) = t";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_ident]) 1);
-val term_map_ident = result();
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> term_map(f, term_map(g,t)) = term_map(%u.f(g(u)), t)";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_compose]) 1);
-val term_map_compose = result();
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> term_map(f, reflect(t)) = reflect(term_map(f,t))";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [rev_map_distrib RS sym, map_compose]) 1);
-val term_map_reflect = result();
-
-
-(** theorems about term_size **)
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> term_size(term_map(f,t)) = term_size(t)";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_compose]) 1);
-val term_size_term_map = result();
-
-goal TermFn.thy "!!t A. t: term(A) ==> term_size(reflect(t)) = term_size(t)";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [rev_map_distrib RS sym, map_compose,
- list_add_rev]) 1);
-val term_size_reflect = result();
-
-goal TermFn.thy "!!t A. t: term(A) ==> term_size(t) = length(preorder(t))";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [length_flat, map_compose]) 1);
-val term_size_length = result();
-
-
-(** theorems about reflect **)
-
-goal TermFn.thy "!!t A. t: term(A) ==> reflect(reflect(t)) = t";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [rev_map_distrib, map_compose,
- map_ident, rev_rev_ident]) 1);
-val reflect_reflect_ident = result();
-
-
-(** theorems about preorder **)
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> preorder(term_map(f,t)) = map(f, preorder(t))";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_compose, map_flat]) 1);
-val preorder_term_map = result();
-
-(** preorder(reflect(t)) = rev(postorder(t)) **)
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/TermFn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
-(* Title: ZF/ex/term-fn.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Terms over an alphabet.
-Illustrates the list functor (essentially the same type as in Trees & Forests)
-*)
-
-TermFn = Term + ListFn +
-consts
- term_rec :: "[i, [i,i,i]=>i] => i"
- term_map :: "[i=>i, i] => i"
- term_size :: "i=>i"
- reflect :: "i=>i"
- preorder :: "i=>i"
-
-rules
- term_rec_def
- "term_rec(t,d) == \
-\ Vrec(t, %t g. term_case(%x zs. d(x, zs, map(%z.g`z, zs)), t))"
-
- term_map_def "term_map(f,t) == term_rec(t, %x zs rs. Apply(f(x), rs))"
-
- term_size_def "term_size(t) == term_rec(t, %x zs rs. succ(list_add(rs)))"
-
- reflect_def "reflect(t) == term_rec(t, %x zs rs. Apply(x, rev(rs)))"
-
- preorder_def "preorder(t) == term_rec(t, %x zs rs. Cons(x, flat(rs)))"
-
-end
--- a/src/ZF/ex/acc.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,64 +0,0 @@
-(* Title: ZF/ex/acc
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Inductive definition of acc(r)
-
-See Ch. Paulin-Mohring, Inductive Definitions in the System Coq.
-Research Report 92-49, LIP, ENS Lyon. Dec 1992.
-*)
-
-structure Acc = Inductive_Fun
- (val thy = WF.thy addconsts [(["acc"],"i=>i")]
- val rec_doms = [("acc", "field(r)")]
- val sintrs = ["[| r-``{a}: Pow(acc(r)); a: field(r) |] ==> a: acc(r)"]
- val monos = [Pow_mono]
- val con_defs = []
- val type_intrs = []
- val type_elims = []);
-
-goal Acc.thy "!!a b r. [| b: acc(r); <a,b>: r |] ==> a: acc(r)";
-by (etac Acc.elim 1);
-by (fast_tac ZF_cs 1);
-val acc_downward = result();
-
-val [major] = goal Acc.thy "field(r) <= acc(r) ==> wf(r)";
-by (rtac (major RS wfI2) 1);
-by (rtac subsetI 1);
-by (etac Acc.induct 1);
-by (etac (bspec RS mp) 1);
-by (resolve_tac Acc.intrs 1);
-by (assume_tac 2);
-by (ALLGOALS (fast_tac ZF_cs));
-val acc_wfI = result();
-
-goal ZF.thy "!!r A. field(r Int A*A) <= field(r) Int A";
-by (fast_tac ZF_cs 1);
-val field_Int_prodself = result();
-
-goal Acc.thy "wf(r Int (acc(r)*acc(r)))";
-by (rtac (field_Int_prodself RS wfI2) 1);
-by (rtac subsetI 1);
-by (etac IntE 1);
-by (etac Acc.induct 1);
-by (etac (bspec RS mp) 1);
-by (rtac IntI 1);
-by (assume_tac 1);
-by (resolve_tac Acc.intrs 1);
-by (assume_tac 2);
-by (ALLGOALS (fast_tac ZF_cs));
-val wf_acc_Int = result();
-
-val [major] = goal Acc.thy "wf(r) ==> field(r) <= acc(r)";
-by (rtac subsetI 1);
-by (etac (major RS wf_induct2) 1);
-by (rtac subset_refl 1);
-by (resolve_tac Acc.intrs 1);
-by (assume_tac 2);
-by (fast_tac ZF_cs 1);
-val acc_wfD = result();
-
-goal Acc.thy "wf(r) <-> field(r) <= acc(r)";
-by (EVERY1 [rtac iffI, etac acc_wfD, etac acc_wfI]);
-val wf_acc_iff = result();
--- a/src/ZF/ex/bin.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
-(* Title: ZF/ex/bin.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Datatype of binary integers
-*)
-
-(*Example of a datatype with an infix constructor*)
-structure Bin = Datatype_Fun
- (val thy = Univ.thy;
- val rec_specs =
- [("bin", "univ(0)",
- [(["Plus", "Minus"], "i"),
- (["op $$"], "[i,i]=>i")])];
- val rec_styp = "i";
- val ext = Some (Syntax.simple_sext [Infixl("$$", "[i,i] => i", 60)]);
- val sintrs =
- ["Plus : bin",
- "Minus : bin",
- "[| w: bin; b: bool |] ==> w$$b : bin"];
- val monos = [];
- val type_intrs = datatype_intrs @ [bool_into_univ];
- val type_elims = []);
-
-(*Perform induction on l, then prove the major premise using prems. *)
-fun bin_ind_tac a prems i =
- EVERY [res_inst_tac [("x",a)] Bin.induct i,
- rename_last_tac a ["1"] (i+3),
- ares_tac prems i];
-
--- a/src/ZF/ex/binfn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,450 +0,0 @@
-(* Title: ZF/ex/bin.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For bin.thy. Arithmetic on binary integers.
-*)
-
-open BinFn;
-
-
-(** bin_rec -- by Vset recursion **)
-
-goal BinFn.thy "bin_rec(Plus,a,b,h) = a";
-by (rtac (bin_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Bin.con_defs);
-by (simp_tac rank_ss 1);
-val bin_rec_Plus = result();
-
-goal BinFn.thy "bin_rec(Minus,a,b,h) = b";
-by (rtac (bin_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Bin.con_defs);
-by (simp_tac rank_ss 1);
-val bin_rec_Minus = result();
-
-goal BinFn.thy "bin_rec(w$$x,a,b,h) = h(w, x, bin_rec(w,a,b,h))";
-by (rtac (bin_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Bin.con_defs);
-by (simp_tac rank_ss 1);
-val bin_rec_Bcons = result();
-
-(*Type checking*)
-val prems = goal BinFn.thy
- "[| w: bin; \
-\ a: C(Plus); b: C(Minus); \
-\ !!w x r. [| w: bin; x: bool; r: C(w) |] ==> h(w,x,r): C(w$$x) \
-\ |] ==> bin_rec(w,a,b,h) : C(w)";
-by (bin_ind_tac "w" prems 1);
-by (ALLGOALS
- (asm_simp_tac (ZF_ss addsimps (prems@[bin_rec_Plus,bin_rec_Minus,
- bin_rec_Bcons]))));
-val bin_rec_type = result();
-
-(** Versions for use with definitions **)
-
-val [rew] = goal BinFn.thy
- "[| !!w. j(w)==bin_rec(w,a,b,h) |] ==> j(Plus) = a";
-by (rewtac rew);
-by (rtac bin_rec_Plus 1);
-val def_bin_rec_Plus = result();
-
-val [rew] = goal BinFn.thy
- "[| !!w. j(w)==bin_rec(w,a,b,h) |] ==> j(Minus) = b";
-by (rewtac rew);
-by (rtac bin_rec_Minus 1);
-val def_bin_rec_Minus = result();
-
-val [rew] = goal BinFn.thy
- "[| !!w. j(w)==bin_rec(w,a,b,h) |] ==> j(w$$x) = h(w,x,j(w))";
-by (rewtac rew);
-by (rtac bin_rec_Bcons 1);
-val def_bin_rec_Bcons = result();
-
-fun bin_recs def = map standard
- ([def] RL [def_bin_rec_Plus, def_bin_rec_Minus, def_bin_rec_Bcons]);
-
-(** Type checking **)
-
-val bin_typechecks0 = bin_rec_type :: Bin.intrs;
-
-goalw BinFn.thy [integ_of_bin_def]
- "!!w. w: bin ==> integ_of_bin(w) : integ";
-by (typechk_tac (bin_typechecks0@integ_typechecks@
- nat_typechecks@[bool_into_nat]));
-val integ_of_bin_type = result();
-
-goalw BinFn.thy [bin_succ_def]
- "!!w. w: bin ==> bin_succ(w) : bin";
-by (typechk_tac (bin_typechecks0@bool_typechecks));
-val bin_succ_type = result();
-
-goalw BinFn.thy [bin_pred_def]
- "!!w. w: bin ==> bin_pred(w) : bin";
-by (typechk_tac (bin_typechecks0@bool_typechecks));
-val bin_pred_type = result();
-
-goalw BinFn.thy [bin_minus_def]
- "!!w. w: bin ==> bin_minus(w) : bin";
-by (typechk_tac ([bin_pred_type]@bin_typechecks0@bool_typechecks));
-val bin_minus_type = result();
-
-goalw BinFn.thy [bin_add_def]
- "!!v w. [| v: bin; w: bin |] ==> bin_add(v,w) : bin";
-by (typechk_tac ([bin_succ_type,bin_pred_type]@bin_typechecks0@
- bool_typechecks@ZF_typechecks));
-val bin_add_type = result();
-
-goalw BinFn.thy [bin_mult_def]
- "!!v w. [| v: bin; w: bin |] ==> bin_mult(v,w) : bin";
-by (typechk_tac ([bin_minus_type,bin_add_type]@bin_typechecks0@
- bool_typechecks));
-val bin_mult_type = result();
-
-val bin_typechecks = bin_typechecks0 @
- [integ_of_bin_type, bin_succ_type, bin_pred_type,
- bin_minus_type, bin_add_type, bin_mult_type];
-
-val bin_ss = integ_ss
- addsimps([bool_1I, bool_0I,
- bin_rec_Plus, bin_rec_Minus, bin_rec_Bcons] @
- bin_recs integ_of_bin_def @ bool_simps @ bin_typechecks);
-
-val typechecks = bin_typechecks @ integ_typechecks @ nat_typechecks @
- [bool_subset_nat RS subsetD];
-
-(**** The carry/borrow functions, bin_succ and bin_pred ****)
-
-(** Lemmas **)
-
-goal Integ.thy
- "!!z v. [| z $+ v = z' $+ v'; \
-\ z: integ; z': integ; v: integ; v': integ; w: integ |] \
-\ ==> z $+ (v $+ w) = z' $+ (v' $+ w)";
-by (asm_simp_tac (integ_ss addsimps ([zadd_assoc RS sym])) 1);
-val zadd_assoc_cong = result();
-
-goal Integ.thy
- "!!z v w. [| z: integ; v: integ; w: integ |] \
-\ ==> z $+ (v $+ w) = v $+ (z $+ w)";
-by (REPEAT (ares_tac [zadd_commute RS zadd_assoc_cong] 1));
-val zadd_assoc_swap = result();
-
-val zadd_cong =
- read_instantiate_sg (sign_of Integ.thy) [("t","op $+")] subst_context2;
-
-val zadd_kill = (refl RS zadd_cong);
-val zadd_assoc_swap_kill = zadd_kill RSN (4, zadd_assoc_swap RS trans);
-
-(*Pushes 'constants' of the form $#m to the right -- LOOPS if two!*)
-val zadd_assoc_znat = standard (znat_type RS zadd_assoc_swap);
-
-goal Integ.thy
- "!!z w. [| z: integ; w: integ |] \
-\ ==> w $+ (z $+ (w $+ z)) = w $+ (w $+ (z $+ z))";
-by (REPEAT (ares_tac [zadd_kill, zadd_assoc_swap] 1));
-val zadd_swap_pairs = result();
-
-
-val carry_ss = bin_ss addsimps
- (bin_recs bin_succ_def @ bin_recs bin_pred_def);
-
-goal BinFn.thy
- "!!w. w: bin ==> integ_of_bin(bin_succ(w)) = $#1 $+ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac (carry_ss addsimps [zadd_0_right]) 1);
-by (simp_tac (carry_ss addsimps [zadd_zminus_inverse]) 1);
-by (etac boolE 1);
-by (ALLGOALS (asm_simp_tac (carry_ss addsimps [zadd_assoc])));
-by (REPEAT (ares_tac (zadd_swap_pairs::typechecks) 1));
-val integ_of_bin_succ = result();
-
-goal BinFn.thy
- "!!w. w: bin ==> integ_of_bin(bin_pred(w)) = $~ ($#1) $+ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac (carry_ss addsimps [zadd_0_right]) 1);
-by (simp_tac (carry_ss addsimps [zadd_zminus_inverse]) 1);
-by (etac boolE 1);
-by (ALLGOALS
- (asm_simp_tac
- (carry_ss addsimps [zadd_assoc RS sym,
- zadd_zminus_inverse, zadd_zminus_inverse2])));
-by (REPEAT (ares_tac ([zadd_commute, zadd_cong, refl]@typechecks) 1));
-val integ_of_bin_pred = result();
-
-(*These two results replace the definitions of bin_succ and bin_pred*)
-
-
-(*** bin_minus: (unary!) negation of binary integers ***)
-
-val bin_minus_ss =
- bin_ss addsimps (bin_recs bin_minus_def @
- [integ_of_bin_succ, integ_of_bin_pred]);
-
-goal BinFn.thy
- "!!w. w: bin ==> integ_of_bin(bin_minus(w)) = $~ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac (bin_minus_ss addsimps [zminus_0]) 1);
-by (simp_tac (bin_minus_ss addsimps [zadd_0_right]) 1);
-by (etac boolE 1);
-by (ALLGOALS
- (asm_simp_tac (bin_minus_ss addsimps [zminus_zadd_distrib, zadd_assoc])));
-val integ_of_bin_minus = result();
-
-
-(*** bin_add: binary addition ***)
-
-goalw BinFn.thy [bin_add_def] "!!w. w: bin ==> bin_add(Plus,w) = w";
-by (asm_simp_tac bin_ss 1);
-val bin_add_Plus = result();
-
-goalw BinFn.thy [bin_add_def] "!!w. w: bin ==> bin_add(Minus,w) = bin_pred(w)";
-by (asm_simp_tac bin_ss 1);
-val bin_add_Minus = result();
-
-goalw BinFn.thy [bin_add_def] "bin_add(v$$x,Plus) = v$$x";
-by (simp_tac bin_ss 1);
-val bin_add_Bcons_Plus = result();
-
-goalw BinFn.thy [bin_add_def] "bin_add(v$$x,Minus) = bin_pred(v$$x)";
-by (simp_tac bin_ss 1);
-val bin_add_Bcons_Minus = result();
-
-goalw BinFn.thy [bin_add_def]
- "!!w y. [| w: bin; y: bool |] ==> \
-\ bin_add(v$$x, w$$y) = \
-\ bin_add(v, cond(x and y, bin_succ(w), w)) $$ (x xor y)";
-by (asm_simp_tac bin_ss 1);
-val bin_add_Bcons_Bcons = result();
-
-val bin_add_rews = [bin_add_Plus, bin_add_Minus, bin_add_Bcons_Plus,
- bin_add_Bcons_Minus, bin_add_Bcons_Bcons,
- integ_of_bin_succ, integ_of_bin_pred];
-
-val bin_add_ss = bin_ss addsimps ([bool_subset_nat RS subsetD] @ bin_add_rews);
-
-goal BinFn.thy
- "!!v. v: bin ==> \
-\ ALL w: bin. integ_of_bin(bin_add(v,w)) = \
-\ integ_of_bin(v) $+ integ_of_bin(w)";
-by (etac Bin.induct 1);
-by (simp_tac bin_add_ss 1);
-by (simp_tac bin_add_ss 1);
-by (rtac ballI 1);
-by (bin_ind_tac "wa" [] 1);
-by (asm_simp_tac (bin_add_ss addsimps [zadd_0_right]) 1);
-by (asm_simp_tac bin_add_ss 1);
-by (REPEAT (ares_tac (zadd_commute::typechecks) 1));
-by (etac boolE 1);
-by (asm_simp_tac (bin_add_ss addsimps [zadd_assoc, zadd_swap_pairs]) 2);
-by (REPEAT (ares_tac ([refl, zadd_kill, zadd_assoc_swap_kill]@typechecks) 2));
-by (etac boolE 1);
-by (ALLGOALS (asm_simp_tac (bin_add_ss addsimps [zadd_assoc,zadd_swap_pairs])));
-by (REPEAT (ares_tac ([refl, zadd_kill, zadd_assoc_swap_kill RS sym]@
- typechecks) 1));
-val integ_of_bin_add_lemma = result();
-
-val integ_of_bin_add = integ_of_bin_add_lemma RS bspec;
-
-
-(*** bin_add: binary multiplication ***)
-
-val bin_mult_ss =
- bin_ss addsimps (bin_recs bin_mult_def @
- [integ_of_bin_minus, integ_of_bin_add]);
-
-
-val major::prems = goal BinFn.thy
- "[| v: bin; w: bin |] ==> \
-\ integ_of_bin(bin_mult(v,w)) = \
-\ integ_of_bin(v) $* integ_of_bin(w)";
-by (cut_facts_tac prems 1);
-by (bin_ind_tac "v" [major] 1);
-by (asm_simp_tac (bin_mult_ss addsimps [zmult_0]) 1);
-by (asm_simp_tac (bin_mult_ss addsimps [zmult_1,zmult_zminus]) 1);
-by (etac boolE 1);
-by (asm_simp_tac (bin_mult_ss addsimps [zadd_zmult_distrib]) 2);
-by (asm_simp_tac
- (bin_mult_ss addsimps [zadd_zmult_distrib, zmult_1, zadd_assoc]) 1);
-by (REPEAT (ares_tac ([zadd_commute, zadd_assoc_swap_kill RS sym]@
- typechecks) 1));
-val integ_of_bin_mult = result();
-
-(**** Computations ****)
-
-(** extra rules for bin_succ, bin_pred **)
-
-val [bin_succ_Plus, bin_succ_Minus, _] = bin_recs bin_succ_def;
-val [bin_pred_Plus, bin_pred_Minus, _] = bin_recs bin_pred_def;
-
-goal BinFn.thy "bin_succ(w$$1) = bin_succ(w) $$ 0";
-by (simp_tac carry_ss 1);
-val bin_succ_Bcons1 = result();
-
-goal BinFn.thy "bin_succ(w$$0) = w$$1";
-by (simp_tac carry_ss 1);
-val bin_succ_Bcons0 = result();
-
-goal BinFn.thy "bin_pred(w$$1) = w$$0";
-by (simp_tac carry_ss 1);
-val bin_pred_Bcons1 = result();
-
-goal BinFn.thy "bin_pred(w$$0) = bin_pred(w) $$ 1";
-by (simp_tac carry_ss 1);
-val bin_pred_Bcons0 = result();
-
-(** extra rules for bin_minus **)
-
-val [bin_minus_Plus, bin_minus_Minus, _] = bin_recs bin_minus_def;
-
-goal BinFn.thy "bin_minus(w$$1) = bin_pred(bin_minus(w) $$ 0)";
-by (simp_tac bin_minus_ss 1);
-val bin_minus_Bcons1 = result();
-
-goal BinFn.thy "bin_minus(w$$0) = bin_minus(w) $$ 0";
-by (simp_tac bin_minus_ss 1);
-val bin_minus_Bcons0 = result();
-
-(** extra rules for bin_add **)
-
-goal BinFn.thy
- "!!w. w: bin ==> bin_add(v$$1, w$$1) = bin_add(v, bin_succ(w)) $$ 0";
-by (asm_simp_tac bin_add_ss 1);
-val bin_add_Bcons_Bcons11 = result();
-
-goal BinFn.thy
- "!!w. w: bin ==> bin_add(v$$1, w$$0) = bin_add(v,w) $$ 1";
-by (asm_simp_tac bin_add_ss 1);
-val bin_add_Bcons_Bcons10 = result();
-
-goal BinFn.thy
- "!!w y.[| w: bin; y: bool |] ==> bin_add(v$$0, w$$y) = bin_add(v,w) $$ y";
-by (asm_simp_tac bin_add_ss 1);
-val bin_add_Bcons_Bcons0 = result();
-
-(** extra rules for bin_mult **)
-
-val [bin_mult_Plus, bin_mult_Minus, _] = bin_recs bin_mult_def;
-
-goal BinFn.thy "bin_mult(v$$1, w) = bin_add(bin_mult(v,w)$$0, w)";
-by (simp_tac bin_mult_ss 1);
-val bin_mult_Bcons1 = result();
-
-goal BinFn.thy "bin_mult(v$$0, w) = bin_mult(v,w)$$0";
-by (simp_tac bin_mult_ss 1);
-val bin_mult_Bcons0 = result();
-
-
-(*** The computation simpset ***)
-
-val bin_comp_ss = integ_ss
- addsimps [bin_succ_Plus, bin_succ_Minus,
- bin_succ_Bcons1, bin_succ_Bcons0,
- bin_pred_Plus, bin_pred_Minus,
- bin_pred_Bcons1, bin_pred_Bcons0,
- bin_minus_Plus, bin_minus_Minus,
- bin_minus_Bcons1, bin_minus_Bcons0,
- bin_add_Plus, bin_add_Minus, bin_add_Bcons_Plus,
- bin_add_Bcons_Minus, bin_add_Bcons_Bcons0,
- bin_add_Bcons_Bcons10, bin_add_Bcons_Bcons11,
- bin_mult_Plus, bin_mult_Minus,
- bin_mult_Bcons1, bin_mult_Bcons0]
- setsolver (type_auto_tac ([bool_1I, bool_0I] @ bin_typechecks0));
-
-(*** Examples of performing binary arithmetic by simplification ***)
-
-proof_timing := true;
-(*All runtimes below are on a SPARCserver 10*)
-
-(* 13+19 = 32 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$1$$0$$1, Plus$$1$$0$$0$$1$$1) = Plus$$1$$0$$0$$0$$0$$0";
-by (simp_tac bin_comp_ss 1); (*0.6 secs*)
-result();
-
-bin_add(binary_of_int 13, binary_of_int 19);
-
-(* 1234+5678 = 6912 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$0$$0$$1$$1$$0$$1$$0$$0$$1$$0, \
-\ Plus$$1$$0$$1$$1$$0$$0$$0$$1$$0$$1$$1$$1$$0) = \
-\ Plus$$1$$1$$0$$1$$1$$0$$0$$0$$0$$0$$0$$0$$0";
-by (simp_tac bin_comp_ss 1); (*2.6 secs*)
-result();
-
-bin_add(binary_of_int 1234, binary_of_int 5678);
-
-(* 1359-2468 = ~1109 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$0$$1$$0$$1$$0$$0$$1$$1$$1$$1, \
-\ Minus$$0$$1$$1$$0$$0$$1$$0$$1$$1$$1$$0$$0) = \
-\ Minus$$1$$0$$1$$1$$1$$0$$1$$0$$1$$0$$1$$1";
-by (simp_tac bin_comp_ss 1); (*2.3 secs*)
-result();
-
-bin_add(binary_of_int 1359, binary_of_int ~2468);
-
-(* 93746-46375 = 47371 *)
-goal BinFn.thy
- "bin_add(Plus$$1$$0$$1$$1$$0$$1$$1$$1$$0$$0$$0$$1$$1$$0$$0$$1$$0, \
-\ Minus$$0$$1$$0$$0$$1$$0$$1$$0$$1$$1$$0$$1$$1$$0$$0$$1) = \
-\ Plus$$0$$1$$0$$1$$1$$1$$0$$0$$1$$0$$0$$0$$0$$1$$0$$1$$1";
-by (simp_tac bin_comp_ss 1); (*3.9 secs*)
-result();
-
-bin_add(binary_of_int 93746, binary_of_int ~46375);
-
-(* negation of 65745 *)
-goal BinFn.thy
- "bin_minus(Plus$$1$$0$$0$$0$$0$$0$$0$$0$$0$$1$$1$$0$$1$$0$$0$$0$$1) = \
-\ Minus$$0$$1$$1$$1$$1$$1$$1$$1$$1$$0$$0$$1$$0$$1$$1$$1$$1";
-by (simp_tac bin_comp_ss 1); (*0.6 secs*)
-result();
-
-bin_minus(binary_of_int 65745);
-
-(* negation of ~54321 *)
-goal BinFn.thy
- "bin_minus(Minus$$0$$0$$1$$0$$1$$0$$1$$1$$1$$1$$0$$0$$1$$1$$1$$1) = \
-\ Plus$$0$$1$$1$$0$$1$$0$$1$$0$$0$$0$$0$$1$$1$$0$$0$$0$$1";
-by (simp_tac bin_comp_ss 1); (*0.7 secs*)
-result();
-
-bin_minus(binary_of_int ~54321);
-
-(* 13*19 = 247 *)
-goal BinFn.thy "bin_mult(Plus$$1$$1$$0$$1, Plus$$1$$0$$0$$1$$1) = \
-\ Plus$$1$$1$$1$$1$$0$$1$$1$$1";
-by (simp_tac bin_comp_ss 1); (*1.5 secs*)
-result();
-
-bin_mult(binary_of_int 13, binary_of_int 19);
-
-(* ~84 * 51 = ~4284 *)
-goal BinFn.thy
- "bin_mult(Minus$$0$$1$$0$$1$$1$$0$$0, Plus$$1$$1$$0$$0$$1$$1) = \
-\ Minus$$0$$1$$1$$1$$1$$0$$1$$0$$0$$0$$1$$0$$0";
-by (simp_tac bin_comp_ss 1); (*2.6 secs*)
-result();
-
-bin_mult(binary_of_int ~84, binary_of_int 51);
-
-(* 255*255 = 65025; the worst case for 8-bit operands *)
-goal BinFn.thy
- "bin_mult(Plus$$1$$1$$1$$1$$1$$1$$1$$1, \
-\ Plus$$1$$1$$1$$1$$1$$1$$1$$1) = \
-\ Plus$$1$$1$$1$$1$$1$$1$$1$$0$$0$$0$$0$$0$$0$$0$$0$$1";
-by (simp_tac bin_comp_ss 1); (*9.8 secs*)
-result();
-
-bin_mult(binary_of_int 255, binary_of_int 255);
-
-(* 1359 * ~2468 = ~3354012 *)
-goal BinFn.thy
- "bin_mult(Plus$$1$$0$$1$$0$$1$$0$$0$$1$$1$$1$$1, \
-\ Minus$$0$$1$$1$$0$$0$$1$$0$$1$$1$$1$$0$$0) = \
-\ Minus$$0$$0$$1$$1$$0$$0$$1$$1$$0$$1$$0$$0$$1$$0$$0$$1$$1$$0$$0$$1$$0$$0";
-by (simp_tac bin_comp_ss 1); (*13.7 secs*)
-result();
-
-bin_mult(binary_of_int 1359, binary_of_int ~2468);
--- a/src/ZF/ex/binfn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,52 +0,0 @@
-(* Title: ZF/bin
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Arithmetic on binary integers.
-*)
-
-BinFn = Integ + Bin +
-consts
- bin_rec :: "[i, i, i, [i,i,i]=>i] => i"
- integ_of_bin :: "i=>i"
- bin_succ :: "i=>i"
- bin_pred :: "i=>i"
- bin_minus :: "i=>i"
- bin_add,bin_mult :: "[i,i]=>i"
-
-rules
-
- bin_rec_def
- "bin_rec(z,a,b,h) == \
-\ Vrec(z, %z g. bin_case(a, b, %w x. h(w, x, g`w), z))"
-
- integ_of_bin_def
- "integ_of_bin(w) == bin_rec(w, $#0, $~($#1), %w x r. $#x $+ r $+ r)"
-
- bin_succ_def
- "bin_succ(w0) == bin_rec(w0, Plus$$1, Plus, %w x r. cond(x, r$$0, w$$1))"
-
- bin_pred_def
- "bin_pred(w0) == \
-\ bin_rec(w0, Minus, Minus$$0, %w x r. cond(x, w$$0, r$$1))"
-
- bin_minus_def
- "bin_minus(w0) == \
-\ bin_rec(w0, Plus, Plus$$1, %w x r. cond(x, bin_pred(r$$0), r$$0))"
-
- bin_add_def
- "bin_add(v0,w0) == \
-\ bin_rec(v0, \
-\ lam w:bin. w, \
-\ lam w:bin. bin_pred(w), \
-\ %v x r. lam w1:bin. \
-\ bin_rec(w1, v$$x, bin_pred(v$$x), \
-\ %w y s. (r`cond(x and y, bin_succ(w), w)) \
-\ $$ (x xor y))) ` w0"
-
- bin_mult_def
- "bin_mult(v0,w) == \
-\ bin_rec(v0, Plus, bin_minus(w), \
-\ %v x r. cond(x, bin_add(r$$0,w), r$$0))"
-end
--- a/src/ZF/ex/bt.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-(* Title: ZF/ex/bt.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Datatype definition of binary trees
-*)
-
-structure BT = Datatype_Fun
- (val thy = Univ.thy;
- val rec_specs =
- [("bt", "univ(A)",
- [(["Lf"],"i"), (["Br"],"[i,i,i]=>i")])];
- val rec_styp = "i=>i";
- val ext = None
- val sintrs =
- ["Lf : bt(A)",
- "[| a: A; t1: bt(A); t2: bt(A) |] ==> Br(a,t1,t2) : bt(A)"];
- val monos = [];
- val type_intrs = datatype_intrs
- val type_elims = []);
-
-val [LfI, BrI] = BT.intrs;
-
-(*Perform induction on l, then prove the major premise using prems. *)
-fun bt_ind_tac a prems i =
- EVERY [res_inst_tac [("x",a)] BT.induct i,
- rename_last_tac a ["1","2"] (i+2),
- ares_tac prems i];
-
-
-(** Lemmas to justify using "bt" in other recursive type definitions **)
-
-goalw BT.thy BT.defs "!!A B. A<=B ==> bt(A) <= bt(B)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac BT.bnd_mono 1));
-by (REPEAT (ares_tac (univ_mono::basic_monos) 1));
-val bt_mono = result();
-
-goalw BT.thy (BT.defs@BT.con_defs) "bt(univ(A)) <= univ(A)";
-by (rtac lfp_lowerbound 1);
-by (rtac (A_subset_univ RS univ_mono) 2);
-by (fast_tac (ZF_cs addSIs [zero_in_univ, Inl_in_univ, Inr_in_univ,
- Pair_in_univ]) 1);
-val bt_univ = result();
-
-val bt_subset_univ = standard ([bt_mono, bt_univ] MRS subset_trans);
-
--- a/src/ZF/ex/bt_fn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,128 +0,0 @@
-(* Title: ZF/bt.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For bt.thy. Binary trees
-*)
-
-open BT_Fn;
-
-
-
-(** bt_rec -- by Vset recursion **)
-
-goalw BT.thy BT.con_defs "rank(l) < rank(Br(a,l,r))";
-by (simp_tac rank_ss 1);
-val rank_Br1 = result();
-
-goalw BT.thy BT.con_defs "rank(r) < rank(Br(a,l,r))";
-by (simp_tac rank_ss 1);
-val rank_Br2 = result();
-
-goal BT_Fn.thy "bt_rec(Lf,c,h) = c";
-by (rtac (bt_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (ZF_ss addsimps BT.case_eqns) 1);
-val bt_rec_Lf = result();
-
-goal BT_Fn.thy
- "bt_rec(Br(a,l,r), c, h) = h(a, l, r, bt_rec(l,c,h), bt_rec(r,c,h))";
-by (rtac (bt_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (rank_ss addsimps (BT.case_eqns @ [rank_Br1, rank_Br2])) 1);
-val bt_rec_Br = result();
-
-(*Type checking -- proved by induction, as usual*)
-val prems = goal BT_Fn.thy
- "[| t: bt(A); \
-\ c: C(Lf); \
-\ !!x y z r s. [| x:A; y:bt(A); z:bt(A); r:C(y); s:C(z) |] ==> \
-\ h(x,y,z,r,s): C(Br(x,y,z)) \
-\ |] ==> bt_rec(t,c,h) : C(t)";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps
- (prems@[bt_rec_Lf,bt_rec_Br]))));
-val bt_rec_type = result();
-
-(** Versions for use with definitions **)
-
-val [rew] = goal BT_Fn.thy "[| !!t. j(t)==bt_rec(t, c, h) |] ==> j(Lf) = c";
-by (rewtac rew);
-by (rtac bt_rec_Lf 1);
-val def_bt_rec_Lf = result();
-
-val [rew] = goal BT_Fn.thy
- "[| !!t. j(t)==bt_rec(t, c, h) |] ==> j(Br(a,l,r)) = h(a,l,r,j(l),j(r))";
-by (rewtac rew);
-by (rtac bt_rec_Br 1);
-val def_bt_rec_Br = result();
-
-fun bt_recs def = map standard ([def] RL [def_bt_rec_Lf, def_bt_rec_Br]);
-
-(** n_nodes **)
-
-val [n_nodes_Lf,n_nodes_Br] = bt_recs n_nodes_def;
-
-val prems = goalw BT_Fn.thy [n_nodes_def]
- "xs: bt(A) ==> n_nodes(xs) : nat";
-by (REPEAT (ares_tac (prems @ [bt_rec_type, nat_0I, nat_succI, add_type]) 1));
-val n_nodes_type = result();
-
-
-(** n_leaves **)
-
-val [n_leaves_Lf,n_leaves_Br] = bt_recs n_leaves_def;
-
-val prems = goalw BT_Fn.thy [n_leaves_def]
- "xs: bt(A) ==> n_leaves(xs) : nat";
-by (REPEAT (ares_tac (prems @ [bt_rec_type, nat_0I, nat_succI, add_type]) 1));
-val n_leaves_type = result();
-
-(** bt_reflect **)
-
-val [bt_reflect_Lf, bt_reflect_Br] = bt_recs bt_reflect_def;
-
-val prems = goalw BT_Fn.thy [bt_reflect_def]
- "xs: bt(A) ==> bt_reflect(xs) : bt(A)";
-by (REPEAT (ares_tac (prems @ [bt_rec_type, LfI, BrI]) 1));
-val bt_reflect_type = result();
-
-
-(** BT_Fn simplification **)
-
-
-val bt_typechecks =
- [LfI, BrI, bt_rec_type, n_nodes_type, n_leaves_type, bt_reflect_type];
-
-val bt_ss = arith_ss
- addsimps BT.case_eqns
- addsimps bt_typechecks
- addsimps [bt_rec_Lf, bt_rec_Br,
- n_nodes_Lf, n_nodes_Br,
- n_leaves_Lf, n_leaves_Br,
- bt_reflect_Lf, bt_reflect_Br];
-
-
-(*** theorems about n_leaves ***)
-
-val prems = goal BT_Fn.thy
- "t: bt(A) ==> n_leaves(bt_reflect(t)) = n_leaves(t)";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac bt_ss));
-by (REPEAT (ares_tac [add_commute, n_leaves_type] 1));
-val n_leaves_reflect = result();
-
-val prems = goal BT_Fn.thy
- "t: bt(A) ==> n_leaves(t) = succ(n_nodes(t))";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac (bt_ss addsimps [add_succ_right])));
-val n_leaves_nodes = result();
-
-(*** theorems about bt_reflect ***)
-
-val prems = goal BT_Fn.thy
- "t: bt(A) ==> bt_reflect(bt_reflect(t))=t";
-by (bt_ind_tac "t" prems 1);
-by (ALLGOALS (asm_simp_tac bt_ss));
-val bt_reflect_bt_reflect_ident = result();
-
-
--- a/src/ZF/ex/bt_fn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,24 +0,0 @@
-(* Title: ZF/ex/bt-fn.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Binary trees
-*)
-
-BT_Fn = BT +
-consts
- bt_rec :: "[i, i, [i,i,i,i,i]=>i] => i"
- n_nodes :: "i=>i"
- n_leaves :: "i=>i"
- bt_reflect :: "i=>i"
-
-rules
- bt_rec_def
- "bt_rec(t,c,h) == Vrec(t, %t g.bt_case(c, %x y z. h(x,y,z,g`y,g`z), t))"
-
- n_nodes_def "n_nodes(t) == bt_rec(t, 0, %x y z r s. succ(r#+s))"
- n_leaves_def "n_leaves(t) == bt_rec(t, succ(0), %x y z r s. r#+s)"
- bt_reflect_def "bt_reflect(t) == bt_rec(t, Lf, %x y z r s. Br(x,s,r))"
-
-end
--- a/src/ZF/ex/comb.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-(* Title: ZF/ex/comb.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Datatype definition of combinators S and K
-
-J. Camilleri and T. F. Melham.
-Reasoning with Inductively Defined Relations in the HOL Theorem Prover.
-Report 265, University of Cambridge Computer Laboratory, 1992.
-*)
-
-
-(*Example of a datatype with mixfix syntax for some constructors*)
-structure Comb = Datatype_Fun
- (val thy = Univ.thy;
- val rec_specs =
- [("comb", "univ(0)",
- [(["K","S"], "i"),
- (["op #"], "[i,i]=>i")])];
- val rec_styp = "i";
- val ext = Some (Syntax.simple_sext [Infixl("#", "[i,i] => i", 90)]);
- val sintrs =
- ["K : comb",
- "S : comb",
- "[| p: comb; q: comb |] ==> p#q : comb"];
- val monos = [];
- val type_intrs = datatype_intrs;
- val type_elims = []);
-
-val [K_comb,S_comb,Ap_comb] = Comb.intrs;
-
-val Ap_E = Comb.mk_cases Comb.con_defs "p#q : comb";
-
--- a/src/ZF/ex/contract0.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,117 +0,0 @@
-(* Title: ZF/ex/contract.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-For ex/contract.thy.
-*)
-
-open Contract0;
-
-structure Contract = Inductive_Fun
- (val thy = Contract0.thy;
- val rec_doms = [("contract","comb*comb")];
- val sintrs =
- ["[| p:comb; q:comb |] ==> K#p#q -1-> p",
- "[| p:comb; q:comb; r:comb |] ==> S#p#q#r -1-> (p#r)#(q#r)",
- "[| p-1->q; r:comb |] ==> p#r -1-> q#r",
- "[| p-1->q; r:comb |] ==> r#p -1-> r#q"];
- val monos = [];
- val con_defs = [];
- val type_intrs = Comb.intrs@[SigmaI];
- val type_elims = [SigmaE2]);
-
-val [K_contract,S_contract,Ap_contract1,Ap_contract2] = Contract.intrs;
-
-val contract_induct = standard
- (Contract.mutual_induct RS spec RS spec RSN (2,rev_mp));
-
-(*For type checking: replaces a-1->b by a,b:comb *)
-val contract_combE2 = Contract.dom_subset RS subsetD RS SigmaE2;
-val contract_combD1 = Contract.dom_subset RS subsetD RS SigmaD1;
-val contract_combD2 = Contract.dom_subset RS subsetD RS SigmaD2;
-
-goal Contract.thy "field(contract) = comb";
-by (fast_tac (ZF_cs addIs [equalityI,K_contract] addSEs [contract_combE2]) 1);
-val field_contract_eq = result();
-
-val reduction_refl = standard
- (field_contract_eq RS equalityD2 RS subsetD RS rtrancl_refl);
-
-val rtrancl_into_rtrancl2 = standard
- (r_into_rtrancl RS (trans_rtrancl RS transD));
-
-val reduction_rls = [reduction_refl, K_contract, S_contract,
- K_contract RS rtrancl_into_rtrancl2,
- S_contract RS rtrancl_into_rtrancl2,
- Ap_contract1 RS rtrancl_into_rtrancl2,
- Ap_contract2 RS rtrancl_into_rtrancl2];
-
-goalw Contract.thy [I_def] "!!p. p:comb ==> I#p ---> p";
-by (REPEAT (ares_tac (Comb.intrs @ reduction_rls) 1));
-val I_reduce = result();
-
-goalw Contract.thy [I_def] "I: comb";
-by (REPEAT (ares_tac Comb.intrs 1));
-val I_comb = result();
-
-(** Non-contraction results **)
-
-(*Derive a case for each combinator constructor*)
-val K_contract_case = Contract.mk_cases Comb.con_defs "K -1-> r";
-val S_contract_case = Contract.mk_cases Comb.con_defs "S -1-> r";
-val Ap_contract_case = Contract.mk_cases Comb.con_defs "p#q -1-> r";
-
-val contract_cs =
- ZF_cs addSIs Comb.intrs
- addIs Contract.intrs
- addSEs [contract_combD1,contract_combD2] (*type checking*)
- addSEs [K_contract_case, S_contract_case, Ap_contract_case]
- addSEs Comb.free_SEs;
-
-goalw Contract.thy [I_def] "!!r. I -1-> r ==> P";
-by (fast_tac contract_cs 1);
-val I_contract_case = result();
-
-goal Contract.thy "!!p r. K#p -1-> r ==> (EX q. r = K#q & p -1-> q)";
-by (fast_tac contract_cs 1);
-val K1_contractD = result();
-
-goal Contract.thy "!!p r. [| p ---> q; r: comb |] ==> p#r ---> q#r";
-by (forward_tac [rtrancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_contract_eq RS equalityD1 RS subsetD) 1);
-by (etac rtrancl_induct 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (etac (trans_rtrancl RS transD) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-val Ap_reduce1 = result();
-
-goal Contract.thy "!!p r. [| p ---> q; r: comb |] ==> r#p ---> r#q";
-by (forward_tac [rtrancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_contract_eq RS equalityD1 RS subsetD) 1);
-by (etac rtrancl_induct 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (etac (trans_rtrancl RS transD) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-val Ap_reduce2 = result();
-
-(** Counterexample to the diamond property for -1-> **)
-
-goal Contract.thy "K#I#(I#I) -1-> I";
-by (REPEAT (ares_tac [K_contract, I_comb, Ap_comb] 1));
-val KIII_contract1 = result();
-
-goalw Contract.thy [I_def] "K#I#(I#I) -1-> K#I#((K#I)#(K#I))";
-by (DEPTH_SOLVE (resolve_tac (Comb.intrs @ Contract.intrs) 1));
-val KIII_contract2 = result();
-
-goal Contract.thy "K#I#((K#I)#(K#I)) -1-> I";
-by (REPEAT (ares_tac (Comb.intrs @ [K_contract, I_comb]) 1));
-val KIII_contract3 = result();
-
-goalw Contract.thy [diamond_def] "~ diamond(contract)";
-by (fast_tac (ZF_cs addIs [KIII_contract1,KIII_contract2,KIII_contract3]
- addSEs [I_contract_case]) 1);
-val not_diamond_contract = result();
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/contract0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,36 +0,0 @@
-(* Title: ZF/ex/contract.thy
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Inductive definition of (1-step) contractions and (mult-step) reductions
-*)
-
-Contract0 = Comb +
-consts
- diamond :: "i => o"
- I :: "i"
-
- contract :: "i"
- "-1->" :: "[i,i] => o" (infixl 50)
- "--->" :: "[i,i] => o" (infixl 50)
-
- parcontract :: "i"
- "=1=>" :: "[i,i] => o" (infixl 50)
- "===>" :: "[i,i] => o" (infixl 50)
-
-translations
- "p -1-> q" == "<p,q> : contract"
- "p ---> q" == "<p,q> : contract^*"
- "p =1=> q" == "<p,q> : parcontract"
- "p ===> q" == "<p,q> : parcontract^+"
-
-rules
-
- diamond_def "diamond(r) == ALL x y. <x,y>:r --> \
-\ (ALL y'. <x,y'>:r --> \
-\ (EX z. <y,z>:r & <y',z> : r))"
-
- I_def "I == S#K#K"
-
-end
--- a/src/ZF/ex/counit.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,109 +0,0 @@
-(* Title: ZF/ex/counit.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Trivial codatatype definitions, one of which goes wrong!
-
-Need to find sufficient conditions for codatatypes to work correctly!
-*)
-
-(*This degenerate definition does not work well because the one constructor's
- definition is trivial! The same thing occurs with Aczel's Special Final
- Coalgebra Theorem
-*)
-structure CoUnit = CoDatatype_Fun
- (val thy = QUniv.thy;
- val rec_specs =
- [("counit", "quniv(0)",
- [(["Con"], "i=>i")])];
- val rec_styp = "i";
- val ext = None
- val sintrs = ["x: counit ==> Con(x) : counit"];
- val monos = [];
- val type_intrs = codatatype_intrs
- val type_elims = codatatype_elims);
-
-val [ConI] = CoUnit.intrs;
-
-(*USELESS because folding on Con(?xa) == ?xa fails*)
-val ConE = CoUnit.mk_cases CoUnit.con_defs "Con(x) : counit";
-
-(*Proving freeness results*)
-val Con_iff = CoUnit.mk_free "Con(x)=Con(y) <-> x=y";
-
-(*Should be a singleton, not everything!*)
-goal CoUnit.thy "counit = quniv(0)";
-by (rtac (CoUnit.dom_subset RS equalityI) 1);
-by (rtac subsetI 1);
-by (etac CoUnit.coinduct 1);
-by (rtac subset_refl 1);
-by (rewrite_goals_tac CoUnit.con_defs);
-by (fast_tac ZF_cs 1);
-val counit_eq_univ = result();
-
-
-(*****************************************************************)
-
-(*A similar example, but the constructor is non-degenerate and it works!
- The resulting set is a singleton.
-*)
-
-structure CoUnit2 = CoDatatype_Fun
- (val thy = QUniv.thy;
- val rec_specs =
- [("counit2", "quniv(0)",
- [(["Con2"], "[i,i]=>i")])];
- val rec_styp = "i";
- val ext = None
- val sintrs = ["[| x: counit2; y: counit2 |] ==> Con2(x,y) : counit2"];
- val monos = [];
- val type_intrs = codatatype_intrs
- val type_elims = codatatype_elims);
-
-val [Con2I] = CoUnit2.intrs;
-
-val Con2E = CoUnit2.mk_cases CoUnit2.con_defs "Con2(x,y) : counit2";
-
-(*Proving freeness results*)
-val Con2_iff = CoUnit2.mk_free "Con2(x,y)=Con2(x',y') <-> x=x' & y=y'";
-
-goalw CoUnit2.thy CoUnit2.con_defs "bnd_mono(univ(0), %x. Con2(x,x))";
-by (rtac bnd_monoI 1);
-by (REPEAT (ares_tac [subset_refl, QPair_subset_univ, QPair_mono] 1));
-val Con2_bnd_mono = result();
-
-goal CoUnit2.thy "lfp(univ(0), %x. Con2(x,x)) : counit2";
-by (rtac (singletonI RS CoUnit2.coinduct) 1);
-by (rtac (qunivI RS singleton_subsetI) 1);
-by (rtac ([lfp_subset, empty_subsetI RS univ_mono] MRS subset_trans) 1);
-by (fast_tac (ZF_cs addSIs [Con2_bnd_mono RS lfp_Tarski]) 1);
-val lfp_Con2_in_counit2 = result();
-
-(*Lemma for proving finality. Borrowed from ex/llist_eq.ML!*)
-goal CoUnit2.thy
- "!!i. Ord(i) ==> ALL x y. x: counit2 & y: counit2 --> x Int Vset(i) <= y";
-by (etac trans_induct 1);
-by (safe_tac subset_cs);
-by (etac CoUnit2.elim 1);
-by (etac CoUnit2.elim 1);
-by (rewrite_goals_tac CoUnit2.con_defs);
-by (fast_tac lleq_cs 1);
-val counit2_Int_Vset_subset_lemma = result();
-
-val counit2_Int_Vset_subset = standard
- (counit2_Int_Vset_subset_lemma RS spec RS spec RS mp);
-
-goal CoUnit2.thy "!!x y. [| x: counit2; y: counit2 |] ==> x=y";
-by (rtac equalityI 1);
-by (REPEAT (ares_tac [conjI, counit2_Int_Vset_subset RS Int_Vset_subset] 1));
-val counit2_implies_equal = result();
-
-goal CoUnit2.thy "counit2 = {lfp(univ(0), %x. Con2(x,x))}";
-by (rtac equalityI 1);
-by (rtac (lfp_Con2_in_counit2 RS singleton_subsetI) 2);
-by (rtac subsetI 1);
-by (dtac (lfp_Con2_in_counit2 RS counit2_implies_equal) 1);
-by (etac subst 1);
-by (rtac singletonI 1);
-val counit2_eq_univ = result();
--- a/src/ZF/ex/data.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-(* Title: ZF/ex/data.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Sample datatype definition.
-It has four contructors, of arities 0-3, and two parameters A and B.
-*)
-
-structure Data = Datatype_Fun
- (val thy = Univ.thy
- val rec_specs = [("data", "univ(A Un B)",
- [(["Con0"], "i"),
- (["Con1"], "i=>i"),
- (["Con2"], "[i,i]=>i"),
- (["Con3"], "[i,i,i]=>i")])]
- val rec_styp = "[i,i]=>i"
- val ext = None
- val sintrs =
- ["Con0 : data(A,B)",
- "[| a: A |] ==> Con1(a) : data(A,B)",
- "[| a: A; b: B |] ==> Con2(a,b) : data(A,B)",
- "[| a: A; b: B; d: data(A,B) |] ==> Con3(a,b,d) : data(A,B)"]
- val monos = []
- val type_intrs = datatype_intrs
- val type_elims = datatype_elims);
-
-
-(** Lemmas to justify using "data" in other recursive type definitions **)
-
-goalw Data.thy Data.defs "!!A B. [| A<=C; B<=D |] ==> data(A,B) <= data(C,D)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac Data.bnd_mono 1));
-by (REPEAT (ares_tac (univ_mono::Un_mono::basic_monos) 1));
-val data_mono = result();
-
-goalw Data.thy (Data.defs@Data.con_defs) "data(univ(A),univ(A)) <= univ(A)";
-by (rtac lfp_lowerbound 1);
-by (rtac ([A_subset_univ, Un_upper1] MRS subset_trans RS univ_mono) 2);
-by (fast_tac (ZF_cs addSIs [zero_in_univ, Inl_in_univ, Inr_in_univ,
- Pair_in_univ]) 1);
-val data_univ = result();
-
-val data_subset_univ = standard ([data_mono, data_univ] MRS subset_trans);
-
-
--- a/src/ZF/ex/enum.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,33 +0,0 @@
-(* Title: ZF/ex/enum
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Example of a BIG enumeration type
-
-Can go up to at least 100 constructors, but it takes nearly 7 minutes...
-*)
-
-
-(*An enumeration type with 60 contructors! -- takes about 150 seconds!*)
-fun mk_ids a 0 = []
- | mk_ids a n = a :: mk_ids (bump_string a) (n-1);
-
-val consts = mk_ids "con1" 60;
-
-structure Enum = Datatype_Fun
- (val thy = Univ.thy;
- val rec_specs =
- [("enum", "univ(0)",
- [(consts, "i")])];
- val rec_styp = "i";
- val ext = None
- val sintrs = map (fn const => const ^ " : enum") consts;
- val monos = [];
- val type_intrs = datatype_intrs
- val type_elims = []);
-
-goal Enum.thy "con59 ~= con60";
-by (simp_tac (ZF_ss addsimps Enum.free_iffs) 1);
-result();
-
--- a/src/ZF/ex/equiv.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,268 +0,0 @@
-(* Title: ZF/ex/equiv.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For equiv.thy. Equivalence relations in Zermelo-Fraenkel Set Theory
-*)
-
-val RSLIST = curry (op MRS);
-
-open Equiv;
-
-(*** Suppes, Theorem 70: r is an equiv relation iff converse(r) O r = r ***)
-
-(** first half: equiv(A,r) ==> converse(r) O r = r **)
-
-goalw Equiv.thy [trans_def,sym_def]
- "!!r. [| sym(r); trans(r) |] ==> converse(r) O r <= r";
-by (fast_tac (ZF_cs addSEs [converseD,compE]) 1);
-val sym_trans_comp_subset = result();
-
-goalw Equiv.thy [refl_def]
- "!!A r. refl(A,r) ==> r <= converse(r) O r";
-by (fast_tac (ZF_cs addSIs [converseI] addIs [compI]) 1);
-val refl_comp_subset = result();
-
-goalw Equiv.thy [equiv_def]
- "!!A r. equiv(A,r) ==> converse(r) O r = r";
-by (rtac equalityI 1);
-by (REPEAT (ares_tac [sym_trans_comp_subset, refl_comp_subset] 1
- ORELSE etac conjE 1));
-val equiv_comp_eq = result();
-
-(*second half*)
-goalw Equiv.thy [equiv_def,refl_def,sym_def,trans_def]
- "!!A r. [| converse(r) O r = r; domain(r) = A |] ==> equiv(A,r)";
-by (etac equalityE 1);
-by (subgoal_tac "ALL x y. <x,y> : r --> <y,x> : r" 1);
-by (safe_tac ZF_cs);
-by (fast_tac (ZF_cs addSIs [converseI] addIs [compI]) 3);
-by (ALLGOALS (fast_tac
- (ZF_cs addSIs [converseI] addIs [compI] addSEs [compE])));
-by flexflex_tac;
-val comp_equivI = result();
-
-(** Equivalence classes **)
-
-(*Lemma for the next result*)
-goalw Equiv.thy [equiv_def,trans_def,sym_def]
- "!!A r. [| equiv(A,r); <a,b>: r |] ==> r``{a} <= r``{b}";
-by (fast_tac ZF_cs 1);
-val equiv_class_subset = result();
-
-goal Equiv.thy "!!A r. [| equiv(A,r); <a,b>: r |] ==> r``{a} = r``{b}";
-by (REPEAT (ares_tac [equalityI, equiv_class_subset] 1));
-by (rewrite_goals_tac [equiv_def,sym_def]);
-by (fast_tac ZF_cs 1);
-val equiv_class_eq = result();
-
-val prems = goalw Equiv.thy [equiv_def,refl_def]
- "[| equiv(A,r); a: A |] ==> a: r``{a}";
-by (cut_facts_tac prems 1);
-by (fast_tac ZF_cs 1);
-val equiv_class_self = result();
-
-(*Lemma for the next result*)
-goalw Equiv.thy [equiv_def,refl_def]
- "!!A r. [| equiv(A,r); r``{b} <= r``{a}; b: A |] ==> <a,b>: r";
-by (fast_tac ZF_cs 1);
-val subset_equiv_class = result();
-
-val prems = goal Equiv.thy
- "[| r``{a} = r``{b}; equiv(A,r); b: A |] ==> <a,b>: r";
-by (REPEAT (resolve_tac (prems @ [equalityD2, subset_equiv_class]) 1));
-val eq_equiv_class = result();
-
-(*thus r``{a} = r``{b} as well*)
-goalw Equiv.thy [equiv_def,trans_def,sym_def]
- "!!A r. [| equiv(A,r); x: (r``{a} Int r``{b}) |] ==> <a,b>: r";
-by (fast_tac ZF_cs 1);
-val equiv_class_nondisjoint = result();
-
-val [major] = goalw Equiv.thy [equiv_def,refl_def]
- "equiv(A,r) ==> r <= A*A";
-by (rtac (major RS conjunct1 RS conjunct1) 1);
-val equiv_type = result();
-
-goal Equiv.thy
- "!!A r. equiv(A,r) ==> <x,y>: r <-> r``{x} = r``{y} & x:A & y:A";
-by (fast_tac (ZF_cs addIs [eq_equiv_class, equiv_class_eq]
- addDs [equiv_type]) 1);
-val equiv_class_eq_iff = result();
-
-goal Equiv.thy
- "!!A r. [| equiv(A,r); x: A; y: A |] ==> r``{x} = r``{y} <-> <x,y>: r";
-by (fast_tac (ZF_cs addIs [eq_equiv_class, equiv_class_eq]
- addDs [equiv_type]) 1);
-val eq_equiv_class_iff = result();
-
-(*** Quotients ***)
-
-(** Introduction/elimination rules -- needed? **)
-
-val prems = goalw Equiv.thy [quotient_def] "x:A ==> r``{x}: A/r";
-by (rtac RepFunI 1);
-by (resolve_tac prems 1);
-val quotientI = result();
-
-val major::prems = goalw Equiv.thy [quotient_def]
- "[| X: A/r; !!x. [| X = r``{x}; x:A |] ==> P |] \
-\ ==> P";
-by (rtac (major RS RepFunE) 1);
-by (eresolve_tac prems 1);
-by (assume_tac 1);
-val quotientE = result();
-
-goalw Equiv.thy [equiv_def,refl_def,quotient_def]
- "!!A r. equiv(A,r) ==> Union(A/r) = A";
-by (fast_tac eq_cs 1);
-val Union_quotient = result();
-
-goalw Equiv.thy [quotient_def]
- "!!A r. [| equiv(A,r); X: A/r; Y: A/r |] ==> X=Y | (X Int Y <= 0)";
-by (safe_tac (ZF_cs addSIs [equiv_class_eq]));
-by (assume_tac 1);
-by (rewrite_goals_tac [equiv_def,trans_def,sym_def]);
-by (fast_tac ZF_cs 1);
-val quotient_disj = result();
-
-(**** Defining unary operations upon equivalence classes ****)
-
-(** These proofs really require as local premises
- equiv(A,r); congruent(r,b)
-**)
-
-(*Conversion rule*)
-val prems as [equivA,bcong,_] = goal Equiv.thy
- "[| equiv(A,r); congruent(r,b); a: A |] ==> (UN x:r``{a}. b(x)) = b(a)";
-by (cut_facts_tac prems 1);
-by (rtac UN_singleton 1);
-by (etac equiv_class_self 1);
-by (assume_tac 1);
-by (rewrite_goals_tac [equiv_def,sym_def,congruent_def]);
-by (fast_tac ZF_cs 1);
-val UN_equiv_class = result();
-
-(*Resolve th against the "local" premises*)
-val localize = RSLIST [equivA,bcong];
-
-(*type checking of UN x:r``{a}. b(x) *)
-val _::_::prems = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); congruent(r,b); X: A/r; \
-\ !!x. x : A ==> b(x) : B |] \
-\ ==> (UN x:X. b(x)) : B";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (rtac (localize UN_equiv_class RS ssubst) 1);
-by (REPEAT (ares_tac prems 1));
-val UN_equiv_class_type = result();
-
-(*Sufficient conditions for injectiveness. Could weaken premises!
- major premise could be an inclusion; bcong could be !!y. y:A ==> b(y):B
-*)
-val _::_::prems = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); congruent(r,b); \
-\ (UN x:X. b(x))=(UN y:Y. b(y)); X: A/r; Y: A/r; \
-\ !!x y. [| x:A; y:A; b(x)=b(y) |] ==> <x,y>:r |] \
-\ ==> X=Y";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (rtac (equivA RS equiv_class_eq) 1);
-by (REPEAT (ares_tac prems 1));
-by (etac box_equals 1);
-by (REPEAT (ares_tac [localize UN_equiv_class] 1));
-val UN_equiv_class_inject = result();
-
-
-(**** Defining binary operations upon equivalence classes ****)
-
-
-goalw Equiv.thy [congruent_def,congruent2_def,equiv_def,refl_def]
- "!!A r. [| equiv(A,r); congruent2(r,b); a: A |] ==> congruent(r,b(a))";
-by (fast_tac ZF_cs 1);
-val congruent2_implies_congruent = result();
-
-val equivA::prems = goalw Equiv.thy [congruent_def]
- "[| equiv(A,r); congruent2(r,b); a: A |] ==> \
-\ congruent(r, %x1. UN x2:r``{a}. b(x1,x2))";
-by (cut_facts_tac (equivA::prems) 1);
-by (safe_tac ZF_cs);
-by (rtac (equivA RS equiv_type RS subsetD RS SigmaE2) 1);
-by (assume_tac 1);
-by (asm_simp_tac (ZF_ss addsimps [equivA RS UN_equiv_class,
- congruent2_implies_congruent]) 1);
-by (rewrite_goals_tac [congruent2_def,equiv_def,refl_def]);
-by (fast_tac ZF_cs 1);
-val congruent2_implies_congruent_UN = result();
-
-val prems as equivA::_ = goal Equiv.thy
- "[| equiv(A,r); congruent2(r,b); a1: A; a2: A |] \
-\ ==> (UN x1:r``{a1}. UN x2:r``{a2}. b(x1,x2)) = b(a1,a2)";
-by (cut_facts_tac prems 1);
-by (asm_simp_tac (ZF_ss addsimps [equivA RS UN_equiv_class,
- congruent2_implies_congruent,
- congruent2_implies_congruent_UN]) 1);
-val UN_equiv_class2 = result();
-
-(*type checking*)
-val prems = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); congruent2(r,b); \
-\ X1: A/r; X2: A/r; \
-\ !!x1 x2. [| x1: A; x2: A |] ==> b(x1,x2) : B |] \
-\ ==> (UN x1:X1. UN x2:X2. b(x1,x2)) : B";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (REPEAT (ares_tac (prems@[UN_equiv_class_type,
- congruent2_implies_congruent_UN,
- congruent2_implies_congruent, quotientI]) 1));
-val UN_equiv_class_type2 = result();
-
-
-(*Suggested by John Harrison -- the two subproofs may be MUCH simpler
- than the direct proof*)
-val prems = goalw Equiv.thy [congruent2_def,equiv_def,refl_def]
- "[| equiv(A,r); \
-\ !! y z w. [| w: A; <y,z> : r |] ==> b(y,w) = b(z,w); \
-\ !! y z w. [| w: A; <y,z> : r |] ==> b(w,y) = b(w,z) \
-\ |] ==> congruent2(r,b)";
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-by (rtac trans 1);
-by (REPEAT (ares_tac prems 1
- ORELSE etac (subsetD RS SigmaE2) 1 THEN assume_tac 2 THEN assume_tac 1));
-val congruent2I = result();
-
-val [equivA,commute,congt] = goal Equiv.thy
- "[| equiv(A,r); \
-\ !! y z. [| y: A; z: A |] ==> b(y,z) = b(z,y); \
-\ !! y z w. [| w: A; <y,z>: r |] ==> b(w,y) = b(w,z) \
-\ |] ==> congruent2(r,b)";
-by (resolve_tac [equivA RS congruent2I] 1);
-by (rtac (commute RS trans) 1);
-by (rtac (commute RS trans RS sym) 3);
-by (rtac sym 5);
-by (REPEAT (ares_tac [congt] 1
- ORELSE etac (equivA RS equiv_type RS subsetD RS SigmaE2) 1));
-val congruent2_commuteI = result();
-
-(***OBSOLETE VERSION
-(*Rules congruentI and congruentD would simplify use of rewriting below*)
-val [equivA,ZinA,congt,commute] = goalw Equiv.thy [quotient_def]
- "[| equiv(A,r); Z: A/r; \
-\ !!w. [| w: A |] ==> congruent(r, %z.b(w,z)); \
-\ !!x y. [| x: A; y: A |] ==> b(y,x) = b(x,y) \
-\ |] ==> congruent(r, %w. UN z: Z. b(w,z))";
-val congt' = rewrite_rule [congruent_def] congt;
-by (cut_facts_tac [ZinA,congt] 1);
-by (rewtac congruent_def);
-by (safe_tac ZF_cs);
-by (rtac (equivA RS equiv_type RS subsetD RS SigmaE2) 1);
-by (assume_tac 1);
-by (asm_simp_tac (ZF_ss addsimps [congt RS (equivA RS UN_equiv_class)]) 1);
-by (rtac (commute RS trans) 1);
-by (rtac (commute RS trans RS sym) 3);
-by (rtac sym 5);
-by (REPEAT (ares_tac [congt' RS spec RS spec RS mp] 1));
-val congruent_commuteI = result();
-***)
--- a/src/ZF/ex/equiv.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,28 +0,0 @@
-(* Title: ZF/ex/equiv.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Equivalence relations in Zermelo-Fraenkel Set Theory
-*)
-
-Equiv = Trancl +
-consts
- refl,equiv :: "[i,i]=>o"
- sym :: "i=>o"
- "'/" :: "[i,i]=>i" (infixl 90) (*set of equiv classes*)
- congruent :: "[i,i=>i]=>o"
- congruent2 :: "[i,[i,i]=>i]=>o"
-
-rules
- refl_def "refl(A,r) == r <= (A*A) & (ALL x: A. <x,x> : r)"
- sym_def "sym(r) == ALL x y. <x,y>: r --> <y,x>: r"
- equiv_def "equiv(A,r) == refl(A,r) & sym(r) & trans(r)"
- quotient_def "A/r == {r``{x} . x:A}"
- congruent_def "congruent(r,b) == ALL y z. <y,z>:r --> b(y)=b(z)"
-
- congruent2_def
- "congruent2(r,b) == ALL y1 z1 y2 z2. \
-\ <y1,z1>:r --> <y2,z2>:r --> b(y1,y2) = b(z1,z2)"
-
-end
--- a/src/ZF/ex/integ.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,433 +0,0 @@
-(* Title: ZF/ex/integ.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For integ.thy. The integers as equivalence classes over nat*nat.
-
-Could also prove...
-"znegative(z) ==> $# zmagnitude(z) = $~ z"
-"~ znegative(z) ==> $# zmagnitude(z) = z"
-$< is a linear ordering
-$+ and $* are monotonic wrt $<
-*)
-
-val add_cong =
- read_instantiate_sg (sign_of Arith.thy) [("t","op #+")] subst_context2;
-
-
-open Integ;
-
-(*** Proving that intrel is an equivalence relation ***)
-
-val prems = goal Arith.thy
- "[| m #+ n = m' #+ n'; m: nat; m': nat |] \
-\ ==> m #+ (n #+ k) = m' #+ (n' #+ k)";
-by (asm_simp_tac (arith_ss addsimps ([add_assoc RS sym] @ prems)) 1);
-val add_assoc_cong = result();
-
-val prems = goal Arith.thy
- "[| m: nat; n: nat |] \
-\ ==> m #+ (n #+ k) = n #+ (m #+ k)";
-by (REPEAT (resolve_tac ([add_commute RS add_assoc_cong] @ prems) 1));
-val add_assoc_swap = result();
-
-val add_kill = (refl RS add_cong);
-
-val add_assoc_swap_kill = add_kill RSN (3, add_assoc_swap RS trans);
-
-(*By luck, requires no typing premises for y1, y2,y3*)
-val eqa::eqb::prems = goal Arith.thy
- "[| x1 #+ y2 = x2 #+ y1; x2 #+ y3 = x3 #+ y2; \
-\ x1: nat; x2: nat; x3: nat |] ==> x1 #+ y3 = x3 #+ y1";
-by (res_inst_tac [("k","x2")] add_left_cancel 1);
-by (resolve_tac prems 1);
-by (rtac (add_assoc_swap RS trans) 1 THEN typechk_tac prems);
-by (rtac (eqb RS ssubst) 1);
-by (rtac (add_assoc_swap RS trans) 1 THEN typechk_tac prems);
-by (rtac (eqa RS ssubst) 1);
-by (rtac (add_assoc_swap) 1 THEN typechk_tac prems);
-val integ_trans_lemma = result();
-
-(** Natural deduction for intrel **)
-
-val prems = goalw Integ.thy [intrel_def]
- "[| x1#+y2 = x2#+y1; x1: nat; y1: nat; x2: nat; y2: nat |] ==> \
-\ <<x1,y1>,<x2,y2>>: intrel";
-by (fast_tac (ZF_cs addIs prems) 1);
-val intrelI = result();
-
-(*intrelE is hard to derive because fast_tac tries hyp_subst_tac so soon*)
-goalw Integ.thy [intrel_def]
- "p: intrel --> (EX x1 y1 x2 y2. \
-\ p = <<x1,y1>,<x2,y2>> & x1#+y2 = x2#+y1 & \
-\ x1: nat & y1: nat & x2: nat & y2: nat)";
-by (fast_tac ZF_cs 1);
-val intrelE_lemma = result();
-
-val [major,minor] = goal Integ.thy
- "[| p: intrel; \
-\ !!x1 y1 x2 y2. [| p = <<x1,y1>,<x2,y2>>; x1#+y2 = x2#+y1; \
-\ x1: nat; y1: nat; x2: nat; y2: nat |] ==> Q |] \
-\ ==> Q";
-by (cut_facts_tac [major RS (intrelE_lemma RS mp)] 1);
-by (REPEAT (eresolve_tac [asm_rl,exE,conjE,minor] 1));
-val intrelE = result();
-
-val intrel_cs = ZF_cs addSIs [intrelI] addSEs [intrelE];
-
-goal Integ.thy
- "<<x1,y1>,<x2,y2>>: intrel <-> \
-\ x1#+y2 = x2#+y1 & x1: nat & y1: nat & x2: nat & y2: nat";
-by (fast_tac intrel_cs 1);
-val intrel_iff = result();
-
-val prems = goalw Integ.thy [equiv_def] "equiv(nat*nat, intrel)";
-by (safe_tac intrel_cs);
-by (rewtac refl_def);
-by (fast_tac intrel_cs 1);
-by (rewtac sym_def);
-by (fast_tac (intrel_cs addSEs [sym]) 1);
-by (rewtac trans_def);
-by (fast_tac (intrel_cs addSEs [integ_trans_lemma]) 1);
-val equiv_intrel = result();
-
-
-val intrel_ss =
- arith_ss addsimps [equiv_intrel RS eq_equiv_class_iff, intrel_iff];
-
-(*Roughly twice as fast as simplifying with intrel_ss*)
-fun INTEG_SIMP_TAC ths =
- let val ss = arith_ss addsimps ths
- in fn i =>
- EVERY [asm_simp_tac ss i,
- rtac (intrelI RS (equiv_intrel RS equiv_class_eq)) i,
- typechk_tac (ZF_typechecks@nat_typechecks@arith_typechecks),
- asm_simp_tac ss i]
- end;
-
-
-(** znat: the injection from nat to integ **)
-
-val prems = goalw Integ.thy [integ_def,quotient_def,znat_def]
- "m : nat ==> $#m : integ";
-by (fast_tac (ZF_cs addSIs (nat_0I::prems)) 1);
-val znat_type = result();
-
-val [major,nnat] = goalw Integ.thy [znat_def]
- "[| $#m = $#n; n: nat |] ==> m=n";
-by (rtac (make_elim (major RS eq_equiv_class)) 1);
-by (rtac equiv_intrel 1);
-by (typechk_tac [nat_0I,nnat,SigmaI]);
-by (safe_tac (intrel_cs addSEs [box_equals,add_0_right]));
-val znat_inject = result();
-
-
-(**** zminus: unary negation on integ ****)
-
-goalw Integ.thy [congruent_def]
- "congruent(intrel, split(%x y. intrel``{<y,x>}))";
-by (safe_tac intrel_cs);
-by (ALLGOALS (asm_simp_tac intrel_ss));
-by (etac (box_equals RS sym) 1);
-by (REPEAT (ares_tac [add_commute] 1));
-val zminus_congruent = result();
-
-(*Resolve th against the corresponding facts for zminus*)
-val zminus_ize = RSLIST [equiv_intrel, zminus_congruent];
-
-val [prem] = goalw Integ.thy [integ_def,zminus_def]
- "z : integ ==> $~z : integ";
-by (typechk_tac [split_type, SigmaI, prem, zminus_ize UN_equiv_class_type,
- quotientI]);
-val zminus_type = result();
-
-val major::prems = goalw Integ.thy [integ_def,zminus_def]
- "[| $~z = $~w; z: integ; w: integ |] ==> z=w";
-by (rtac (major RS zminus_ize UN_equiv_class_inject) 1);
-by (REPEAT (ares_tac prems 1));
-by (REPEAT (etac SigmaE 1));
-by (etac rev_mp 1);
-by (asm_simp_tac ZF_ss 1);
-by (fast_tac (intrel_cs addSIs [SigmaI, equiv_intrel]
- addSEs [box_equals RS sym, add_commute,
- make_elim eq_equiv_class]) 1);
-val zminus_inject = result();
-
-val prems = goalw Integ.thy [zminus_def]
- "[| x: nat; y: nat |] ==> $~ (intrel``{<x,y>}) = intrel `` {<y,x>}";
-by (asm_simp_tac
- (ZF_ss addsimps (prems@[zminus_ize UN_equiv_class, SigmaI])) 1);
-val zminus = result();
-
-goalw Integ.thy [integ_def] "!!z. z : integ ==> $~ ($~ z) = z";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (asm_simp_tac (ZF_ss addsimps [zminus]) 1);
-val zminus_zminus = result();
-
-goalw Integ.thy [integ_def, znat_def] "$~ ($#0) = $#0";
-by (simp_tac (arith_ss addsimps [zminus]) 1);
-val zminus_0 = result();
-
-
-(**** znegative: the test for negative integers ****)
-
-goalw Integ.thy [znegative_def, znat_def]
- "~ znegative($# n)";
-by (safe_tac intrel_cs);
-by (rtac (add_le_self2 RS le_imp_not_lt RS notE) 1);
-by (etac ssubst 3);
-by (asm_simp_tac (arith_ss addsimps [add_0_right]) 3);
-by (REPEAT (assume_tac 1));
-val not_znegative_znat = result();
-
-goalw Integ.thy [znegative_def, znat_def]
- "!!n. n: nat ==> znegative($~ $# succ(n))";
-by (asm_simp_tac (intrel_ss addsimps [zminus]) 1);
-by (REPEAT
- (ares_tac [refl, exI, conjI, nat_0_le,
- refl RS intrelI RS imageI, consI1, nat_0I, nat_succI] 1));
-val znegative_zminus_znat = result();
-
-
-(**** zmagnitude: magnitide of an integer, as a natural number ****)
-
-goalw Integ.thy [congruent_def]
- "congruent(intrel, split(%x y. (y#-x) #+ (x#-y)))";
-by (safe_tac intrel_cs);
-by (ALLGOALS (asm_simp_tac intrel_ss));
-by (etac rev_mp 1);
-by (res_inst_tac [("m","x1"),("n","y1")] diff_induct 1);
-by (REPEAT (assume_tac 1));
-by (asm_simp_tac (arith_ss addsimps [add_succ_right,succ_inject_iff]) 3);
-by (asm_simp_tac
- (arith_ss addsimps [diff_add_inverse,diff_add_0,add_0_right]) 2);
-by (asm_simp_tac (arith_ss addsimps [add_0_right]) 1);
-by (rtac impI 1);
-by (etac subst 1);
-by (res_inst_tac [("m1","x")] (add_commute RS ssubst) 1);
-by (REPEAT (assume_tac 1));
-by (asm_simp_tac (arith_ss addsimps [diff_add_inverse,diff_add_0]) 1);
-val zmagnitude_congruent = result();
-
-(*Resolve th against the corresponding facts for zmagnitude*)
-val zmagnitude_ize = RSLIST [equiv_intrel, zmagnitude_congruent];
-
-val [prem] = goalw Integ.thy [integ_def,zmagnitude_def]
- "z : integ ==> zmagnitude(z) : nat";
-by (typechk_tac [split_type, prem, zmagnitude_ize UN_equiv_class_type,
- add_type, diff_type]);
-val zmagnitude_type = result();
-
-val prems = goalw Integ.thy [zmagnitude_def]
- "[| x: nat; y: nat |] ==> \
-\ zmagnitude (intrel``{<x,y>}) = (y #- x) #+ (x #- y)";
-by (asm_simp_tac
- (ZF_ss addsimps (prems@[zmagnitude_ize UN_equiv_class, SigmaI])) 1);
-val zmagnitude = result();
-
-goalw Integ.thy [znat_def]
- "!!n. n: nat ==> zmagnitude($# n) = n";
-by (asm_simp_tac (intrel_ss addsimps [zmagnitude]) 1);
-val zmagnitude_znat = result();
-
-goalw Integ.thy [znat_def]
- "!!n. n: nat ==> zmagnitude($~ $# n) = n";
-by (asm_simp_tac (intrel_ss addsimps [zmagnitude, zminus ,add_0_right]) 1);
-val zmagnitude_zminus_znat = result();
-
-
-(**** zadd: addition on integ ****)
-
-(** Congruence property for addition **)
-
-goalw Integ.thy [congruent2_def]
- "congruent2(intrel, %p1 p2. \
-\ split(%x1 y1. split(%x2 y2. intrel `` {<x1#+x2, y1#+y2>}, p2), p1))";
-(*Proof via congruent2_commuteI seems longer*)
-by (safe_tac intrel_cs);
-by (INTEG_SIMP_TAC [add_assoc] 1);
-(*The rest should be trivial, but rearranging terms is hard*)
-by (res_inst_tac [("m1","x1a")] (add_assoc_swap RS ssubst) 1);
-by (res_inst_tac [("m1","x2a")] (add_assoc_swap RS ssubst) 3);
-by (typechk_tac [add_type]);
-by (asm_simp_tac (arith_ss addsimps [add_assoc RS sym]) 1);
-val zadd_congruent2 = result();
-
-(*Resolve th against the corresponding facts for zadd*)
-val zadd_ize = RSLIST [equiv_intrel, zadd_congruent2];
-
-val prems = goalw Integ.thy [integ_def,zadd_def]
- "[| z: integ; w: integ |] ==> z $+ w : integ";
-by (REPEAT (ares_tac (prems@[zadd_ize UN_equiv_class_type2,
- split_type, add_type, quotientI, SigmaI]) 1));
-val zadd_type = result();
-
-val prems = goalw Integ.thy [zadd_def]
- "[| x1: nat; y1: nat; x2: nat; y2: nat |] ==> \
-\ (intrel``{<x1,y1>}) $+ (intrel``{<x2,y2>}) = intrel `` {<x1#+x2, y1#+y2>}";
-by (asm_simp_tac (ZF_ss addsimps
- (prems @ [zadd_ize UN_equiv_class2, SigmaI])) 1);
-val zadd = result();
-
-goalw Integ.thy [integ_def,znat_def] "!!z. z : integ ==> $#0 $+ z = z";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (asm_simp_tac (arith_ss addsimps [zadd]) 1);
-val zadd_0 = result();
-
-goalw Integ.thy [integ_def]
- "!!z w. [| z: integ; w: integ |] ==> $~ (z $+ w) = $~ z $+ $~ w";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (asm_simp_tac (arith_ss addsimps [zminus,zadd]) 1);
-val zminus_zadd_distrib = result();
-
-goalw Integ.thy [integ_def]
- "!!z w. [| z: integ; w: integ |] ==> z $+ w = w $+ z";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (INTEG_SIMP_TAC [zadd] 1);
-by (REPEAT (ares_tac [add_commute,add_cong] 1));
-val zadd_commute = result();
-
-goalw Integ.thy [integ_def]
- "!!z1 z2 z3. [| z1: integ; z2: integ; z3: integ |] ==> \
-\ (z1 $+ z2) $+ z3 = z1 $+ (z2 $+ z3)";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-(*rewriting is much faster without intrel_iff, etc.*)
-by (asm_simp_tac (arith_ss addsimps [zadd,add_assoc]) 1);
-val zadd_assoc = result();
-
-val prems = goalw Integ.thy [znat_def]
- "[| m: nat; n: nat |] ==> $# (m #+ n) = ($#m) $+ ($#n)";
-by (asm_simp_tac (arith_ss addsimps (zadd::prems)) 1);
-val znat_add = result();
-
-goalw Integ.thy [integ_def,znat_def] "!!z. z : integ ==> z $+ ($~ z) = $#0";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (asm_simp_tac (intrel_ss addsimps [zminus,zadd,add_0_right]) 1);
-by (REPEAT (ares_tac [add_commute] 1));
-val zadd_zminus_inverse = result();
-
-val prems = goal Integ.thy
- "z : integ ==> ($~ z) $+ z = $#0";
-by (rtac (zadd_commute RS trans) 1);
-by (REPEAT (resolve_tac (prems@[zminus_type, zadd_zminus_inverse]) 1));
-val zadd_zminus_inverse2 = result();
-
-val prems = goal Integ.thy "z:integ ==> z $+ $#0 = z";
-by (rtac (zadd_commute RS trans) 1);
-by (REPEAT (resolve_tac (prems@[znat_type,nat_0I,zadd_0]) 1));
-val zadd_0_right = result();
-
-
-(*Need properties of $- ??? Or use $- just as an abbreviation?
- [| m: nat; n: nat; m>=n |] ==> $# (m #- n) = ($#m) $- ($#n)
-*)
-
-(**** zmult: multiplication on integ ****)
-
-(** Congruence property for multiplication **)
-
-val prems = goalw Integ.thy [znat_def]
- "[| k: nat; l: nat; m: nat; n: nat |] ==> \
-\ (k #+ l) #+ (m #+ n) = (k #+ m) #+ (n #+ l)";
-val add_commute' = read_instantiate [("m","l")] add_commute;
-by (simp_tac (arith_ss addsimps ([add_commute',add_assoc]@prems)) 1);
-val zmult_congruent_lemma = result();
-
-goal Integ.thy
- "congruent2(intrel, %p1 p2. \
-\ split(%x1 y1. split(%x2 y2. \
-\ intrel``{<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}, p2), p1))";
-by (rtac (equiv_intrel RS congruent2_commuteI) 1);
-by (safe_tac intrel_cs);
-by (ALLGOALS (INTEG_SIMP_TAC []));
-(*Proof that zmult is congruent in one argument*)
-by (rtac (zmult_congruent_lemma RS trans) 2);
-by (rtac (zmult_congruent_lemma RS trans RS sym) 6);
-by (typechk_tac [mult_type]);
-by (asm_simp_tac (arith_ss addsimps [add_mult_distrib_left RS sym]) 2);
-(*Proof that zmult is commutative on representatives*)
-by (rtac add_cong 1);
-by (rtac (add_commute RS trans) 2);
-by (REPEAT (ares_tac [mult_commute,add_type,mult_type,add_cong] 1));
-val zmult_congruent2 = result();
-
-(*Resolve th against the corresponding facts for zmult*)
-val zmult_ize = RSLIST [equiv_intrel, zmult_congruent2];
-
-val prems = goalw Integ.thy [integ_def,zmult_def]
- "[| z: integ; w: integ |] ==> z $* w : integ";
-by (REPEAT (ares_tac (prems@[zmult_ize UN_equiv_class_type2,
- split_type, add_type, mult_type,
- quotientI, SigmaI]) 1));
-val zmult_type = result();
-
-
-val prems = goalw Integ.thy [zmult_def]
- "[| x1: nat; y1: nat; x2: nat; y2: nat |] ==> \
-\ (intrel``{<x1,y1>}) $* (intrel``{<x2,y2>}) = \
-\ intrel `` {<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}";
-by (asm_simp_tac (ZF_ss addsimps
- (prems @ [zmult_ize UN_equiv_class2, SigmaI])) 1);
-val zmult = result();
-
-goalw Integ.thy [integ_def,znat_def] "!!z. z : integ ==> $#0 $* z = $#0";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (asm_simp_tac (arith_ss addsimps [zmult]) 1);
-val zmult_0 = result();
-
-goalw Integ.thy [integ_def,znat_def]
- "!!z. z : integ ==> $#1 $* z = z";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (asm_simp_tac (arith_ss addsimps [zmult,add_0_right]) 1);
-val zmult_1 = result();
-
-goalw Integ.thy [integ_def]
- "!!z w. [| z: integ; w: integ |] ==> ($~ z) $* w = $~ (z $* w)";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (INTEG_SIMP_TAC [zminus,zmult] 1);
-by (REPEAT (ares_tac [mult_type,add_commute,add_cong] 1));
-val zmult_zminus = result();
-
-goalw Integ.thy [integ_def]
- "!!z w. [| z: integ; w: integ |] ==> ($~ z) $* ($~ w) = (z $* w)";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (INTEG_SIMP_TAC [zminus,zmult] 1);
-by (REPEAT (ares_tac [mult_type,add_commute,add_cong] 1));
-val zmult_zminus_zminus = result();
-
-goalw Integ.thy [integ_def]
- "!!z w. [| z: integ; w: integ |] ==> z $* w = w $* z";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (INTEG_SIMP_TAC [zmult] 1);
-by (res_inst_tac [("m1","xc #* y")] (add_commute RS ssubst) 1);
-by (REPEAT (ares_tac [mult_type,mult_commute,add_cong] 1));
-val zmult_commute = result();
-
-goalw Integ.thy [integ_def]
- "!!z1 z2 z3. [| z1: integ; z2: integ; z3: integ |] ==> \
-\ (z1 $* z2) $* z3 = z1 $* (z2 $* z3)";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (INTEG_SIMP_TAC [zmult, add_mult_distrib_left,
- add_mult_distrib, add_assoc, mult_assoc] 1);
-(*takes 54 seconds due to wasteful type-checking*)
-by (REPEAT (ares_tac [add_type, mult_type, add_commute, add_kill,
- add_assoc_swap_kill, add_assoc_swap_kill RS sym] 1));
-val zmult_assoc = result();
-
-goalw Integ.thy [integ_def]
- "!!z1 z2 z3. [| z1: integ; z2: integ; w: integ |] ==> \
-\ (z1 $+ z2) $* w = (z1 $* w) $+ (z2 $* w)";
-by (REPEAT (eresolve_tac [quotientE,SigmaE,ssubst] 1));
-by (INTEG_SIMP_TAC [zadd, zmult, add_mult_distrib, add_assoc] 1);
-(*takes 30 seconds due to wasteful type-checking*)
-by (REPEAT (ares_tac [add_type, mult_type, refl, add_commute, add_kill,
- add_assoc_swap_kill, add_assoc_swap_kill RS sym] 1));
-val zadd_zmult_distrib = result();
-
-val integ_typechecks =
- [znat_type, zminus_type, zmagnitude_type, zadd_type, zmult_type];
-
-val integ_ss =
- arith_ss addsimps ([zminus_zminus, zmagnitude_znat,
- zmagnitude_zminus_znat, zadd_0] @ integ_typechecks);
--- a/src/ZF/ex/integ.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,54 +0,0 @@
-(* Title: ZF/ex/integ.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-The integers as equivalence classes over nat*nat.
-*)
-
-Integ = Equiv + Arith +
-consts
- intrel,integ:: "i"
- znat :: "i=>i" ("$# _" [80] 80)
- zminus :: "i=>i" ("$~ _" [80] 80)
- znegative :: "i=>o"
- zmagnitude :: "i=>i"
- "$*" :: "[i,i]=>i" (infixl 70)
- "$'/" :: "[i,i]=>i" (infixl 70)
- "$'/'/" :: "[i,i]=>i" (infixl 70)
- "$+" :: "[i,i]=>i" (infixl 65)
- "$-" :: "[i,i]=>i" (infixl 65)
- "$<" :: "[i,i]=>o" (infixl 50)
-
-rules
-
- intrel_def
- "intrel == {p:(nat*nat)*(nat*nat). \
-\ EX x1 y1 x2 y2. p=<<x1,y1>,<x2,y2>> & x1#+y2 = x2#+y1}"
-
- integ_def "integ == (nat*nat)/intrel"
-
- znat_def "$# m == intrel `` {<m,0>}"
-
- zminus_def "$~ Z == UN p:Z. split(%x y. intrel``{<y,x>}, p)"
-
- znegative_def
- "znegative(Z) == EX x y. x<y & y:nat & <x,y>:Z"
-
- zmagnitude_def
- "zmagnitude(Z) == UN p:Z. split(%x y. (y#-x) #+ (x#-y), p)"
-
- zadd_def
- "Z1 $+ Z2 == \
-\ UN p1:Z1. UN p2:Z2. split(%x1 y1. split(%x2 y2. \
-\ intrel``{<x1#+x2, y1#+y2>}, p2), p1)"
-
- zdiff_def "Z1 $- Z2 == Z1 $+ zminus(Z2)"
- zless_def "Z1 $< Z2 == znegative(Z1 $- Z2)"
-
- zmult_def
- "Z1 $* Z2 == \
-\ UN p1:Z1. UN p2:Z2. split(%x1 y1. split(%x2 y2. \
-\ intrel``{<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}, p2), p1)"
-
- end
--- a/src/ZF/ex/listn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,61 +0,0 @@
-(* Title: ZF/ex/listn
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Inductive definition of lists of n elements
-
-See Ch. Paulin-Mohring, Inductive Definitions in the System Coq.
-Research Report 92-49, LIP, ENS Lyon. Dec 1992.
-*)
-
-structure ListN = Inductive_Fun
- (val thy = ListFn.thy addconsts [(["listn"],"i=>i")]
- val rec_doms = [("listn", "nat*list(A)")]
- val sintrs =
- ["<0,Nil> : listn(A)",
- "[| a: A; <n,l> : listn(A) |] ==> <succ(n), Cons(a,l)> : listn(A)"]
- val monos = []
- val con_defs = []
- val type_intrs = nat_typechecks @ List.intrs @ [SigmaI]
- val type_elims = [SigmaE2]);
-
-val listn_induct = standard
- (ListN.mutual_induct RS spec RS spec RSN (2,rev_mp));
-
-goal ListN.thy "!!l. l:list(A) ==> <length(l),l> : listn(A)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-by (REPEAT (ares_tac ListN.intrs 1));
-val list_into_listn = result();
-
-goal ListN.thy "<n,l> : listn(A) <-> l:list(A) & length(l)=n";
-by (rtac iffI 1);
-by (etac listn_induct 1);
-by (safe_tac (ZF_cs addSIs (list_typechecks @
- [length_Nil, length_Cons, list_into_listn])));
-val listn_iff = result();
-
-goal ListN.thy "listn(A)``{n} = {l:list(A). length(l)=n}";
-by (rtac equality_iffI 1);
-by (simp_tac (list_ss addsimps [listn_iff,separation,image_singleton_iff]) 1);
-val listn_image_eq = result();
-
-goalw ListN.thy ListN.defs "!!A B. A<=B ==> listn(A) <= listn(B)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac ListN.bnd_mono 1));
-by (REPEAT (ares_tac ([univ_mono,Sigma_mono,list_mono] @ basic_monos) 1));
-val listn_mono = result();
-
-goal ListN.thy
- "!!n l. [| <n,l> : listn(A); <n',l'> : listn(A) |] ==> \
-\ <n#+n', l@l'> : listn(A)";
-by (etac listn_induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps ListN.intrs)));
-val listn_append = result();
-
-val Nil_listn_case = ListN.mk_cases List.con_defs "<i,Nil> : listn(A)"
-and Cons_listn_case = ListN.mk_cases List.con_defs "<i,Cons(x,l)> : listn(A)";
-
-val zero_listn_case = ListN.mk_cases List.con_defs "<0,l> : listn(A)"
-and succ_listn_case = ListN.mk_cases List.con_defs "<succ(i),l> : listn(A)";
--- a/src/ZF/ex/llist.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,71 +0,0 @@
-(* Title: ZF/ex/llist.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Codatatype definition of Lazy Lists
-*)
-
-structure LList = CoDatatype_Fun
- (val thy = QUniv.thy
- val rec_specs = [("llist", "quniv(A)",
- [(["LNil"], "i"),
- (["LCons"], "[i,i]=>i")])]
- val rec_styp = "i=>i"
- val ext = None
- val sintrs = ["LNil : llist(A)",
- "[| a: A; l: llist(A) |] ==> LCons(a,l) : llist(A)"]
- val monos = []
- val type_intrs = codatatype_intrs
- val type_elims = codatatype_elims);
-
-val [LNilI, LConsI] = LList.intrs;
-
-(*An elimination rule, for type-checking*)
-val LConsE = LList.mk_cases LList.con_defs "LCons(a,l) : llist(A)";
-
-(*Proving freeness results*)
-val LCons_iff = LList.mk_free "LCons(a,l)=LCons(a',l') <-> a=a' & l=l'";
-val LNil_LCons_iff = LList.mk_free "~ LNil=LCons(a,l)";
-
-(*** Lemmas to justify using "llist" in other recursive type definitions ***)
-
-goalw LList.thy LList.defs "!!A B. A<=B ==> llist(A) <= llist(B)";
-by (rtac gfp_mono 1);
-by (REPEAT (rtac LList.bnd_mono 1));
-by (REPEAT (ares_tac (quniv_mono::basic_monos) 1));
-val llist_mono = result();
-
-(** Closure of quniv(A) under llist -- why so complex? Its a gfp... **)
-
-val quniv_cs = subset_cs addSIs [QPair_Int_Vset_subset_UN RS subset_trans,
- QPair_subset_univ,
- empty_subsetI, one_in_quniv RS qunivD]
- addIs [Int_lower1 RS subset_trans]
- addSDs [qunivD]
- addSEs [Ord_in_Ord];
-
-goal LList.thy
- "!!i. Ord(i) ==> ALL l: llist(quniv(A)). l Int Vset(i) <= univ(eclose(A))";
-by (etac trans_induct 1);
-by (rtac ballI 1);
-by (etac LList.elim 1);
-by (rewrite_goals_tac ([QInl_def,QInr_def]@LList.con_defs));
-(*LNil case*)
-by (fast_tac quniv_cs 1);
-(*LCons case*)
-by (safe_tac quniv_cs);
-by (ALLGOALS (fast_tac (quniv_cs addSEs [Ord_trans, make_elim bspec])));
-val llist_quniv_lemma = result();
-
-goal LList.thy "llist(quniv(A)) <= quniv(A)";
-by (rtac (qunivI RS subsetI) 1);
-by (rtac Int_Vset_subset 1);
-by (REPEAT (ares_tac [llist_quniv_lemma RS bspec] 1));
-val llist_quniv = result();
-
-val llist_subset_quniv = standard
- (llist_mono RS (llist_quniv RSN (2,subset_trans)));
-
-(* Definition and use of LList_Eq has been moved to llist_eq.ML to allow
- automatic association between theory name and filename. *)
--- a/src/ZF/ex/llist_eq.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,72 +0,0 @@
-(* Title: ZF/ex/llist_eq.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Equality for llist(A) as a greatest fixed point
-***)
-
-(*Previously used <*> in the domain and variant pairs as elements. But
- standard pairs work just as well. To use variant pairs, must change prefix
- a q/Q to the Sigma, Pair and converse rules.*)
-
-structure LList_Eq = CoInductive_Fun
- (val thy = LList.thy addconsts [(["lleq"],"i=>i")]
- val rec_doms = [("lleq", "llist(A) * llist(A)")]
- val sintrs =
- ["<LNil, LNil> : lleq(A)",
- "[| a:A; <l,l'>: lleq(A) |] ==> <LCons(a,l), LCons(a,l')>: lleq(A)"]
- val monos = []
- val con_defs = []
- val type_intrs = LList.intrs @ [SigmaI]
- val type_elims = [SigmaE2]);
-
-(** Alternatives for above:
- val con_defs = LList.con_defs
- val type_intrs = codatatype_intrs
- val type_elims = [quniv_QPair_E]
-**)
-
-val lleq_cs = subset_cs
- addSIs [QPair_Int_Vset_subset_UN RS subset_trans, QPair_mono]
- addSEs [Ord_in_Ord, Pair_inject];
-
-(*Lemma for proving finality. Unfold the lazy list; use induction hypothesis*)
-goal LList_Eq.thy
- "!!i. Ord(i) ==> ALL l l'. <l,l'> : lleq(A) --> l Int Vset(i) <= l'";
-by (etac trans_induct 1);
-by (REPEAT (resolve_tac [allI, impI] 1));
-by (etac LList_Eq.elim 1);
-by (rewrite_goals_tac (QInr_def::LList.con_defs));
-by (safe_tac lleq_cs);
-by (fast_tac (subset_cs addSEs [Ord_trans, make_elim bspec]) 1);
-val lleq_Int_Vset_subset_lemma = result();
-
-val lleq_Int_Vset_subset = standard
- (lleq_Int_Vset_subset_lemma RS spec RS spec RS mp);
-
-
-(*lleq(A) is a symmetric relation because qconverse(lleq(A)) is a fixedpoint*)
-val [prem] = goal LList_Eq.thy "<l,l'> : lleq(A) ==> <l',l> : lleq(A)";
-by (rtac (prem RS converseI RS LList_Eq.coinduct) 1);
-by (rtac (LList_Eq.dom_subset RS converse_type) 1);
-by (safe_tac converse_cs);
-by (etac LList_Eq.elim 1);
-by (ALLGOALS (fast_tac qconverse_cs));
-val lleq_symmetric = result();
-
-goal LList_Eq.thy "!!l l'. <l,l'> : lleq(A) ==> l=l'";
-by (rtac equalityI 1);
-by (REPEAT (ares_tac [lleq_Int_Vset_subset RS Int_Vset_subset] 1
- ORELSE etac lleq_symmetric 1));
-val lleq_implies_equal = result();
-
-val [eqprem,lprem] = goal LList_Eq.thy
- "[| l=l'; l: llist(A) |] ==> <l,l'> : lleq(A)";
-by (res_inst_tac [("X", "{<l,l>. l: llist(A)}")] LList_Eq.coinduct 1);
-by (rtac (lprem RS RepFunI RS (eqprem RS subst)) 1);
-by (safe_tac qpair_cs);
-by (etac LList.elim 1);
-by (ALLGOALS (fast_tac pair_cs));
-val equal_llist_implies_leq = result();
-
--- a/src/ZF/ex/llistfn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,98 +0,0 @@
-(* Title: ZF/ex/llist-fn.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Functions for Lazy Lists in Zermelo-Fraenkel Set Theory
-
-Examples of coinduction for type-checking and to prove llist equations
-*)
-
-open LListFn;
-
-(*** lconst -- defined directly using lfp, but equivalent to a LList_corec ***)
-
-goalw LListFn.thy LList.con_defs "bnd_mono(univ(a), %l. LCons(a,l))";
-by (rtac bnd_monoI 1);
-by (REPEAT (ares_tac [subset_refl, QInr_mono, QPair_mono] 2));
-by (REPEAT (ares_tac [subset_refl, A_subset_univ,
- QInr_subset_univ, QPair_subset_univ] 1));
-val lconst_fun_bnd_mono = result();
-
-(* lconst(a) = LCons(a,lconst(a)) *)
-val lconst = standard
- ([lconst_def, lconst_fun_bnd_mono] MRS def_lfp_Tarski);
-
-val lconst_subset = lconst_def RS def_lfp_subset;
-
-val member_subset_Union_eclose = standard (arg_into_eclose RS Union_upper);
-
-goal LListFn.thy "!!a A. a : A ==> lconst(a) : quniv(A)";
-by (rtac (lconst_subset RS subset_trans RS qunivI) 1);
-by (etac (arg_into_eclose RS eclose_subset RS univ_mono) 1);
-val lconst_in_quniv = result();
-
-goal LListFn.thy "!!a A. a:A ==> lconst(a): llist(A)";
-by (rtac (singletonI RS LList.coinduct) 1);
-by (fast_tac (ZF_cs addSIs [lconst_in_quniv]) 1);
-by (fast_tac (ZF_cs addSIs [lconst]) 1);
-val lconst_type = result();
-
-(*** flip --- equations merely assumed; certain consequences proved ***)
-
-val flip_ss = ZF_ss addsimps [flip_LNil, flip_LCons, not_type];
-
-goal QUniv.thy "!!b. b:bool ==> b Int X <= univ(eclose(A))";
-by (fast_tac (quniv_cs addSEs [boolE]) 1);
-val bool_Int_subset_univ = result();
-
-val flip_cs = quniv_cs addSIs [not_type]
- addIs [bool_Int_subset_univ];
-
-(*Reasoning borrowed from llist_eq.ML; a similar proof works for all
- "productive" functions -- cf Coquand's "Infinite Objects in Type Theory".*)
-goal LListFn.thy
- "!!i. Ord(i) ==> ALL l: llist(bool). flip(l) Int Vset(i) <= \
-\ univ(eclose(bool))";
-by (etac trans_induct 1);
-by (rtac ballI 1);
-by (etac LList.elim 1);
-by (asm_simp_tac flip_ss 1);
-by (asm_simp_tac flip_ss 2);
-by (rewrite_goals_tac ([QInl_def,QInr_def]@LList.con_defs));
-(*LNil case*)
-by (fast_tac flip_cs 1);
-(*LCons case*)
-by (safe_tac flip_cs);
-by (ALLGOALS (fast_tac (flip_cs addSEs [Ord_trans, make_elim bspec])));
-val flip_llist_quniv_lemma = result();
-
-goal LListFn.thy "!!l. l: llist(bool) ==> flip(l) : quniv(bool)";
-by (rtac (flip_llist_quniv_lemma RS bspec RS Int_Vset_subset RS qunivI) 1);
-by (REPEAT (assume_tac 1));
-val flip_in_quniv = result();
-
-val [prem] = goal LListFn.thy "l : llist(bool) ==> flip(l): llist(bool)";
-by (res_inst_tac [("X", "{flip(l) . l:llist(bool)}")]
- LList.coinduct 1);
-by (rtac (prem RS RepFunI) 1);
-by (fast_tac (ZF_cs addSIs [flip_in_quniv]) 1);
-by (etac RepFunE 1);
-by (etac LList.elim 1);
-by (asm_simp_tac flip_ss 1);
-by (asm_simp_tac flip_ss 1);
-by (fast_tac (ZF_cs addSIs [not_type]) 1);
-val flip_type = result();
-
-val [prem] = goal LListFn.thy
- "l : llist(bool) ==> flip(flip(l)) = l";
-by (res_inst_tac [("X1", "{<flip(flip(l)),l> . l:llist(bool)}")]
- (LList_Eq.coinduct RS lleq_implies_equal) 1);
-by (rtac (prem RS RepFunI) 1);
-by (fast_tac (ZF_cs addSIs [flip_type]) 1);
-by (etac RepFunE 1);
-by (etac LList.elim 1);
-by (asm_simp_tac flip_ss 1);
-by (asm_simp_tac (flip_ss addsimps [flip_type, not_not]) 1);
-by (fast_tac (ZF_cs addSIs [not_type]) 1);
-val flip_flip = result();
--- a/src/ZF/ex/llistfn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-(* Title: ZF/ex/llist-fn.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Functions for Lazy Lists in Zermelo-Fraenkel Set Theory
-
-STILL NEEDS:
-co_recursion for defining lconst, flip, etc.
-a typing rule for it, based on some notion of "productivity..."
-*)
-
-LListFn = LList + LList_Eq +
-consts
- lconst :: "i => i"
- flip :: "i => i"
-
-rules
- lconst_def "lconst(a) == lfp(univ(a), %l. LCons(a,l))"
-
- flip_LNil "flip(LNil) = LNil"
-
- flip_LCons "[| x:bool; l: llist(bool) |] ==> \
-\ flip(LCons(x,l)) = LCons(not(x), flip(l))"
-
-end
--- a/src/ZF/ex/parcontract.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,144 +0,0 @@
-(* Title: ZF/ex/parcontract.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Parallel contraction
-
-HOL system proofs may be found in
-/usr/groups/theory/hvg-aftp/contrib/rule-induction/cl.ml
-*)
-
-structure ParContract = Inductive_Fun
- (val thy = Contract.thy;
- val rec_doms = [("parcontract","comb*comb")];
- val sintrs =
- ["[| p:comb |] ==> p =1=> p",
- "[| p:comb; q:comb |] ==> K#p#q =1=> p",
- "[| p:comb; q:comb; r:comb |] ==> S#p#q#r =1=> (p#r)#(q#r)",
- "[| p=1=>q; r=1=>s |] ==> p#r =1=> q#s"];
- val monos = [];
- val con_defs = [];
- val type_intrs = Comb.intrs@[SigmaI];
- val type_elims = [SigmaE2]);
-
-val [parcontract_refl,K_parcontract,S_parcontract,Ap_parcontract] = ParContract.intrs;
-
-val parcontract_induct = standard
- (ParContract.mutual_induct RS spec RS spec RSN (2,rev_mp));
-
-(*For type checking: replaces a=1=>b by a,b:comb *)
-val parcontract_combE2 = ParContract.dom_subset RS subsetD RS SigmaE2;
-val parcontract_combD1 = ParContract.dom_subset RS subsetD RS SigmaD1;
-val parcontract_combD2 = ParContract.dom_subset RS subsetD RS SigmaD2;
-
-goal ParContract.thy "field(parcontract) = comb";
-by (fast_tac (ZF_cs addIs [equalityI,K_parcontract]
- addSEs [parcontract_combE2]) 1);
-val field_parcontract_eq = result();
-
-val parcontract_caseE = standard
- (ParContract.unfold RS equalityD1 RS subsetD RS CollectE);
-
-(*Derive a case for each combinator constructor*)
-val K_parcontract_case = ParContract.mk_cases Comb.con_defs "K =1=> r";
-val S_parcontract_case = ParContract.mk_cases Comb.con_defs "S =1=> r";
-val Ap_parcontract_case = ParContract.mk_cases Comb.con_defs "p#q =1=> r";
-
-val parcontract_cs =
- ZF_cs addSIs Comb.intrs
- addIs ParContract.intrs
- addSEs [Ap_E, K_parcontract_case, S_parcontract_case,
- Ap_parcontract_case]
- addSEs [parcontract_combD1, parcontract_combD2] (*type checking*)
- addSEs Comb.free_SEs;
-
-(*** Basic properties of parallel contraction ***)
-
-goal ParContract.thy "!!p r. K#p =1=> r ==> (EX p'. r = K#p' & p =1=> p')";
-by (fast_tac parcontract_cs 1);
-val K1_parcontractD = result();
-
-goal ParContract.thy "!!p r. S#p =1=> r ==> (EX p'. r = S#p' & p =1=> p')";
-by (fast_tac parcontract_cs 1);
-val S1_parcontractD = result();
-
-goal ParContract.thy
- "!!p q r. S#p#q =1=> r ==> (EX p' q'. r = S#p'#q' & p =1=> p' & q =1=> q')";
-by (fast_tac (parcontract_cs addSDs [S1_parcontractD]) 1);
-val S2_parcontractD = result();
-
-(*Church-Rosser property for parallel contraction*)
-goalw ParContract.thy [diamond_def] "diamond(parcontract)";
-by (rtac (impI RS allI RS allI) 1);
-by (etac parcontract_induct 1);
-by (ALLGOALS
- (fast_tac (parcontract_cs addSDs [K1_parcontractD,S2_parcontractD])));
-val diamond_parcontract = result();
-
-(*** Transitive closure preserves the Church-Rosser property ***)
-
-goalw ParContract.thy [diamond_def]
- "!!x y r. [| diamond(r); <x,y>:r^+ |] ==> \
-\ ALL y'. <x,y'>:r --> (EX z. <y',z>: r^+ & <y,z>: r)";
-by (etac trancl_induct 1);
-by (fast_tac (ZF_cs addIs [r_into_trancl]) 1);
-by (slow_best_tac (ZF_cs addSDs [spec RS mp]
- addIs [r_into_trancl, trans_trancl RS transD]) 1);
-val diamond_trancl_lemma = result();
-
-val diamond_lemmaE = diamond_trancl_lemma RS spec RS mp RS exE;
-
-val [major] = goal ParContract.thy "diamond(r) ==> diamond(r^+)";
-bw diamond_def; (*unfold only in goal, not in premise!*)
-by (rtac (impI RS allI RS allI) 1);
-by (etac trancl_induct 1);
-by (ALLGOALS
- (slow_best_tac (ZF_cs addIs [r_into_trancl, trans_trancl RS transD]
- addEs [major RS diamond_lemmaE])));
-val diamond_trancl = result();
-
-
-(*** Equivalence of p--->q and p===>q ***)
-
-goal ParContract.thy "!!p q. p-1->q ==> p=1=>q";
-by (etac contract_induct 1);
-by (ALLGOALS (fast_tac (parcontract_cs)));
-val contract_imp_parcontract = result();
-
-goal ParContract.thy "!!p q. p--->q ==> p===>q";
-by (forward_tac [rtrancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_contract_eq RS equalityD1 RS subsetD) 1);
-by (etac rtrancl_induct 1);
-by (fast_tac (parcontract_cs addIs [r_into_trancl]) 1);
-by (fast_tac (ZF_cs addIs [contract_imp_parcontract,
- r_into_trancl, trans_trancl RS transD]) 1);
-val reduce_imp_parreduce = result();
-
-
-goal ParContract.thy "!!p q. p=1=>q ==> p--->q";
-by (etac parcontract_induct 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (fast_tac (contract_cs addIs reduction_rls) 1);
-by (rtac (trans_rtrancl RS transD) 1);
-by (ALLGOALS
- (fast_tac
- (contract_cs addIs [Ap_reduce1, Ap_reduce2]
- addSEs [parcontract_combD1,parcontract_combD2])));
-val parcontract_imp_reduce = result();
-
-goal ParContract.thy "!!p q. p===>q ==> p--->q";
-by (forward_tac [trancl_type RS subsetD RS SigmaD1] 1);
-by (dtac (field_parcontract_eq RS equalityD1 RS subsetD) 1);
-by (etac trancl_induct 1);
-by (etac parcontract_imp_reduce 1);
-by (etac (trans_rtrancl RS transD) 1);
-by (etac parcontract_imp_reduce 1);
-val parreduce_imp_reduce = result();
-
-goal ParContract.thy "p===>q <-> p--->q";
-by (REPEAT (ares_tac [iffI, parreduce_imp_reduce, reduce_imp_parreduce] 1));
-val parreduce_iff_reduce = result();
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/primrec0.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,395 +0,0 @@
-(* Title: ZF/ex/primrec
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Primitive Recursive Functions
-
-Proof adopted from
-Nora Szasz,
-A Machine Checked Proof that Ackermann's Function is not Primitive Recursive,
-In: Huet & Plotkin, eds., Logical Environments (CUP, 1993), 317-338.
-
-See also E. Mendelson, Introduction to Mathematical Logic.
-(Van Nostrand, 1964), page 250, exercise 11.
-*)
-
-open Primrec0;
-
-val pr0_typechecks =
- nat_typechecks @ List.intrs @
- [lam_type, list_case_type, drop_type, map_type, apply_type, rec_type];
-
-(** Useful special cases of evaluation ***)
-
-val pr0_ss = arith_ss
- addsimps List.case_eqns
- addsimps [list_rec_Nil, list_rec_Cons,
- drop_0, drop_Nil, drop_succ_Cons,
- map_Nil, map_Cons]
- setsolver (type_auto_tac pr0_typechecks);
-
-goalw Primrec0.thy [SC_def]
- "!!x l. [| x:nat; l: list(nat) |] ==> SC ` (Cons(x,l)) = succ(x)";
-by (asm_simp_tac pr0_ss 1);
-val SC = result();
-
-goalw Primrec0.thy [CONST_def]
- "!!l. [| l: list(nat) |] ==> CONST(k) ` l = k";
-by (asm_simp_tac pr0_ss 1);
-val CONST = result();
-
-goalw Primrec0.thy [PROJ_def]
- "!!l. [| x: nat; l: list(nat) |] ==> PROJ(0) ` (Cons(x,l)) = x";
-by (asm_simp_tac pr0_ss 1);
-val PROJ_0 = result();
-
-goalw Primrec0.thy [COMP_def]
- "!!l. [| l: list(nat) |] ==> COMP(g,[f]) ` l = g` [f`l]";
-by (asm_simp_tac pr0_ss 1);
-val COMP_1 = result();
-
-goalw Primrec0.thy [PREC_def]
- "!!l. l: list(nat) ==> PREC(f,g) ` (Cons(0,l)) = f`l";
-by (asm_simp_tac pr0_ss 1);
-val PREC_0 = result();
-
-goalw Primrec0.thy [PREC_def]
- "!!l. [| x:nat; l: list(nat) |] ==> \
-\ PREC(f,g) ` (Cons(succ(x),l)) = \
-\ g ` Cons(PREC(f,g)`(Cons(x,l)), Cons(x,l))";
-by (asm_simp_tac pr0_ss 1);
-val PREC_succ = result();
-
-(*** Inductive definition of the PR functions ***)
-
-structure Primrec = Inductive_Fun
- (val thy = Primrec0.thy
- val rec_doms = [("primrec", "list(nat)->nat")]
- val sintrs =
- ["SC : primrec",
- "k: nat ==> CONST(k) : primrec",
- "i: nat ==> PROJ(i) : primrec",
- "[| g: primrec; fs: list(primrec) |] ==> COMP(g,fs): primrec",
- "[| f: primrec; g: primrec |] ==> PREC(f,g): primrec"]
- val monos = [list_mono]
- val con_defs = [SC_def,CONST_def,PROJ_def,COMP_def,PREC_def]
- val type_intrs = pr0_typechecks
- val type_elims = []);
-
-
-(* c: primrec ==> c: list(nat) -> nat *)
-val primrec_into_fun = Primrec.dom_subset RS subsetD;
-
-val pr_ss = pr0_ss
- setsolver (type_auto_tac ([primrec_into_fun] @
- pr0_typechecks @ Primrec.intrs));
-
-goalw Primrec.thy [ACK_def] "!!i. i:nat ==> ACK(i): primrec";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac pr_ss));
-val ACK_in_primrec = result();
-
-val ack_typechecks =
- [ACK_in_primrec, primrec_into_fun RS apply_type,
- add_type, list_add_type, naturals_are_ordinals] @
- nat_typechecks @ List.intrs @ Primrec.intrs;
-
-(*strict typechecking for the Ackermann proof; instantiates no vars*)
-fun tc_tac rls =
- REPEAT
- (SOMEGOAL (test_assume_tac ORELSE' match_tac (rls @ ack_typechecks)));
-
-goal Primrec.thy "!!i j. [| i:nat; j:nat |] ==> ack(i,j): nat";
-by (tc_tac []);
-val ack_type = result();
-
-(** Ackermann's function cases **)
-
-(*PROPERTY A 1*)
-goalw Primrec0.thy [ACK_def] "!!j. j:nat ==> ack(0,j) = succ(j)";
-by (asm_simp_tac (pr0_ss addsimps [SC]) 1);
-val ack_0 = result();
-
-(*PROPERTY A 2*)
-goalw Primrec0.thy [ACK_def] "ack(succ(i), 0) = ack(i,1)";
-by (asm_simp_tac (pr0_ss addsimps [CONST,PREC_0]) 1);
-val ack_succ_0 = result();
-
-(*PROPERTY A 3*)
-(*Could be proved in Primrec0, like the previous two cases, but using
- primrec_into_fun makes type-checking easier!*)
-goalw Primrec.thy [ACK_def]
- "!!i j. [| i:nat; j:nat |] ==> \
-\ ack(succ(i), succ(j)) = ack(i, ack(succ(i), j))";
-by (asm_simp_tac (pr_ss addsimps [CONST,PREC_succ,COMP_1,PROJ_0]) 1);
-val ack_succ_succ = result();
-
-val ack_ss =
- pr_ss addsimps [ack_0, ack_succ_0, ack_succ_succ,
- ack_type, naturals_are_ordinals];
-
-(*PROPERTY A 4*)
-goal Primrec.thy "!!i. i:nat ==> ALL j:nat. j < ack(i,j)";
-by (etac nat_induct 1);
-by (asm_simp_tac ack_ss 1);
-by (rtac ballI 1);
-by (eres_inst_tac [("n","j")] nat_induct 1);
-by (DO_GOAL [rtac (nat_0I RS nat_0_le RS lt_trans),
- asm_simp_tac ack_ss] 1);
-by (DO_GOAL [etac (succ_leI RS lt_trans1),
- asm_simp_tac ack_ss] 1);
-val lt_ack2_lemma = result();
-val lt_ack2 = standard (lt_ack2_lemma RS bspec);
-
-(*PROPERTY A 5-, the single-step lemma*)
-goal Primrec.thy "!!i j. [| i:nat; j:nat |] ==> ack(i,j) < ack(i, succ(j))";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (ack_ss addsimps [lt_ack2])));
-val ack_lt_ack_succ2 = result();
-
-(*PROPERTY A 5, monotonicity for < *)
-goal Primrec.thy "!!i j k. [| j<k; i:nat; k:nat |] ==> ack(i,j) < ack(i,k)";
-by (forward_tac [lt_nat_in_nat] 1 THEN assume_tac 1);
-by (etac succ_lt_induct 1);
-by (assume_tac 1);
-by (rtac lt_trans 2);
-by (REPEAT (ares_tac ([ack_lt_ack_succ2, ack_type] @ pr0_typechecks) 1));
-val ack_lt_mono2 = result();
-
-(*PROPERTY A 5', monotonicity for le *)
-goal Primrec.thy
- "!!i j k. [| j le k; i: nat; k:nat |] ==> ack(i,j) le ack(i,k)";
-by (res_inst_tac [("f", "%j.ack(i,j)")] Ord_lt_mono_imp_le_mono 1);
-by (REPEAT (ares_tac [ack_lt_mono2, ack_type RS naturals_are_ordinals] 1));
-val ack_le_mono2 = result();
-
-(*PROPERTY A 6*)
-goal Primrec.thy
- "!!i j. [| i:nat; j:nat |] ==> ack(i, succ(j)) le ack(succ(i), j)";
-by (nat_ind_tac "j" [] 1);
-by (ALLGOALS (asm_simp_tac ack_ss));
-by (rtac ack_le_mono2 1);
-by (rtac (lt_ack2 RS succ_leI RS le_trans) 1);
-by (REPEAT (ares_tac (ack_typechecks) 1));
-val ack2_le_ack1 = result();
-
-(*PROPERTY A 7-, the single-step lemma*)
-goal Primrec.thy "!!i j. [| i:nat; j:nat |] ==> ack(i,j) < ack(succ(i),j)";
-by (rtac (ack_lt_mono2 RS lt_trans2) 1);
-by (rtac ack2_le_ack1 4);
-by (REPEAT (ares_tac ([nat_le_refl, ack_type] @ pr0_typechecks) 1));
-val ack_lt_ack_succ1 = result();
-
-(*PROPERTY A 7, monotonicity for < *)
-goal Primrec.thy "!!i j k. [| i<j; j:nat; k:nat |] ==> ack(i,k) < ack(j,k)";
-by (forward_tac [lt_nat_in_nat] 1 THEN assume_tac 1);
-by (etac succ_lt_induct 1);
-by (assume_tac 1);
-by (rtac lt_trans 2);
-by (REPEAT (ares_tac ([ack_lt_ack_succ1, ack_type] @ pr0_typechecks) 1));
-val ack_lt_mono1 = result();
-
-(*PROPERTY A 7', monotonicity for le *)
-goal Primrec.thy
- "!!i j k. [| i le j; j:nat; k:nat |] ==> ack(i,k) le ack(j,k)";
-by (res_inst_tac [("f", "%j.ack(j,k)")] Ord_lt_mono_imp_le_mono 1);
-by (REPEAT (ares_tac [ack_lt_mono1, ack_type RS naturals_are_ordinals] 1));
-val ack_le_mono1 = result();
-
-(*PROPERTY A 8*)
-goal Primrec.thy "!!j. j:nat ==> ack(1,j) = succ(succ(j))";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac ack_ss));
-val ack_1 = result();
-
-(*PROPERTY A 9*)
-goal Primrec.thy "!!j. j:nat ==> ack(succ(1),j) = succ(succ(succ(j#+j)))";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (ack_ss addsimps [ack_1, add_succ_right])));
-val ack_2 = result();
-
-(*PROPERTY A 10*)
-goal Primrec.thy
- "!!i1 i2 j. [| i1:nat; i2:nat; j:nat |] ==> \
-\ ack(i1, ack(i2,j)) < ack(succ(succ(i1#+i2)), j)";
-by (rtac (ack2_le_ack1 RSN (2,lt_trans2)) 1);
-by (asm_simp_tac ack_ss 1);
-by (rtac (add_le_self RS ack_le_mono1 RS lt_trans1) 1);
-by (rtac (add_le_self2 RS ack_lt_mono1 RS ack_lt_mono2) 5);
-by (tc_tac []);
-val ack_nest_bound = result();
-
-(*PROPERTY A 11*)
-goal Primrec.thy
- "!!i1 i2 j. [| i1:nat; i2:nat; j:nat |] ==> \
-\ ack(i1,j) #+ ack(i2,j) < ack(succ(succ(succ(succ(i1#+i2)))), j)";
-by (res_inst_tac [("j", "ack(succ(1), ack(i1 #+ i2, j))")] lt_trans 1);
-by (asm_simp_tac (ack_ss addsimps [ack_2]) 1);
-by (rtac (ack_nest_bound RS lt_trans2) 2);
-by (asm_simp_tac ack_ss 5);
-by (rtac (add_le_mono RS leI RS leI) 1);
-by (REPEAT (ares_tac ([add_le_self, add_le_self2, ack_le_mono1] @
- ack_typechecks) 1));
-val ack_add_bound = result();
-
-(*PROPERTY A 12. Article uses existential quantifier but the ALF proof
- used k#+4. Quantified version must be nested EX k'. ALL i,j... *)
-goal Primrec.thy
- "!!i j k. [| i < ack(k,j); j:nat; k:nat |] ==> \
-\ i#+j < ack(succ(succ(succ(succ(k)))), j)";
-by (res_inst_tac [("j", "ack(k,j) #+ ack(0,j)")] lt_trans 1);
-by (rtac (ack_add_bound RS lt_trans2) 2);
-by (asm_simp_tac (ack_ss addsimps [add_0_right]) 5);
-by (REPEAT (ares_tac ([add_lt_mono, lt_ack2] @ ack_typechecks) 1));
-val ack_add_bound2 = result();
-
-(*** MAIN RESULT ***)
-
-val ack2_ss =
- ack_ss addsimps [list_add_Nil, list_add_Cons, list_add_type,
- naturals_are_ordinals];
-
-goalw Primrec.thy [SC_def]
- "!!l. l: list(nat) ==> SC ` l < ack(1, list_add(l))";
-by (etac List.elim 1);
-by (asm_simp_tac (ack2_ss addsimps [succ_iff]) 1);
-by (asm_simp_tac (ack2_ss addsimps [ack_1, add_le_self]) 1);
-val SC_case = result();
-
-(*PROPERTY A 4'? Extra lemma needed for CONST case, constant functions*)
-goal Primrec.thy "!!j. [| i:nat; j:nat |] ==> i < ack(i,j)";
-by (etac nat_induct 1);
-by (asm_simp_tac (ack_ss addsimps [nat_0_le]) 1);
-by (etac ([succ_leI, ack_lt_ack_succ1] MRS lt_trans1) 1);
-by (tc_tac []);
-val lt_ack1 = result();
-
-goalw Primrec.thy [CONST_def]
- "!!l. [| l: list(nat); k: nat |] ==> CONST(k) ` l < ack(k, list_add(l))";
-by (asm_simp_tac (ack2_ss addsimps [lt_ack1]) 1);
-val CONST_case = result();
-
-goalw Primrec.thy [PROJ_def]
- "!!l. l: list(nat) ==> ALL i:nat. PROJ(i) ` l < ack(0, list_add(l))";
-by (asm_simp_tac ack2_ss 1);
-by (etac List.induct 1);
-by (asm_simp_tac (ack2_ss addsimps [nat_0_le]) 1);
-by (asm_simp_tac ack2_ss 1);
-by (rtac ballI 1);
-by (eres_inst_tac [("n","x")] natE 1);
-by (asm_simp_tac (ack2_ss addsimps [add_le_self]) 1);
-by (asm_simp_tac ack2_ss 1);
-by (etac (bspec RS lt_trans2) 1);
-by (rtac (add_le_self2 RS succ_leI) 2);
-by (tc_tac []);
-val PROJ_case_lemma = result();
-val PROJ_case = PROJ_case_lemma RS bspec;
-
-(** COMP case **)
-
-goal Primrec.thy
- "!!fs. fs : list({f: primrec . \
-\ EX kf:nat. ALL l:list(nat). \
-\ f`l < ack(kf, list_add(l))}) \
-\ ==> EX k:nat. ALL l: list(nat). \
-\ list_add(map(%f. f ` l, fs)) < ack(k, list_add(l))";
-by (etac List.induct 1);
-by (DO_GOAL [res_inst_tac [("x","0")] bexI,
- asm_simp_tac (ack2_ss addsimps [lt_ack1, nat_0_le]),
- resolve_tac nat_typechecks] 1);
-by (safe_tac ZF_cs);
-by (asm_simp_tac ack2_ss 1);
-by (rtac (ballI RS bexI) 1);
-by (rtac (add_lt_mono RS lt_trans) 1);
-by (REPEAT (FIRSTGOAL (etac bspec)));
-by (rtac ack_add_bound 5);
-by (tc_tac []);
-val COMP_map_lemma = result();
-
-goalw Primrec.thy [COMP_def]
- "!!g. [| g: primrec; kg: nat; \
-\ ALL l:list(nat). g`l < ack(kg, list_add(l)); \
-\ fs : list({f: primrec . \
-\ EX kf:nat. ALL l:list(nat). \
-\ f`l < ack(kf, list_add(l))}) \
-\ |] ==> EX k:nat. ALL l: list(nat). COMP(g,fs)`l < ack(k, list_add(l))";
-by (asm_simp_tac ZF_ss 1);
-by (forward_tac [list_CollectD] 1);
-by (etac (COMP_map_lemma RS bexE) 1);
-by (rtac (ballI RS bexI) 1);
-by (etac (bspec RS lt_trans) 1);
-by (rtac lt_trans 2);
-by (rtac ack_nest_bound 3);
-by (etac (bspec RS ack_lt_mono2) 2);
-by (tc_tac [map_type]);
-val COMP_case = result();
-
-(** PREC case **)
-
-goalw Primrec.thy [PREC_def]
- "!!f g. [| ALL l:list(nat). f`l #+ list_add(l) < ack(kf, list_add(l)); \
-\ ALL l:list(nat). g`l #+ list_add(l) < ack(kg, list_add(l)); \
-\ f: primrec; kf: nat; \
-\ g: primrec; kg: nat; \
-\ l: list(nat) \
-\ |] ==> PREC(f,g)`l #+ list_add(l) < ack(succ(kf#+kg), list_add(l))";
-by (etac List.elim 1);
-by (asm_simp_tac (ack2_ss addsimps [[nat_le_refl, lt_ack2] MRS lt_trans]) 1);
-by (asm_simp_tac ack2_ss 1);
-by (etac ssubst 1); (*get rid of the needless assumption*)
-by (eres_inst_tac [("n","a")] nat_induct 1);
-(*base case*)
-by (DO_GOAL [asm_simp_tac ack2_ss, rtac lt_trans, etac bspec,
- assume_tac, rtac (add_le_self RS ack_lt_mono1),
- REPEAT o ares_tac (ack_typechecks)] 1);
-(*ind step*)
-by (asm_simp_tac (ack2_ss addsimps [add_succ_right]) 1);
-by (rtac (succ_leI RS lt_trans1) 1);
-by (res_inst_tac [("j", "g ` ?ll #+ ?mm")] lt_trans1 1);
-by (etac bspec 2);
-by (rtac (nat_le_refl RS add_le_mono) 1);
-by (tc_tac []);
-by (asm_simp_tac (ack2_ss addsimps [add_le_self2]) 1);
-(*final part of the simplification*)
-by (asm_simp_tac ack2_ss 1);
-by (rtac (add_le_self2 RS ack_le_mono1 RS lt_trans1) 1);
-by (etac ack_lt_mono2 5);
-by (tc_tac []);
-val PREC_case_lemma = result();
-
-goal Primrec.thy
- "!!f g. [| f: primrec; kf: nat; \
-\ g: primrec; kg: nat; \
-\ ALL l:list(nat). f`l < ack(kf, list_add(l)); \
-\ ALL l:list(nat). g`l < ack(kg, list_add(l)) \
-\ |] ==> EX k:nat. ALL l: list(nat). \
-\ PREC(f,g)`l< ack(k, list_add(l))";
-by (rtac (ballI RS bexI) 1);
-by (rtac ([add_le_self, PREC_case_lemma] MRS lt_trans1) 1);
-by (REPEAT
- (SOMEGOAL
- (FIRST' [test_assume_tac,
- match_tac (ack_typechecks),
- rtac (ack_add_bound2 RS ballI) THEN' etac bspec])));
-val PREC_case = result();
-
-goal Primrec.thy
- "!!f. f:primrec ==> EX k:nat. ALL l:list(nat). f`l < ack(k, list_add(l))";
-by (etac Primrec.induct 1);
-by (safe_tac ZF_cs);
-by (DEPTH_SOLVE
- (ares_tac ([SC_case, CONST_case, PROJ_case, COMP_case, PREC_case,
- bexI, ballI] @ nat_typechecks) 1));
-val ack_bounds_primrec = result();
-
-goal Primrec.thy
- "~ (lam l:list(nat). list_case(0, %x xs. ack(x,x), l)) : primrec";
-by (rtac notI 1);
-by (etac (ack_bounds_primrec RS bexE) 1);
-by (rtac lt_anti_refl 1);
-by (dres_inst_tac [("x", "[x]")] bspec 1);
-by (asm_simp_tac ack2_ss 1);
-by (asm_full_simp_tac (ack2_ss addsimps [add_0_right]) 1);
-val ack_not_primrec = result();
-
--- a/src/ZF/ex/primrec0.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,49 +0,0 @@
-(* Title: ZF/ex/primrec.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Primitive Recursive Functions
-
-Proof adopted from
-Nora Szasz,
-A Machine Checked Proof that Ackermann's Function is not Primitive Recursive,
-In: Huet & Plotkin, eds., Logical Environments (CUP, 1993), 317-338.
-
-See also E. Mendelson, Introduction to Mathematical Logic.
-(Van Nostrand, 1964), page 250, exercise 11.
-*)
-
-Primrec0 = ListFn +
-consts
- SC :: "i"
- CONST :: "i=>i"
- PROJ :: "i=>i"
- COMP :: "[i,i]=>i"
- PREC :: "[i,i]=>i"
- primrec :: "i"
- ACK :: "i=>i"
- ack :: "[i,i]=>i"
-
-translations
- "ack(x,y)" == "ACK(x) ` [y]"
-
-rules
-
- SC_def "SC == lam l:list(nat).list_case(0, %x xs.succ(x), l)"
-
- CONST_def "CONST(k) == lam l:list(nat).k"
-
- PROJ_def "PROJ(i) == lam l:list(nat). list_case(0, %x xs.x, drop(i,l))"
-
- COMP_def "COMP(g,fs) == lam l:list(nat). g ` map(%f. f`l, fs)"
-
- (*Note that g is applied first to PREC(f,g)`y and then to y!*)
- PREC_def "PREC(f,g) == \
-\ lam l:list(nat). list_case(0, \
-\ %x xs. rec(x, f`xs, %y r. g ` Cons(r, Cons(y, xs))), l)"
-
- ACK_def "ACK(i) == rec(i, SC, \
-\ %z r. PREC (CONST (r`[1]), COMP(r,[PROJ(0)])))"
-
-end
--- a/src/ZF/ex/prop.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,37 +0,0 @@
-(* Title: ZF/ex/prop.ML
- ID: $Id$
- Author: Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Datatype definition of propositional logic formulae and inductive definition
-of the propositional tautologies.
-*)
-
-(*Example of a datatype with mixfix syntax for some constructors*)
-structure Prop = Datatype_Fun
- (val thy = Univ.thy;
- val rec_specs =
- [("prop", "univ(0)",
- [(["Fls"], "i"),
- (["Var"], "i=>i"),
- (["op =>"], "[i,i]=>i")])];
- val rec_styp = "i";
- val ext = Some (Syntax.simple_sext
- [Mixfix("#_", "i => i", "Var", [100], 100),
- Infixr("=>", "[i,i] => i", 90)]);
- val sintrs =
- ["Fls : prop",
- "n: nat ==> #n : prop",
- "[| p: prop; q: prop |] ==> p=>q : prop"];
- val monos = [];
- val type_intrs = datatype_intrs;
- val type_elims = []);
-
-val [FlsI,VarI,ImpI] = Prop.intrs;
-
-
-(** Type-checking rules **)
-
-val ImpE = Prop.mk_cases Prop.con_defs "p=>q : prop";
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/proplog.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,327 +0,0 @@
-(* Title: ZF/ex/prop-log.ML
- ID: $Id$
- Author: Tobias Nipkow & Lawrence C Paulson
- Copyright 1992 University of Cambridge
-
-For ex/prop-log.thy. Inductive definition of propositional logic.
-Soundness and completeness w.r.t. truth-tables.
-
-Prove: If H|=p then G|=p where G:Fin(H)
-*)
-
-open PropLog;
-
-(*** prop_rec -- by Vset recursion ***)
-
-(** conversion rules **)
-
-goal PropLog.thy "prop_rec(Fls,b,c,d) = b";
-by (rtac (prop_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Prop.con_defs);
-by (simp_tac rank_ss 1);
-val prop_rec_Fls = result();
-
-goal PropLog.thy "prop_rec(#v,b,c,d) = c(v)";
-by (rtac (prop_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Prop.con_defs);
-by (simp_tac rank_ss 1);
-val prop_rec_Var = result();
-
-goal PropLog.thy "prop_rec(p=>q,b,c,d) = \
-\ d(p, q, prop_rec(p,b,c,d), prop_rec(q,b,c,d))";
-by (rtac (prop_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Prop.con_defs);
-by (simp_tac rank_ss 1);
-val prop_rec_Imp = result();
-
-val prop_rec_ss =
- arith_ss addsimps [prop_rec_Fls, prop_rec_Var, prop_rec_Imp];
-
-(*** Semantics of propositional logic ***)
-
-(** The function is_true **)
-
-goalw PropLog.thy [is_true_def] "is_true(Fls,t) <-> False";
-by (simp_tac (prop_rec_ss addsimps [one_not_0 RS not_sym]) 1);
-val is_true_Fls = result();
-
-goalw PropLog.thy [is_true_def] "is_true(#v,t) <-> v:t";
-by (simp_tac (prop_rec_ss addsimps [one_not_0 RS not_sym]
- setloop (split_tac [expand_if])) 1);
-val is_true_Var = result();
-
-goalw PropLog.thy [is_true_def]
- "is_true(p=>q,t) <-> (is_true(p,t)-->is_true(q,t))";
-by (simp_tac (prop_rec_ss setloop (split_tac [expand_if])) 1);
-val is_true_Imp = result();
-
-(** The function hyps **)
-
-goalw PropLog.thy [hyps_def] "hyps(Fls,t) = 0";
-by (simp_tac prop_rec_ss 1);
-val hyps_Fls = result();
-
-goalw PropLog.thy [hyps_def] "hyps(#v,t) = {if(v:t, #v, #v=>Fls)}";
-by (simp_tac prop_rec_ss 1);
-val hyps_Var = result();
-
-goalw PropLog.thy [hyps_def] "hyps(p=>q,t) = hyps(p,t) Un hyps(q,t)";
-by (simp_tac prop_rec_ss 1);
-val hyps_Imp = result();
-
-val prop_ss = prop_rec_ss
- addsimps Prop.intrs
- addsimps [is_true_Fls, is_true_Var, is_true_Imp,
- hyps_Fls, hyps_Var, hyps_Imp];
-
-(*** Proof theory of propositional logic ***)
-
-structure PropThms = Inductive_Fun
- (val thy = PropLog.thy;
- val rec_doms = [("thms","prop")];
- val sintrs =
- ["[| p:H; p:prop |] ==> H |- p",
- "[| p:prop; q:prop |] ==> H |- p=>q=>p",
- "[| p:prop; q:prop; r:prop |] ==> H |- (p=>q=>r) => (p=>q) => p=>r",
- "p:prop ==> H |- ((p=>Fls) => Fls) => p",
- "[| H |- p=>q; H |- p; p:prop; q:prop |] ==> H |- q"];
- val monos = [];
- val con_defs = [];
- val type_intrs = Prop.intrs;
- val type_elims = []);
-
-goalw PropThms.thy PropThms.defs "!!G H. G<=H ==> thms(G) <= thms(H)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac PropThms.bnd_mono 1));
-by (REPEAT (ares_tac (univ_mono::basic_monos) 1));
-val thms_mono = result();
-
-val thms_in_pl = PropThms.dom_subset RS subsetD;
-
-val [thms_H, thms_K, thms_S, thms_DN, weak_thms_MP] = PropThms.intrs;
-
-(*Modus Ponens rule -- this stronger version avoids typecheck*)
-goal PropThms.thy "!!p q H. [| H |- p=>q; H |- p |] ==> H |- q";
-by (rtac weak_thms_MP 1);
-by (REPEAT (eresolve_tac [asm_rl, thms_in_pl, thms_in_pl RS ImpE] 1));
-val thms_MP = result();
-
-(*Rule is called I for Identity Combinator, not for Introduction*)
-goal PropThms.thy "!!p H. p:prop ==> H |- p=>p";
-by (rtac (thms_S RS thms_MP RS thms_MP) 1);
-by (rtac thms_K 5);
-by (rtac thms_K 4);
-by (REPEAT (ares_tac [ImpI] 1));
-val thms_I = result();
-
-(** Weakening, left and right **)
-
-(* [| G<=H; G|-p |] ==> H|-p Order of premises is convenient with RS*)
-val weaken_left = standard (thms_mono RS subsetD);
-
-(* H |- p ==> cons(a,H) |- p *)
-val weaken_left_cons = subset_consI RS weaken_left;
-
-val weaken_left_Un1 = Un_upper1 RS weaken_left;
-val weaken_left_Un2 = Un_upper2 RS weaken_left;
-
-goal PropThms.thy "!!H p q. [| H |- q; p:prop |] ==> H |- p=>q";
-by (rtac (thms_K RS thms_MP) 1);
-by (REPEAT (ares_tac [thms_in_pl] 1));
-val weaken_right = result();
-
-(*The deduction theorem*)
-goal PropThms.thy "!!p q H. [| cons(p,H) |- q; p:prop |] ==> H |- p=>q";
-by (etac PropThms.induct 1);
-by (fast_tac (ZF_cs addIs [thms_I, thms_H RS weaken_right]) 1);
-by (fast_tac (ZF_cs addIs [thms_K RS weaken_right]) 1);
-by (fast_tac (ZF_cs addIs [thms_S RS weaken_right]) 1);
-by (fast_tac (ZF_cs addIs [thms_DN RS weaken_right]) 1);
-by (fast_tac (ZF_cs addIs [thms_S RS thms_MP RS thms_MP]) 1);
-val deduction = result();
-
-
-(*The cut rule*)
-goal PropThms.thy "!!H p q. [| H|-p; cons(p,H) |- q |] ==> H |- q";
-by (rtac (deduction RS thms_MP) 1);
-by (REPEAT (ares_tac [thms_in_pl] 1));
-val cut = result();
-
-goal PropThms.thy "!!H p. [| H |- Fls; p:prop |] ==> H |- p";
-by (rtac (thms_DN RS thms_MP) 1);
-by (rtac weaken_right 2);
-by (REPEAT (ares_tac (Prop.intrs@[consI1]) 1));
-val thms_FlsE = result();
-
-(* [| H |- p=>Fls; H |- p; q: prop |] ==> H |- q *)
-val thms_notE = standard (thms_MP RS thms_FlsE);
-
-(*Soundness of the rules wrt truth-table semantics*)
-goalw PropThms.thy [sat_def] "!!H. H |- p ==> H |= p";
-by (etac PropThms.induct 1);
-by (fast_tac (ZF_cs addSDs [is_true_Imp RS iffD1 RS mp]) 5);
-by (ALLGOALS (asm_simp_tac prop_ss));
-val soundness = result();
-
-(*** Towards the completeness proof ***)
-
-val [premf,premq] = goal PropThms.thy
- "[| H |- p=>Fls; q: prop |] ==> H |- p=>q";
-by (rtac (premf RS thms_in_pl RS ImpE) 1);
-by (rtac deduction 1);
-by (rtac (premf RS weaken_left_cons RS thms_notE) 1);
-by (REPEAT (ares_tac [premq, consI1, thms_H] 1));
-val Fls_Imp = result();
-
-val [premp,premq] = goal PropThms.thy
- "[| H |- p; H |- q=>Fls |] ==> H |- (p=>q)=>Fls";
-by (cut_facts_tac ([premp,premq] RL [thms_in_pl]) 1);
-by (etac ImpE 1);
-by (rtac deduction 1);
-by (rtac (premq RS weaken_left_cons RS thms_MP) 1);
-by (rtac (consI1 RS thms_H RS thms_MP) 1);
-by (rtac (premp RS weaken_left_cons) 2);
-by (REPEAT (ares_tac Prop.intrs 1));
-val Imp_Fls = result();
-
-(*Typical example of strengthening the induction formula*)
-val [major] = goal PropThms.thy
- "p: prop ==> hyps(p,t) |- if(is_true(p,t), p, p=>Fls)";
-by (rtac (expand_if RS iffD2) 1);
-by (rtac (major RS Prop.induct) 1);
-by (ALLGOALS (asm_simp_tac (prop_ss addsimps [thms_I, thms_H])));
-by (safe_tac (ZF_cs addSEs [Fls_Imp RS weaken_left_Un1,
- Fls_Imp RS weaken_left_Un2]));
-by (ALLGOALS (fast_tac (ZF_cs addIs [weaken_left_Un1, weaken_left_Un2,
- weaken_right, Imp_Fls])));
-val hyps_thms_if = result();
-
-(*Key lemma for completeness; yields a set of assumptions satisfying p*)
-val [premp,sat] = goalw PropThms.thy [sat_def]
- "[| p: prop; 0 |= p |] ==> hyps(p,t) |- p";
-by (rtac (sat RS spec RS mp RS if_P RS subst) 1 THEN
- rtac (premp RS hyps_thms_if) 2);
-by (fast_tac ZF_cs 1);
-val sat_thms_p = result();
-
-(*For proving certain theorems in our new propositional logic*)
-val thms_cs =
- ZF_cs addSIs [FlsI, VarI, ImpI, deduction]
- addIs [thms_in_pl, thms_H, thms_H RS thms_MP];
-
-(*The excluded middle in the form of an elimination rule*)
-val prems = goal PropThms.thy
- "[| p: prop; q: prop |] ==> H |- (p=>q) => ((p=>Fls)=>q) => q";
-by (rtac (deduction RS deduction) 1);
-by (rtac (thms_DN RS thms_MP) 1);
-by (ALLGOALS (best_tac (thms_cs addSIs prems)));
-val thms_excluded_middle = result();
-
-(*Hard to prove directly because it requires cuts*)
-val prems = goal PropThms.thy
- "[| cons(p,H) |- q; cons(p=>Fls,H) |- q; p: prop |] ==> H |- q";
-by (rtac (thms_excluded_middle RS thms_MP RS thms_MP) 1);
-by (REPEAT (resolve_tac (prems@Prop.intrs@[deduction,thms_in_pl]) 1));
-val thms_excluded_middle_rule = result();
-
-(*** Completeness -- lemmas for reducing the set of assumptions ***)
-
-(*For the case hyps(p,t)-cons(#v,Y) |- p;
- we also have hyps(p,t)-{#v} <= hyps(p, t-{v}) *)
-val [major] = goal PropThms.thy
- "p: prop ==> hyps(p, t-{v}) <= cons(#v=>Fls, hyps(p,t)-{#v})";
-by (rtac (major RS Prop.induct) 1);
-by (simp_tac prop_ss 1);
-by (asm_simp_tac (prop_ss setloop (split_tac [expand_if])) 1);
-by (fast_tac (ZF_cs addSEs Prop.free_SEs) 1);
-by (asm_simp_tac prop_ss 1);
-by (fast_tac ZF_cs 1);
-val hyps_Diff = result();
-
-(*For the case hyps(p,t)-cons(#v => Fls,Y) |- p;
- we also have hyps(p,t)-{#v=>Fls} <= hyps(p, cons(v,t)) *)
-val [major] = goal PropThms.thy
- "p: prop ==> hyps(p, cons(v,t)) <= cons(#v, hyps(p,t)-{#v=>Fls})";
-by (rtac (major RS Prop.induct) 1);
-by (simp_tac prop_ss 1);
-by (asm_simp_tac (prop_ss setloop (split_tac [expand_if])) 1);
-by (fast_tac (ZF_cs addSEs Prop.free_SEs) 1);
-by (asm_simp_tac prop_ss 1);
-by (fast_tac ZF_cs 1);
-val hyps_cons = result();
-
-(** Two lemmas for use with weaken_left **)
-
-goal ZF.thy "B-C <= cons(a, B-cons(a,C))";
-by (fast_tac ZF_cs 1);
-val cons_Diff_same = result();
-
-goal ZF.thy "cons(a, B-{c}) - D <= cons(a, B-cons(c,D))";
-by (fast_tac ZF_cs 1);
-val cons_Diff_subset2 = result();
-
-(*The set hyps(p,t) is finite, and elements have the form #v or #v=>Fls;
- could probably prove the stronger hyps(p,t) : Fin(hyps(p,0) Un hyps(p,nat))*)
-val [major] = goal PropThms.thy
- "p: prop ==> hyps(p,t) : Fin(UN v:nat. {#v, #v=>Fls})";
-by (rtac (major RS Prop.induct) 1);
-by (asm_simp_tac (prop_ss addsimps [Fin_0I, Fin_consI, UN_I, cons_iff]
- setloop (split_tac [expand_if])) 2);
-by (ALLGOALS (asm_simp_tac (prop_ss addsimps [Un_0, Fin_0I, Fin_UnI])));
-val hyps_finite = result();
-
-val Diff_weaken_left = subset_refl RSN (2, Diff_mono) RS weaken_left;
-
-(*Induction on the finite set of assumptions hyps(p,t0).
- We may repeatedly subtract assumptions until none are left!*)
-val [premp,sat] = goal PropThms.thy
- "[| p: prop; 0 |= p |] ==> ALL t. hyps(p,t) - hyps(p,t0) |- p";
-by (rtac (premp RS hyps_finite RS Fin_induct) 1);
-by (simp_tac (prop_ss addsimps [premp, sat, sat_thms_p, Diff_0]) 1);
-by (safe_tac ZF_cs);
-(*Case hyps(p,t)-cons(#v,Y) |- p *)
-by (rtac thms_excluded_middle_rule 1);
-by (etac VarI 3);
-by (rtac (cons_Diff_same RS weaken_left) 1);
-by (etac spec 1);
-by (rtac (cons_Diff_subset2 RS weaken_left) 1);
-by (rtac (premp RS hyps_Diff RS Diff_weaken_left) 1);
-by (etac spec 1);
-(*Case hyps(p,t)-cons(#v => Fls,Y) |- p *)
-by (rtac thms_excluded_middle_rule 1);
-by (etac VarI 3);
-by (rtac (cons_Diff_same RS weaken_left) 2);
-by (etac spec 2);
-by (rtac (cons_Diff_subset2 RS weaken_left) 1);
-by (rtac (premp RS hyps_cons RS Diff_weaken_left) 1);
-by (etac spec 1);
-val completeness_0_lemma = result();
-
-(*The base case for completeness*)
-val [premp,sat] = goal PropThms.thy "[| p: prop; 0 |= p |] ==> 0 |- p";
-by (rtac (Diff_cancel RS subst) 1);
-by (rtac (sat RS (premp RS completeness_0_lemma RS spec)) 1);
-val completeness_0 = result();
-
-(*A semantic analogue of the Deduction Theorem*)
-goalw PropThms.thy [sat_def] "!!H p q. [| cons(p,H) |= q |] ==> H |= p=>q";
-by (simp_tac prop_ss 1);
-by (fast_tac ZF_cs 1);
-val sat_Imp = result();
-
-goal PropThms.thy "!!H. H: Fin(prop) ==> ALL p:prop. H |= p --> H |- p";
-by (etac Fin_induct 1);
-by (safe_tac (ZF_cs addSIs [completeness_0]));
-by (rtac (weaken_left_cons RS thms_MP) 1);
-by (fast_tac (ZF_cs addSIs [sat_Imp,ImpI]) 1);
-by (fast_tac thms_cs 1);
-val completeness_lemma = result();
-
-val completeness = completeness_lemma RS bspec RS mp;
-
-val [finite] = goal PropThms.thy "H: Fin(prop) ==> H |- p <-> H |= p & p:prop";
-by (fast_tac (ZF_cs addSEs [soundness, finite RS completeness,
- thms_in_pl]) 1);
-val thms_iff = result();
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/proplog.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,43 +0,0 @@
-(* Title: ZF/ex/prop-log.thy
- ID: $Id$
- Author: Tobias Nipkow & Lawrence C Paulson
- Copyright 1993 University of Cambridge
-
-Inductive definition of propositional logic.
-*)
-
-PropLog = Prop + Fin +
-consts
- (*semantics*)
- prop_rec :: "[i, i, i=>i, [i,i,i,i]=>i] => i"
- is_true :: "[i,i] => o"
- "|=" :: "[i,i] => o" (infixl 50)
- hyps :: "[i,i] => i"
-
- (*proof theory*)
- thms :: "i => i"
- "|-" :: "[i,i] => o" (infixl 50)
-
-translations
- "H |- p" == "p : thms(H)"
-
-rules
-
- prop_rec_def
- "prop_rec(p,b,c,h) == \
-\ Vrec(p, %p g.prop_case(b, c, %x y. h(x, y, g`x, g`y), p))"
-
- (** Semantics of propositional logic **)
- is_true_def
- "is_true(p,t) == prop_rec(p, 0, %v. if(v:t, 1, 0), \
-\ %p q tp tq. if(tp=1,tq,1)) = 1"
-
- (*For every valuation, if all elements of H are true then so is p*)
- sat_def "H |= p == ALL t. (ALL q:H. is_true(q,t)) --> is_true(p,t)"
-
- (** A finite set of hypotheses from t and the Vars in p **)
- hyps_def
- "hyps(p,t) == prop_rec(p, 0, %v. {if(v:t, #v, #v=>Fls)}, \
-\ %p q Hp Hq. Hp Un Hq)"
-
-end
--- a/src/ZF/ex/ramsey.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,234 +0,0 @@
-(* Title: ZF/ex/ramsey.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Ramsey's Theorem (finite exponent 2 version)
-
-Based upon the article
- D Basin and M Kaufmann,
- The Boyer-Moore Prover and Nuprl: An Experimental Comparison.
- In G Huet and G Plotkin, editors, Logical Frameworks.
- (CUP, 1991), pages 89--119
-
-See also
- M Kaufmann,
- An example in NQTHM: Ramsey's Theorem
- Internal Note, Computational Logic, Inc., Austin, Texas 78703
- Available from the author: kaufmann@cli.com
-*)
-
-open Ramsey;
-
-(*** Cliques and Independent sets ***)
-
-goalw Ramsey.thy [Clique_def] "Clique(0,V,E)";
-by (fast_tac ZF_cs 1);
-val Clique0 = result();
-
-goalw Ramsey.thy [Clique_def]
- "!!C V E. [| Clique(C,V',E); V'<=V |] ==> Clique(C,V,E)";
-by (fast_tac ZF_cs 1);
-val Clique_superset = result();
-
-goalw Ramsey.thy [Indept_def] "Indept(0,V,E)";
-by (fast_tac ZF_cs 1);
-val Indept0 = result();
-
-val prems = goalw Ramsey.thy [Indept_def]
- "!!I V E. [| Indept(I,V',E); V'<=V |] ==> Indept(I,V,E)";
-by (fast_tac ZF_cs 1);
-val Indept_superset = result();
-
-(*** Atleast ***)
-
-goalw Ramsey.thy [Atleast_def,inj_def] "Atleast(0,A)";
-by (fast_tac (ZF_cs addIs [PiI]) 1);
-val Atleast0 = result();
-
-val [major] = goalw Ramsey.thy [Atleast_def]
- "Atleast(succ(m),A) ==> EX x:A. Atleast(m, A-{x})";
-by (rtac (major RS exE) 1);
-by (rtac bexI 1);
-by (etac (inj_is_fun RS apply_type) 2);
-by (rtac succI1 2);
-by (rtac exI 1);
-by (etac inj_succ_restrict 1);
-val Atleast_succD = result();
-
-val major::prems = goalw Ramsey.thy [Atleast_def]
- "[| Atleast(n,A); A<=B |] ==> Atleast(n,B)";
-by (rtac (major RS exE) 1);
-by (rtac exI 1);
-by (etac inj_weaken_type 1);
-by (resolve_tac prems 1);
-val Atleast_superset = result();
-
-val prems = goalw Ramsey.thy [Atleast_def,succ_def]
- "[| Atleast(m,B); b~: B |] ==> Atleast(succ(m), cons(b,B))";
-by (cut_facts_tac prems 1);
-by (etac exE 1);
-by (rtac exI 1);
-by (etac inj_extend 1);
-by (rtac mem_not_refl 1);
-by (assume_tac 1);
-val Atleast_succI = result();
-
-val prems = goal Ramsey.thy
- "[| Atleast(m, B-{x}); x: B |] ==> Atleast(succ(m), B)";
-by (cut_facts_tac prems 1);
-by (etac (Atleast_succI RS Atleast_superset) 1);
-by (fast_tac ZF_cs 1);
-by (fast_tac ZF_cs 1);
-val Atleast_Diff_succI = result();
-
-(*** Main Cardinality Lemma ***)
-
-(*The #-succ(0) strengthens the original theorem statement, but precisely
- the same proof could be used!!*)
-val prems = goal Ramsey.thy
- "m: nat ==> \
-\ ALL n: nat. ALL A B. Atleast((m#+n) #- succ(0), A Un B) --> \
-\ Atleast(m,A) | Atleast(n,B)";
-by (nat_ind_tac "m" prems 1);
-by (fast_tac (ZF_cs addSIs [Atleast0]) 1);
-by (asm_simp_tac arith_ss 1);
-by (rtac ballI 1);
-by (rename_tac "n" 1); (*simplifier does NOT preserve bound names!*)
-by (nat_ind_tac "n" [] 1);
-by (fast_tac (ZF_cs addSIs [Atleast0]) 1);
-by (asm_simp_tac (arith_ss addsimps [add_succ_right]) 1);
-by (safe_tac ZF_cs);
-by (etac (Atleast_succD RS bexE) 1);
-by (etac UnE 1);
-(**case x:B. Instantiate the 'ALL A B' induction hypothesis. **)
-by (dres_inst_tac [("x1","A"), ("x","B-{x}")] (spec RS spec) 2);
-by (etac (mp RS disjE) 2);
-(*cases Atleast(succ(m1),A) and Atleast(succ(n1),B)*)
-by (REPEAT (eresolve_tac [asm_rl, notE, Atleast_Diff_succI] 3));
-(*proving the condition*)
-by (etac Atleast_superset 2 THEN fast_tac ZF_cs 2);
-(**case x:A. Instantiate the 'ALL n:nat. ALL A B' induction hypothesis. **)
-by (dres_inst_tac [("x2","succ(n1)"), ("x1","A-{x}"), ("x","B")]
- (bspec RS spec RS spec) 1);
-by (etac nat_succI 1);
-by (etac (mp RS disjE) 1);
-(*cases Atleast(succ(m1),A) and Atleast(succ(n1),B)*)
-by (REPEAT (eresolve_tac [asm_rl, Atleast_Diff_succI, notE] 2));
-(*proving the condition*)
-by (asm_simp_tac (arith_ss addsimps [add_succ_right]) 1);
-by (etac Atleast_superset 1 THEN fast_tac ZF_cs 1);
-val pigeon2_lemma = result();
-
-(* [| m:nat; n:nat; Atleast(m #+ n #- succ(0), A Un B) |] ==>
- Atleast(m,A) | Atleast(n,B) *)
-val pigeon2 = standard (pigeon2_lemma RS bspec RS spec RS spec RS mp);
-
-
-(**** Ramsey's Theorem ****)
-
-(** Base cases of induction; they now admit ANY Ramsey number **)
-
-goalw Ramsey.thy [Ramsey_def] "Ramsey(n,0,j)";
-by (fast_tac (ZF_cs addIs [Clique0,Atleast0]) 1);
-val Ramsey0j = result();
-
-goalw Ramsey.thy [Ramsey_def] "Ramsey(n,i,0)";
-by (fast_tac (ZF_cs addIs [Indept0,Atleast0]) 1);
-val Ramseyi0 = result();
-
-(** Lemmas for induction step **)
-
-(*The use of succ(m) here, rather than #-succ(0), simplifies the proof of
- Ramsey_step_lemma.*)
-val prems = goal Ramsey.thy
- "[| Atleast(m #+ n, A); m: nat; n: nat |] ==> \
-\ Atleast(succ(m), {x:A. ~P(x)}) | Atleast(n, {x:A. P(x)})";
-by (rtac (nat_succI RS pigeon2) 1);
-by (simp_tac (arith_ss addsimps prems) 3);
-by (rtac Atleast_superset 3);
-by (REPEAT (resolve_tac prems 1));
-by (fast_tac ZF_cs 1);
-val Atleast_partition = result();
-
-(*For the Atleast part, proves ~(a:I) from the second premise!*)
-val prems = goalw Ramsey.thy [Symmetric_def,Indept_def]
- "[| Symmetric(E); Indept(I, {z: V-{a}. <a,z> ~: E}, E); a: V; \
-\ Atleast(j,I) |] ==> \
-\ Indept(cons(a,I), V, E) & Atleast(succ(j), cons(a,I))";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addSEs [Atleast_succI]) 1); (*34 secs*)
-val Indept_succ = result();
-
-val prems = goalw Ramsey.thy [Symmetric_def,Clique_def]
- "[| Symmetric(E); Clique(C, {z: V-{a}. <a,z>:E}, E); a: V; \
-\ Atleast(j,C) |] ==> \
-\ Clique(cons(a,C), V, E) & Atleast(succ(j), cons(a,C))";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addSEs [Atleast_succI]) 1); (*41 secs*)
-val Clique_succ = result();
-
-(** Induction step **)
-
-(*Published proofs gloss over the need for Ramsey numbers to be POSITIVE.*)
-val ram1::ram2::prems = goalw Ramsey.thy [Ramsey_def]
- "[| Ramsey(succ(m), succ(i), j); Ramsey(n, i, succ(j)); \
-\ m: nat; n: nat |] ==> \
-\ Ramsey(succ(m#+n), succ(i), succ(j))";
-by (safe_tac ZF_cs);
-by (etac (Atleast_succD RS bexE) 1);
-by (eres_inst_tac [("P1","%z.<x,z>:E")] (Atleast_partition RS disjE) 1);
-by (REPEAT (resolve_tac prems 1));
-(*case m*)
-by (rtac (ram1 RS spec RS spec RS mp RS disjE) 1);
-by (fast_tac ZF_cs 1);
-by (fast_tac (ZF_cs addEs [Clique_superset]) 1); (*easy -- given a Clique*)
-by (safe_tac ZF_cs);
-by (eresolve_tac (swapify [exI]) 1); (*ignore main EX quantifier*)
-by (REPEAT (ares_tac [Indept_succ] 1)); (*make a bigger Indept*)
-(*case n*)
-by (rtac (ram2 RS spec RS spec RS mp RS disjE) 1);
-by (fast_tac ZF_cs 1);
-by (safe_tac ZF_cs);
-by (rtac exI 1);
-by (REPEAT (ares_tac [Clique_succ] 1)); (*make a bigger Clique*)
-by (fast_tac (ZF_cs addEs [Indept_superset]) 1); (*easy -- given an Indept*)
-val Ramsey_step_lemma = result();
-
-
-(** The actual proof **)
-
-(*Again, the induction requires Ramsey numbers to be positive.*)
-val prems = goal Ramsey.thy
- "i: nat ==> ALL j: nat. EX n:nat. Ramsey(succ(n), i, j)";
-by (nat_ind_tac "i" prems 1);
-by (fast_tac (ZF_cs addSIs [nat_0I,Ramsey0j]) 1);
-by (rtac ballI 1);
-by (nat_ind_tac "j" [] 1);
-by (fast_tac (ZF_cs addSIs [nat_0I,Ramseyi0]) 1);
-by (dres_inst_tac [("x","succ(j1)")] bspec 1);
-by (REPEAT (eresolve_tac [nat_succI,bexE] 1));
-by (rtac bexI 1);
-by (rtac Ramsey_step_lemma 1);
-by (REPEAT (ares_tac [nat_succI,add_type] 1));
-val ramsey_lemma = result();
-
-(*Final statement in a tidy form, without succ(...) *)
-val prems = goal Ramsey.thy
- "[| i: nat; j: nat |] ==> EX n:nat. Ramsey(n,i,j)";
-by (rtac (ramsey_lemma RS bspec RS bexE) 1);
-by (etac bexI 3);
-by (REPEAT (ares_tac (prems@[nat_succI]) 1));
-val ramsey = result();
-
-(*Computer Ramsey numbers according to proof above -- which, actually,
- does not constrain the base case values at all!*)
-fun ram 0 j = 1
- | ram i 0 = 1
- | ram i j = ram (i-1) j + ram i (j-1);
-
-(*Previous proof gave the following Ramsey numbers, which are smaller than
- those above by one!*)
-fun ram' 0 j = 0
- | ram' i 0 = 0
- | ram' i j = ram' (i-1) j + ram' i (j-1) + 1;
--- a/src/ZF/ex/ramsey.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,46 +0,0 @@
-(* Title: ZF/ex/ramsey.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Ramsey's Theorem (finite exponent 2 version)
-
-Based upon the article
- D Basin and M Kaufmann,
- The Boyer-Moore Prover and Nuprl: An Experimental Comparison.
- In G Huet and G Plotkin, editors, Logical Frameworks.
- (CUP, 1991), pages 89--119
-
-See also
- M Kaufmann,
- An example in NQTHM: Ramsey's Theorem
- Internal Note, Computational Logic, Inc., Austin, Texas 78703
- Available from the author: kaufmann@cli.com
-*)
-
-Ramsey = Arith +
-consts
- Symmetric :: "i=>o"
- Atleast :: "[i,i]=>o"
- Clique,Indept,Ramsey :: "[i,i,i]=>o"
-
-rules
-
- Symmetric_def
- "Symmetric(E) == (ALL x y. <x,y>:E --> <y,x>:E)"
-
- Clique_def
- "Clique(C,V,E) == (C<=V) & (ALL x:C. ALL y:C. x~=y --> <x,y> : E)"
-
- Indept_def
- "Indept(I,V,E) == (I<=V) & (ALL x:I. ALL y:I. x~=y --> <x,y> ~: E)"
-
- Atleast_def
- "Atleast(n,S) == (EX f. f: inj(n,S))"
-
- Ramsey_def
- "Ramsey(n,i,j) == ALL V E. Symmetric(E) & Atleast(n,V) --> \
-\ (EX C. Clique(C,V,E) & Atleast(i,C)) | \
-\ (EX I. Indept(I,V,E) & Atleast(j,I))"
-
-end
--- a/src/ZF/ex/rmap.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,82 +0,0 @@
-(* Title: ZF/ex/rmap
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Inductive definition of an operator to "map" a relation over a list
-*)
-
-structure Rmap = Inductive_Fun
- (val thy = List.thy addconsts [(["rmap"],"i=>i")];
- val rec_doms = [("rmap", "list(domain(r))*list(range(r))")];
- val sintrs =
- ["<Nil,Nil> : rmap(r)",
-
- "[| <x,y>: r; <xs,ys> : rmap(r) |] ==> \
-\ <Cons(x,xs), Cons(y,ys)> : rmap(r)"];
- val monos = [];
- val con_defs = [];
- val type_intrs = [domainI,rangeI] @ List.intrs @ [SigmaI]
- val type_elims = [SigmaE2]);
-
-goalw Rmap.thy Rmap.defs "!!r s. r<=s ==> rmap(r) <= rmap(s)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac Rmap.bnd_mono 1));
-by (REPEAT (ares_tac ([Sigma_mono, list_mono, domain_mono, range_mono] @
- basic_monos) 1));
-val rmap_mono = result();
-
-val rmap_induct = standard
- (Rmap.mutual_induct RS spec RS spec RSN (2,rev_mp));
-
-val Nil_rmap_case = Rmap.mk_cases List.con_defs "<Nil,zs> : rmap(r)"
-and Cons_rmap_case = Rmap.mk_cases List.con_defs "<Cons(x,xs),zs> : rmap(r)";
-
-val rmap_cs = ZF_cs addIs Rmap.intrs
- addSEs [Nil_rmap_case, Cons_rmap_case];
-
-goal Rmap.thy "!!r. r <= A*B ==> rmap(r) <= list(A)*list(B)";
-by (rtac (Rmap.dom_subset RS subset_trans) 1);
-by (REPEAT (ares_tac [domain_rel_subset, range_rel_subset,
- Sigma_mono, list_mono] 1));
-val rmap_rel_type = result();
-
-goal Rmap.thy
- "!!r. [| ALL x:A. EX y. <x,y>: r; xs: list(A) |] ==> \
-\ EX y. <xs, y> : rmap(r)";
-by (etac List.induct 1);
-by (ALLGOALS (fast_tac rmap_cs));
-val rmap_total = result();
-
-goal Rmap.thy
- "!!r. [| ALL x y z. <x,y>: r --> <x,z>: r --> y=z; \
-\ <xs, ys> : rmap(r) |] ==> \
-\ ALL zs. <xs, zs> : rmap(r) --> ys=zs";
-by (etac rmap_induct 1);
-by (ALLGOALS (fast_tac rmap_cs));
-val rmap_functional_lemma = result();
-val rmap_functional = standard (rmap_functional_lemma RS spec RS mp);
-
-(** If f is a function then rmap(f) behaves as expected. **)
-
-goal Rmap.thy "!!f. f: A->B ==> rmap(f): list(A)->list(B)";
-by (etac PiE 1);
-by (rtac PiI 1);
-by (etac rmap_rel_type 1);
-by (rtac (rmap_total RS ex_ex1I) 1);
-by (assume_tac 2);
-by (fast_tac (ZF_cs addSEs [bspec RS ex1E]) 1);
-by (rtac rmap_functional 1);
-by (REPEAT (assume_tac 2));
-by (fast_tac (ZF_cs addSEs [bspec RS ex1_equalsE]) 1);
-val rmap_fun_type = result();
-
-goalw Rmap.thy [apply_def] "rmap(f)`Nil = Nil";
-by (fast_tac (rmap_cs addIs [the_equality]) 1);
-val rmap_Nil = result();
-
-goal Rmap.thy "!!f. [| f: A->B; x: A; xs: list(A) |] ==> \
-\ rmap(f) ` Cons(x,xs) = Cons(f`x, rmap(f)`xs)";
-by (rtac apply_equality 1);
-by (REPEAT (ares_tac ([apply_Pair, rmap_fun_type] @ Rmap.intrs) 1));
-val rmap_Cons = result();
--- a/src/ZF/ex/term.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,66 +0,0 @@
-(* Title: ZF/ex/term.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Datatype definition of terms over an alphabet.
-Illustrates the list functor (essentially the same type as in Trees & Forests)
-*)
-
-structure Term = Datatype_Fun
- (val thy = List.thy;
- val rec_specs =
- [("term", "univ(A)",
- [(["Apply"], "[i,i]=>i")])];
- val rec_styp = "i=>i";
- val ext = None
- val sintrs = ["[| a: A; l: list(term(A)) |] ==> Apply(a,l) : term(A)"];
- val monos = [list_mono];
- val type_intrs = datatype_intrs;
- val type_elims = [make_elim (list_univ RS subsetD)]);
-
-val [ApplyI] = Term.intrs;
-
-(*Induction on term(A) followed by induction on List *)
-val major::prems = goal Term.thy
- "[| t: term(A); \
-\ !!x. [| x: A |] ==> P(Apply(x,Nil)); \
-\ !!x z zs. [| x: A; z: term(A); zs: list(term(A)); P(Apply(x,zs)) \
-\ |] ==> P(Apply(x, Cons(z,zs))) \
-\ |] ==> P(t)";
-by (rtac (major RS Term.induct) 1);
-by (etac List.induct 1);
-by (etac CollectE 2);
-by (REPEAT (ares_tac (prems@[list_CollectD]) 1));
-val term_induct2 = result();
-
-(*Induction on term(A) to prove an equation*)
-val major::prems = goal (merge_theories(Term.thy,ListFn.thy))
- "[| t: term(A); \
-\ !!x zs. [| x: A; zs: list(term(A)); map(f,zs) = map(g,zs) |] ==> \
-\ f(Apply(x,zs)) = g(Apply(x,zs)) \
-\ |] ==> f(t)=g(t)";
-by (rtac (major RS Term.induct) 1);
-by (resolve_tac prems 1);
-by (REPEAT (eresolve_tac [asm_rl, map_list_Collect, list_CollectD] 1));
-val term_induct_eqn = result();
-
-(** Lemmas to justify using "term" in other recursive type definitions **)
-
-goalw Term.thy Term.defs "!!A B. A<=B ==> term(A) <= term(B)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac Term.bnd_mono 1));
-by (REPEAT (ares_tac (univ_mono::basic_monos) 1));
-val term_mono = result();
-
-(*Easily provable by induction also*)
-goalw Term.thy (Term.defs@Term.con_defs) "term(univ(A)) <= univ(A)";
-by (rtac lfp_lowerbound 1);
-by (rtac (A_subset_univ RS univ_mono) 2);
-by (safe_tac ZF_cs);
-by (REPEAT (ares_tac [Pair_in_univ, list_univ RS subsetD] 1));
-val term_univ = result();
-
-val term_subset_univ = standard
- (term_mono RS (term_univ RSN (2,subset_trans)));
-
--- a/src/ZF/ex/termfn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,186 +0,0 @@
-(* Title: ZF/ex/term
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Terms over a given alphabet -- function applications; illustrates list functor
- (essentially the same type as in Trees & Forests)
-*)
-
-writeln"File ZF/ex/term-fn.";
-
-open TermFn;
-
-(*** term_rec -- by Vset recursion ***)
-
-(*Lemma: map works correctly on the underlying list of terms*)
-val [major,ordi] = goal ListFn.thy
- "[| l: list(A); Ord(i) |] ==> \
-\ rank(l)<i --> map(%z. (lam x:Vset(i).h(x)) ` z, l) = map(h,l)";
-by (rtac (major RS List.induct) 1);
-by (simp_tac list_ss 1);
-by (rtac impI 1);
-by (forward_tac [rank_Cons1 RS lt_trans] 1);
-by (dtac (rank_Cons2 RS lt_trans) 1);
-by (asm_simp_tac (list_ss addsimps [ordi, VsetI]) 1);
-val map_lemma = result();
-
-(*Typing premise is necessary to invoke map_lemma*)
-val [prem] = goal TermFn.thy
- "ts: list(A) ==> \
-\ term_rec(Apply(a,ts), d) = d(a, ts, map (%z. term_rec(z,d), ts))";
-by (rtac (term_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac Term.con_defs);
-val term_rec_ss = ZF_ss addsimps [Ord_rank, rank_pair2, prem RS map_lemma];
-by (simp_tac term_rec_ss 1);
-val term_rec = result();
-
-(*Slightly odd typing condition on r in the second premise!*)
-val major::prems = goal TermFn.thy
- "[| t: term(A); \
-\ !!x zs r. [| x: A; zs: list(term(A)); \
-\ r: list(UN t:term(A). C(t)) |] \
-\ ==> d(x, zs, r): C(Apply(x,zs)) \
-\ |] ==> term_rec(t,d) : C(t)";
-by (rtac (major RS Term.induct) 1);
-by (forward_tac [list_CollectD] 1);
-by (rtac (term_rec RS ssubst) 1);
-by (REPEAT (ares_tac prems 1));
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [term_rec])));
-by (etac CollectE 1);
-by (REPEAT (ares_tac [ConsI, UN_I] 1));
-val term_rec_type = result();
-
-val [rew,tslist] = goal TermFn.thy
- "[| !!t. j(t)==term_rec(t,d); ts: list(A) |] ==> \
-\ j(Apply(a,ts)) = d(a, ts, map(%Z.j(Z), ts))";
-by (rewtac rew);
-by (rtac (tslist RS term_rec) 1);
-val def_term_rec = result();
-
-val prems = goal TermFn.thy
- "[| t: term(A); \
-\ !!x zs r. [| x: A; zs: list(term(A)); r: list(C) |] \
-\ ==> d(x, zs, r): C \
-\ |] ==> term_rec(t,d) : C";
-by (REPEAT (ares_tac (term_rec_type::prems) 1));
-by (etac (subset_refl RS UN_least RS list_mono RS subsetD) 1);
-val term_rec_simple_type = result();
-
-
-(** term_map **)
-
-val term_map = standard (term_map_def RS def_term_rec);
-
-val prems = goalw TermFn.thy [term_map_def]
- "[| t: term(A); !!x. x: A ==> f(x): B |] ==> term_map(f,t) : term(B)";
-by (REPEAT (ares_tac ([term_rec_simple_type, ApplyI] @ prems) 1));
-val term_map_type = result();
-
-val [major] = goal TermFn.thy
- "t: term(A) ==> term_map(f,t) : term({f(u). u:A})";
-by (rtac (major RS term_map_type) 1);
-by (etac RepFunI 1);
-val term_map_type2 = result();
-
-
-(** term_size **)
-
-val term_size = standard (term_size_def RS def_term_rec);
-
-goalw TermFn.thy [term_size_def] "!!t A. t: term(A) ==> term_size(t) : nat";
-by (REPEAT (ares_tac [term_rec_simple_type, list_add_type, nat_succI] 1));
-val term_size_type = result();
-
-
-(** reflect **)
-
-val reflect = standard (reflect_def RS def_term_rec);
-
-goalw TermFn.thy [reflect_def] "!!t A. t: term(A) ==> reflect(t) : term(A)";
-by (REPEAT (ares_tac [term_rec_simple_type, rev_type, ApplyI] 1));
-val reflect_type = result();
-
-(** preorder **)
-
-val preorder = standard (preorder_def RS def_term_rec);
-
-goalw TermFn.thy [preorder_def]
- "!!t A. t: term(A) ==> preorder(t) : list(A)";
-by (REPEAT (ares_tac [term_rec_simple_type, ConsI, flat_type] 1));
-val preorder_type = result();
-
-
-(** Term simplification **)
-
-val term_typechecks =
- [ApplyI, term_map_type, term_map_type2, term_size_type, reflect_type,
- preorder_type];
-
-(*map_type2 and term_map_type2 instantiate variables*)
-val term_ss = list_ss
- addsimps [term_rec, term_map, term_size, reflect, preorder]
- setsolver type_auto_tac (list_typechecks@term_typechecks);
-
-
-(** theorems about term_map **)
-
-goal TermFn.thy "!!t A. t: term(A) ==> term_map(%u.u, t) = t";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_ident]) 1);
-val term_map_ident = result();
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> term_map(f, term_map(g,t)) = term_map(%u.f(g(u)), t)";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_compose]) 1);
-val term_map_compose = result();
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> term_map(f, reflect(t)) = reflect(term_map(f,t))";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [rev_map_distrib RS sym, map_compose]) 1);
-val term_map_reflect = result();
-
-
-(** theorems about term_size **)
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> term_size(term_map(f,t)) = term_size(t)";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_compose]) 1);
-val term_size_term_map = result();
-
-goal TermFn.thy "!!t A. t: term(A) ==> term_size(reflect(t)) = term_size(t)";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [rev_map_distrib RS sym, map_compose,
- list_add_rev]) 1);
-val term_size_reflect = result();
-
-goal TermFn.thy "!!t A. t: term(A) ==> term_size(t) = length(preorder(t))";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [length_flat, map_compose]) 1);
-val term_size_length = result();
-
-
-(** theorems about reflect **)
-
-goal TermFn.thy "!!t A. t: term(A) ==> reflect(reflect(t)) = t";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [rev_map_distrib, map_compose,
- map_ident, rev_rev_ident]) 1);
-val reflect_reflect_ident = result();
-
-
-(** theorems about preorder **)
-
-goal TermFn.thy
- "!!t A. t: term(A) ==> preorder(term_map(f,t)) = map(f, preorder(t))";
-by (etac term_induct_eqn 1);
-by (asm_simp_tac (term_ss addsimps [map_compose, map_flat]) 1);
-val preorder_term_map = result();
-
-(** preorder(reflect(t)) = rev(postorder(t)) **)
-
-writeln"Reached end of file.";
--- a/src/ZF/ex/termfn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
-(* Title: ZF/ex/term-fn.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Terms over an alphabet.
-Illustrates the list functor (essentially the same type as in Trees & Forests)
-*)
-
-TermFn = Term + ListFn +
-consts
- term_rec :: "[i, [i,i,i]=>i] => i"
- term_map :: "[i=>i, i] => i"
- term_size :: "i=>i"
- reflect :: "i=>i"
- preorder :: "i=>i"
-
-rules
- term_rec_def
- "term_rec(t,d) == \
-\ Vrec(t, %t g. term_case(%x zs. d(x, zs, map(%z.g`z, zs)), t))"
-
- term_map_def "term_map(f,t) == term_rec(t, %x zs rs. Apply(f(x), rs))"
-
- term_size_def "term_size(t) == term_rec(t, %x zs rs. succ(list_add(rs)))"
-
- reflect_def "reflect(t) == term_rec(t, %x zs rs. Apply(x, rev(rs)))"
-
- preorder_def "preorder(t) == term_rec(t, %x zs rs. Cons(x, flat(rs)))"
-
-end
--- a/src/ZF/ex/tf.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,65 +0,0 @@
-(* Title: ZF/ex/tf.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Trees & forests, a mutually recursive type definition.
-*)
-
-structure TF = Datatype_Fun
- (val thy = Univ.thy
- val rec_specs = [("tree", "univ(A)",
- [(["Tcons"], "[i,i]=>i")]),
- ("forest", "univ(A)",
- [(["Fnil"], "i"),
- (["Fcons"], "[i,i]=>i")])]
- val rec_styp = "i=>i"
- val ext = None
- val sintrs =
- ["[| a:A; f: forest(A) |] ==> Tcons(a,f) : tree(A)",
- "Fnil : forest(A)",
- "[| t: tree(A); f: forest(A) |] ==> Fcons(t,f) : forest(A)"]
- val monos = []
- val type_intrs = datatype_intrs
- val type_elims = datatype_elims);
-
-val [TconsI, FnilI, FconsI] = TF.intrs;
-
-(** tree_forest(A) as the union of tree(A) and forest(A) **)
-
-goalw TF.thy (tl TF.defs) "tree(A) <= tree_forest(A)";
-by (rtac Part_subset 1);
-val tree_subset_TF = result();
-
-goalw TF.thy (tl TF.defs) "forest(A) <= tree_forest(A)";
-by (rtac Part_subset 1);
-val forest_subset_TF = result();
-
-goalw TF.thy (tl TF.defs) "tree(A) Un forest(A) = tree_forest(A)";
-by (rtac (TF.dom_subset RS Part_sum_equality) 1);
-val TF_equals_Un = result();
-
-(** NOT useful, but interesting... **)
-
-(*The (refl RS conjI RS exI RS exI) avoids considerable search!*)
-val unfold_cs = sum_cs addSIs [PartI, refl RS conjI RS exI RS exI]
- addIs datatype_intrs
- addDs [TF.dom_subset RS subsetD]
- addSEs ([PartE] @ datatype_elims @ TF.free_SEs);
-
-goalw TF.thy (tl TF.defs) "tree(A) = {Inl(x). x: A*forest(A)}";
-by (res_inst_tac [("P", "%x.?t(x) = ?u::i")] (TF.unfold RS ssubst) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (rtac equalityI 1);
-by (fast_tac unfold_cs 1);
-by (fast_tac unfold_cs 1);
-val tree_unfold = result();
-
-goalw TF.thy (tl TF.defs) "forest(A) = {Inr(x). x: {0} + tree(A)*forest(A)}";
-by (res_inst_tac [("P", "%x.?t(x) = ?u::i")] (TF.unfold RS ssubst) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (rtac equalityI 1);
-by (fast_tac unfold_cs 1);
-by (fast_tac unfold_cs 1);
-val forest_unfold = result();
-
--- a/src/ZF/ex/tf_fn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,225 +0,0 @@
-(* Title: ZF/ex/tf.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For tf.thy. Trees & forests, a mutually recursive type definition.
-
-Still needs
-
-"TF_reflect == (%z. TF_rec(z, %x ts r. Tcons(x,r), 0,
- %t ts r1 r2. TF_of_list(list_of_TF(r2) @ <r1,0>)))"
-*)
-
-open TF_Fn;
-
-
-(*** TF_rec -- by Vset recursion ***)
-
-(** conversion rules **)
-
-goal TF_Fn.thy "TF_rec(Tcons(a,f), b, c, d) = b(a, f, TF_rec(f,b,c,d))";
-by (rtac (TF_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (simp_tac rank_ss 1);
-val TF_rec_Tcons = result();
-
-goal TF_Fn.thy "TF_rec(Fnil, b, c, d) = c";
-by (rtac (TF_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (simp_tac rank_ss 1);
-val TF_rec_Fnil = result();
-
-goal TF_Fn.thy "TF_rec(Fcons(t,f), b, c, d) = \
-\ d(t, f, TF_rec(t, b, c, d), TF_rec(f, b, c, d))";
-by (rtac (TF_rec_def RS def_Vrec RS trans) 1);
-by (rewrite_goals_tac TF.con_defs);
-by (simp_tac rank_ss 1);
-val TF_rec_Fcons = result();
-
-(*list_ss includes list operations as well as arith_ss*)
-val TF_rec_ss = list_ss addsimps
- [TF_rec_Tcons, TF_rec_Fnil, TF_rec_Fcons, TconsI, FnilI, FconsI];
-
-(** Type checking **)
-
-val major::prems = goal TF_Fn.thy
- "[| z: tree_forest(A); \
-\ !!x f r. [| x: A; f: forest(A); r: C(f) \
-\ |] ==> b(x,f,r): C(Tcons(x,f)); \
-\ c : C(Fnil); \
-\ !!t f r1 r2. [| t: tree(A); f: forest(A); r1: C(t); r2: C(f) \
-\ |] ==> d(t,f,r1,r2): C(Fcons(t,f)) \
-\ |] ==> TF_rec(z,b,c,d) : C(z)";
-by (rtac (major RS TF.induct) 1);
-by (ALLGOALS (asm_simp_tac (TF_rec_ss addsimps prems)));
-val TF_rec_type = result();
-
-(*Mutually recursive version*)
-val prems = goal TF_Fn.thy
- "[| !!x f r. [| x: A; f: forest(A); r: D(f) \
-\ |] ==> b(x,f,r): C(Tcons(x,f)); \
-\ c : D(Fnil); \
-\ !!t f r1 r2. [| t: tree(A); f: forest(A); r1: C(t); r2: D(f) \
-\ |] ==> d(t,f,r1,r2): D(Fcons(t,f)) \
-\ |] ==> (ALL t:tree(A). TF_rec(t,b,c,d) : C(t)) & \
-\ (ALL f: forest(A). TF_rec(f,b,c,d) : D(f))";
-by (rewtac Ball_def);
-by (rtac TF.mutual_induct 1);
-by (ALLGOALS (asm_simp_tac (TF_rec_ss addsimps prems)));
-val tree_forest_rec_type = result();
-
-
-(** Versions for use with definitions **)
-
-val [rew] = goal TF_Fn.thy
- "[| !!z. j(z)==TF_rec(z,b,c,d) |] ==> j(Tcons(a,f)) = b(a,f,j(f))";
-by (rewtac rew);
-by (rtac TF_rec_Tcons 1);
-val def_TF_rec_Tcons = result();
-
-val [rew] = goal TF_Fn.thy
- "[| !!z. j(z)==TF_rec(z,b,c,d) |] ==> j(Fnil) = c";
-by (rewtac rew);
-by (rtac TF_rec_Fnil 1);
-val def_TF_rec_Fnil = result();
-
-val [rew] = goal TF_Fn.thy
- "[| !!z. j(z)==TF_rec(z,b,c,d) |] ==> j(Fcons(t,f)) = d(t,f,j(t),j(f))";
-by (rewtac rew);
-by (rtac TF_rec_Fcons 1);
-val def_TF_rec_Fcons = result();
-
-fun TF_recs def = map standard
- ([def] RL [def_TF_rec_Tcons, def_TF_rec_Fnil, def_TF_rec_Fcons]);
-
-
-(** list_of_TF and TF_of_list **)
-
-val [list_of_TF_Tcons, list_of_TF_Fnil, list_of_TF_Fcons] =
- TF_recs list_of_TF_def;
-
-goalw TF_Fn.thy [list_of_TF_def]
- "!!z A. z: tree_forest(A) ==> list_of_TF(z) : list(tree(A))";
-by (REPEAT (ares_tac ([TF_rec_type,TconsI] @ list_typechecks) 1));
-val list_of_TF_type = result();
-
-val [TF_of_list_Nil,TF_of_list_Cons] = list_recs TF_of_list_def;
-
-goalw TF_Fn.thy [TF_of_list_def]
- "!!l A. l: list(tree(A)) ==> TF_of_list(l) : forest(A)";
-by (REPEAT (ares_tac [list_rec_type, FnilI, FconsI] 1));
-val TF_of_list_type = result();
-
-
-(** TF_map **)
-
-val [TF_map_Tcons, TF_map_Fnil, TF_map_Fcons] = TF_recs TF_map_def;
-
-val prems = goalw TF_Fn.thy [TF_map_def]
- "[| !!x. x: A ==> h(x): B |] ==> \
-\ (ALL t:tree(A). TF_map(h,t) : tree(B)) & \
-\ (ALL f: forest(A). TF_map(h,f) : forest(B))";
-by (REPEAT
- (ares_tac ([tree_forest_rec_type, TconsI, FnilI, FconsI] @ prems) 1));
-val TF_map_type = result();
-
-
-(** TF_size **)
-
-val [TF_size_Tcons, TF_size_Fnil, TF_size_Fcons] = TF_recs TF_size_def;
-
-goalw TF_Fn.thy [TF_size_def]
- "!!z A. z: tree_forest(A) ==> TF_size(z) : nat";
-by (REPEAT (ares_tac [TF_rec_type, add_type, nat_0I, nat_succI] 1));
-val TF_size_type = result();
-
-
-(** TF_preorder **)
-
-val [TF_preorder_Tcons, TF_preorder_Fnil, TF_preorder_Fcons] =
- TF_recs TF_preorder_def;
-
-goalw TF_Fn.thy [TF_preorder_def]
- "!!z A. z: tree_forest(A) ==> TF_preorder(z) : list(A)";
-by (REPEAT (ares_tac [TF_rec_type, app_type,NilI, ConsI] 1));
-val TF_preorder_type = result();
-
-
-(** Term simplification **)
-
-val treeI = tree_subset_TF RS subsetD
-and forestI = forest_subset_TF RS subsetD;
-
-val TF_typechecks =
- [TconsI, FnilI, FconsI, treeI, forestI,
- list_of_TF_type, TF_map_type, TF_size_type, TF_preorder_type];
-
-val TF_rewrites =
- [TF_rec_Tcons, TF_rec_Fnil, TF_rec_Fcons,
- list_of_TF_Tcons, list_of_TF_Fnil, list_of_TF_Fcons,
- TF_of_list_Nil,TF_of_list_Cons,
- TF_map_Tcons, TF_map_Fnil, TF_map_Fcons,
- TF_size_Tcons, TF_size_Fnil, TF_size_Fcons,
- TF_preorder_Tcons, TF_preorder_Fnil, TF_preorder_Fcons];
-
-val TF_ss = list_ss addsimps TF_rewrites
- setsolver type_auto_tac (list_typechecks@TF_typechecks);
-
-(** theorems about list_of_TF and TF_of_list **)
-
-(*essentially the same as list induction*)
-val major::prems = goal TF_Fn.thy
- "[| f: forest(A); \
-\ R(Fnil); \
-\ !!t f. [| t: tree(A); f: forest(A); R(f) |] ==> R(Fcons(t,f)) \
-\ |] ==> R(f)";
-by (rtac (major RS (TF.mutual_induct RS conjunct2 RS spec RSN (2,rev_mp))) 1);
-by (REPEAT (ares_tac (TrueI::prems) 1));
-val forest_induct = result();
-
-goal TF_Fn.thy "!!f A. f: forest(A) ==> TF_of_list(list_of_TF(f)) = f";
-by (etac forest_induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val forest_iso = result();
-
-goal TF_Fn.thy
- "!!ts. ts: list(tree(A)) ==> list_of_TF(TF_of_list(ts)) = ts";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val tree_list_iso = result();
-
-(** theorems about TF_map **)
-
-goal TF_Fn.thy "!!z A. z: tree_forest(A) ==> TF_map(%u.u, z) = z";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val TF_map_ident = result();
-
-goal TF_Fn.thy
- "!!z A. z: tree_forest(A) ==> TF_map(h, TF_map(j,z)) = TF_map(%u.h(j(u)), z)";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val TF_map_compose = result();
-
-(** theorems about TF_size **)
-
-goal TF_Fn.thy
- "!!z A. z: tree_forest(A) ==> TF_size(TF_map(h,z)) = TF_size(z)";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac TF_ss));
-val TF_size_TF_map = result();
-
-goal TF_Fn.thy
- "!!z A. z: tree_forest(A) ==> TF_size(z) = length(TF_preorder(z))";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac (TF_ss addsimps [length_app])));
-val TF_size_length = result();
-
-(** theorems about TF_preorder **)
-
-goal TF_Fn.thy "!!z A. z: tree_forest(A) ==> \
-\ TF_preorder(TF_map(h,z)) = map(h, TF_preorder(z))";
-by (etac TF.induct 1);
-by (ALLGOALS (asm_simp_tac (TF_ss addsimps [map_app_distrib])));
-val TF_preorder_TF_map = result();
--- a/src/ZF/ex/tf_fn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-(* Title: ZF/ex/TF.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Trees & forests, a mutually recursive type definition.
-*)
-
-TF_Fn = TF + ListFn +
-consts
- TF_rec :: "[i, [i,i,i]=>i, i, [i,i,i,i]=>i] => i"
- TF_map :: "[i=>i, i] => i"
- TF_size :: "i=>i"
- TF_preorder :: "i=>i"
- list_of_TF :: "i=>i"
- TF_of_list :: "i=>i"
-
-rules
- TF_rec_def
- "TF_rec(z,b,c,d) == Vrec(z, \
-\ %z r. tree_forest_case(%x f. b(x, f, r`f), \
-\ c, \
-\ %t f. d(t, f, r`t, r`f), z))"
-
- list_of_TF_def
- "list_of_TF(z) == TF_rec(z, %x f r. [Tcons(x,f)], [], \
-\ %t f r1 r2. Cons(t, r2))"
-
- TF_of_list_def
- "TF_of_list(f) == list_rec(f, Fnil, %t f r. Fcons(t,r))"
-
- TF_map_def
- "TF_map(h,z) == TF_rec(z, %x f r.Tcons(h(x),r), Fnil, \
-\ %t f r1 r2. Fcons(r1,r2))"
-
- TF_size_def
- "TF_size(z) == TF_rec(z, %x f r.succ(r), 0, %t f r1 r2. r1#+r2)"
-
- TF_preorder_def
- "TF_preorder(z) == TF_rec(z, %x f r.Cons(x,r), Nil, %t f r1 r2. r1@r2)"
-
-end
--- a/src/ZF/ex/twos-compl.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,103 +0,0 @@
-(* Title: ZF/ex/twos-compl.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-ML code for Arithmetic on binary integers; the model for theory BinFn
-
- The sign Plus stands for an infinite string of leading 0's.
- The sign Minus stands for an infinite string of leading 1's.
-
-A number can have multiple representations, namely leading 0's with sign
-Plus and leading 1's with sign Minus. See int_of_binary for the numerical
-interpretation.
-
-The representation expects that (m mod 2) is 0 or 1, even if m is negative;
-For instance, ~5 div 2 = ~3 and ~5 mod 2 = 1; thus ~5 = (~3)*2 + 1
-
-Still needs division!
-
-print_depth 40;
-System.Control.Print.printDepth := 350;
-*)
-
-infix 5 $$
-
-(*Recursive datatype of binary integers*)
-datatype bin = Plus | Minus | op $$ of bin * int;
-
-(** Conversions between bin and int **)
-
-fun int_of_binary Plus = 0
- | int_of_binary Minus = ~1
- | int_of_binary (w$$b) = 2 * int_of_binary w + b;
-
-fun binary_of_int 0 = Plus
- | binary_of_int ~1 = Minus
- | binary_of_int n = binary_of_int (n div 2) $$ (n mod 2);
-
-(*** Addition ***)
-
-(*Adding one to a number*)
-fun bin_succ Plus = Plus$$1
- | bin_succ Minus = Plus
- | bin_succ (w$$1) = bin_succ(w) $$ 0
- | bin_succ (w$$0) = w$$1;
-
-(*Subtracing one from a number*)
-fun bin_pred Plus = Minus
- | bin_pred Minus = Minus$$0
- | bin_pred (w$$1) = w$$0
- | bin_pred (w$$0) = bin_pred(w) $$ 1;
-
-(*sum of two binary integers*)
-fun bin_add (Plus, w) = w
- | bin_add (Minus, w) = bin_pred w
- | bin_add (v$$x, Plus) = v$$x
- | bin_add (v$$x, Minus) = bin_pred (v$$x)
- | bin_add (v$$x, w$$y) = bin_add(v, if x+y=2 then bin_succ w else w) $$
- ((x+y) mod 2);
-
-(*** Subtraction ***)
-
-(*Unary minus*)
-fun bin_minus Plus = Plus
- | bin_minus Minus = Plus$$1
- | bin_minus (w$$1) = bin_pred (bin_minus(w) $$ 0)
- | bin_minus (w$$0) = bin_minus(w) $$ 0;
-
-(*** Multiplication ***)
-
-(*product of two bins*)
-fun bin_mult (Plus, _) = Plus
- | bin_mult (Minus, v) = bin_minus v
- | bin_mult (w$$1, v) = bin_add(bin_mult(w,v) $$ 0, v)
- | bin_mult (w$$0, v) = bin_mult(w,v) $$ 0;
-
-(*** Testing ***)
-
-(*tests addition*)
-fun checksum m n =
- let val wm = binary_of_int m
- and wn = binary_of_int n
- val wsum = bin_add(wm,wn)
- in if m+n = int_of_binary wsum then (wm, wn, wsum, m+n)
- else raise Match
- end;
-
-fun bfact n = if n=0 then Plus$$1
- else bin_mult(binary_of_int n, bfact(n-1));
-
-(*Examples...
-bfact 5;
-int_of_binary it;
-bfact 69;
-int_of_binary it;
-
-(*leading zeros!*)
-bin_add(binary_of_int 1234, binary_of_int ~1234);
-bin_mult(binary_of_int 1234, Plus);
-
-(*leading ones!*)
-bin_add(binary_of_int 1234, binary_of_int ~1235);
-*)
--- a/src/ZF/fin.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,106 +0,0 @@
-(* Title: ZF/ex/fin.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Finite powerset operator
-
-could define cardinality?
-
-prove X:Fin(A) ==> EX n:nat. EX f. f:bij(X,n)
- card(0)=0
- [| a~:b; b: Fin(A) |] ==> card(cons(a,b)) = succ(card(b))
-
-b: Fin(A) ==> inj(b,b)<=surj(b,b)
-
-Limit(i) ==> Fin(Vfrom(A,i)) <= Un j:i. Fin(Vfrom(A,j))
-Fin(univ(A)) <= univ(A)
-*)
-
-structure Fin = Inductive_Fun
- (val thy = Arith.thy addconsts [(["Fin"],"i=>i")]
- val rec_doms = [("Fin","Pow(A)")]
- val sintrs = ["0 : Fin(A)",
- "[| a: A; b: Fin(A) |] ==> cons(a,b) : Fin(A)"]
- val monos = []
- val con_defs = []
- val type_intrs = [empty_subsetI, cons_subsetI, PowI]
- val type_elims = [make_elim PowD]);
-
-store_theory "Fin" Fin.thy;
-
-val [Fin_0I, Fin_consI] = Fin.intrs;
-
-
-goalw Fin.thy Fin.defs "!!A B. A<=B ==> Fin(A) <= Fin(B)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac Fin.bnd_mono 1));
-by (REPEAT (ares_tac (Pow_mono::basic_monos) 1));
-val Fin_mono = result();
-
-(* A : Fin(B) ==> A <= B *)
-val FinD = Fin.dom_subset RS subsetD RS PowD;
-
-(** Induction on finite sets **)
-
-(*Discharging x~:y entails extra work*)
-val major::prems = goal Fin.thy
- "[| b: Fin(A); \
-\ P(0); \
-\ !!x y. [| x: A; y: Fin(A); x~:y; P(y) |] ==> P(cons(x,y)) \
-\ |] ==> P(b)";
-by (rtac (major RS Fin.induct) 1);
-by (res_inst_tac [("Q","a:b")] (excluded_middle RS disjE) 2);
-by (etac (cons_absorb RS ssubst) 3 THEN assume_tac 3); (*backtracking!*)
-by (REPEAT (ares_tac prems 1));
-val Fin_induct = result();
-
-(** Simplification for Fin **)
-val Fin_ss = arith_ss addsimps Fin.intrs;
-
-(*The union of two finite sets is finite.*)
-val major::prems = goal Fin.thy
- "[| b: Fin(A); c: Fin(A) |] ==> b Un c : Fin(A)";
-by (rtac (major RS Fin_induct) 1);
-by (ALLGOALS (asm_simp_tac (Fin_ss addsimps (prems@[Un_0, Un_cons]))));
-val Fin_UnI = result();
-
-(*The union of a set of finite sets is finite.*)
-val [major] = goal Fin.thy "C : Fin(Fin(A)) ==> Union(C) : Fin(A)";
-by (rtac (major RS Fin_induct) 1);
-by (ALLGOALS (asm_simp_tac (Fin_ss addsimps [Union_0, Union_cons, Fin_UnI])));
-val Fin_UnionI = result();
-
-(*Every subset of a finite set is finite.*)
-goal Fin.thy "!!b A. b: Fin(A) ==> ALL z. z<=b --> z: Fin(A)";
-by (etac Fin_induct 1);
-by (simp_tac (Fin_ss addsimps [subset_empty_iff]) 1);
-by (safe_tac (ZF_cs addSDs [subset_cons_iff RS iffD1]));
-by (eres_inst_tac [("b","z")] (cons_Diff RS subst) 2);
-by (ALLGOALS (asm_simp_tac Fin_ss));
-val Fin_subset_lemma = result();
-
-goal Fin.thy "!!c b A. [| c<=b; b: Fin(A) |] ==> c: Fin(A)";
-by (REPEAT (ares_tac [Fin_subset_lemma RS spec RS mp] 1));
-val Fin_subset = result();
-
-val major::prems = goal Fin.thy
- "[| c: Fin(A); b: Fin(A); \
-\ P(b); \
-\ !!x y. [| x: A; y: Fin(A); x:y; P(y) |] ==> P(y-{x}) \
-\ |] ==> c<=b --> P(b-c)";
-by (rtac (major RS Fin_induct) 1);
-by (rtac (Diff_cons RS ssubst) 2);
-by (ALLGOALS (asm_simp_tac (Fin_ss addsimps (prems@[Diff_0, cons_subset_iff,
- Diff_subset RS Fin_subset]))));
-val Fin_0_induct_lemma = result();
-
-val prems = goal Fin.thy
- "[| b: Fin(A); \
-\ P(b); \
-\ !!x y. [| x: A; y: Fin(A); x:y; P(y) |] ==> P(y-{x}) \
-\ |] ==> P(0)";
-by (rtac (Diff_cancel RS subst) 1);
-by (rtac (Fin_0_induct_lemma RS mp) 1);
-by (REPEAT (ares_tac (subset_refl::prems) 1));
-val Fin_0_induct = result();
--- a/src/ZF/fin.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-fin = Arith + "inductive" + "constructor" + "intr_elim" + "equalities"
--- a/src/ZF/fixedpt.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,317 +0,0 @@
-(* Title: ZF/fixedpt.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For fixedpt.thy. Least and greatest fixed points; the Knaster-Tarski Theorem
-
-Proved in the lattice of subsets of D, namely Pow(D), with Inter as glb
-*)
-
-open Fixedpt;
-
-(*** Monotone operators ***)
-
-val prems = goalw Fixedpt.thy [bnd_mono_def]
- "[| h(D)<=D; \
-\ !!W X. [| W<=D; X<=D; W<=X |] ==> h(W) <= h(X) \
-\ |] ==> bnd_mono(D,h)";
-by (REPEAT (ares_tac (prems@[conjI,allI,impI]) 1
- ORELSE etac subset_trans 1));
-val bnd_monoI = result();
-
-val [major] = goalw Fixedpt.thy [bnd_mono_def] "bnd_mono(D,h) ==> h(D) <= D";
-by (rtac (major RS conjunct1) 1);
-val bnd_monoD1 = result();
-
-val major::prems = goalw Fixedpt.thy [bnd_mono_def]
- "[| bnd_mono(D,h); W<=X; X<=D |] ==> h(W) <= h(X)";
-by (rtac (major RS conjunct2 RS spec RS spec RS mp RS mp) 1);
-by (REPEAT (resolve_tac prems 1));
-val bnd_monoD2 = result();
-
-val [major,minor] = goal Fixedpt.thy
- "[| bnd_mono(D,h); X<=D |] ==> h(X) <= D";
-by (rtac (major RS bnd_monoD2 RS subset_trans) 1);
-by (rtac (major RS bnd_monoD1) 3);
-by (rtac minor 1);
-by (rtac subset_refl 1);
-val bnd_mono_subset = result();
-
-goal Fixedpt.thy "!!A B. [| bnd_mono(D,h); A <= D; B <= D |] ==> \
-\ h(A) Un h(B) <= h(A Un B)";
-by (REPEAT (ares_tac [Un_upper1, Un_upper2, Un_least] 1
- ORELSE etac bnd_monoD2 1));
-val bnd_mono_Un = result();
-
-(*Useful??*)
-goal Fixedpt.thy "!!A B. [| bnd_mono(D,h); A <= D; B <= D |] ==> \
-\ h(A Int B) <= h(A) Int h(B)";
-by (REPEAT (ares_tac [Int_lower1, Int_lower2, Int_greatest] 1
- ORELSE etac bnd_monoD2 1));
-val bnd_mono_Int = result();
-
-(**** Proof of Knaster-Tarski Theorem for the lfp ****)
-
-(*lfp is contained in each pre-fixedpoint*)
-val prems = goalw Fixedpt.thy [lfp_def]
- "[| h(A) <= A; A<=D |] ==> lfp(D,h) <= A";
-by (rtac (PowI RS CollectI RS Inter_lower) 1);
-by (REPEAT (resolve_tac prems 1));
-val lfp_lowerbound = result();
-
-(*Unfolding the defn of Inter dispenses with the premise bnd_mono(D,h)!*)
-goalw Fixedpt.thy [lfp_def,Inter_def] "lfp(D,h) <= D";
-by (fast_tac ZF_cs 1);
-val lfp_subset = result();
-
-(*Used in datatype package*)
-val [rew] = goal Fixedpt.thy "A==lfp(D,h) ==> A <= D";
-by (rewtac rew);
-by (rtac lfp_subset 1);
-val def_lfp_subset = result();
-
-val subset0_cs = FOL_cs
- addSIs [ballI, InterI, CollectI, PowI, empty_subsetI]
- addIs [bexI, UnionI, ReplaceI, RepFunI]
- addSEs [bexE, make_elim PowD, UnionE, ReplaceE, RepFunE,
- CollectE, emptyE]
- addEs [rev_ballE, InterD, make_elim InterD, subsetD];
-
-val subset_cs = subset0_cs
- addSIs [subset_refl,cons_subsetI,subset_consI,Union_least,UN_least,Un_least,
- Inter_greatest,Int_greatest,RepFun_subset]
- addSIs [Un_upper1,Un_upper2,Int_lower1,Int_lower2]
- addIs [Union_upper,Inter_lower]
- addSEs [cons_subsetE];
-
-val prems = goalw Fixedpt.thy [lfp_def]
- "[| h(D) <= D; !!X. [| h(X) <= X; X<=D |] ==> A<=X |] ==> \
-\ A <= lfp(D,h)";
-by (rtac (Pow_top RS CollectI RS Inter_greatest) 1);
-by (REPEAT (ares_tac prems 1 ORELSE eresolve_tac [CollectE,PowD] 1));
-val lfp_greatest = result();
-
-val hmono::prems = goal Fixedpt.thy
- "[| bnd_mono(D,h); h(A)<=A; A<=D |] ==> h(lfp(D,h)) <= A";
-by (rtac (hmono RS bnd_monoD2 RS subset_trans) 1);
-by (rtac lfp_lowerbound 1);
-by (REPEAT (resolve_tac prems 1));
-val lfp_lemma1 = result();
-
-val [hmono] = goal Fixedpt.thy
- "bnd_mono(D,h) ==> h(lfp(D,h)) <= lfp(D,h)";
-by (rtac (bnd_monoD1 RS lfp_greatest) 1);
-by (rtac lfp_lemma1 2);
-by (REPEAT (ares_tac [hmono] 1));
-val lfp_lemma2 = result();
-
-val [hmono] = goal Fixedpt.thy
- "bnd_mono(D,h) ==> lfp(D,h) <= h(lfp(D,h))";
-by (rtac lfp_lowerbound 1);
-by (rtac (hmono RS bnd_monoD2) 1);
-by (rtac (hmono RS lfp_lemma2) 1);
-by (rtac (hmono RS bnd_mono_subset) 2);
-by (REPEAT (rtac lfp_subset 1));
-val lfp_lemma3 = result();
-
-val prems = goal Fixedpt.thy
- "bnd_mono(D,h) ==> lfp(D,h) = h(lfp(D,h))";
-by (REPEAT (resolve_tac (prems@[equalityI,lfp_lemma2,lfp_lemma3]) 1));
-val lfp_Tarski = result();
-
-(*Definition form, to control unfolding*)
-val [rew,mono] = goal Fixedpt.thy
- "[| A==lfp(D,h); bnd_mono(D,h) |] ==> A = h(A)";
-by (rewtac rew);
-by (rtac (mono RS lfp_Tarski) 1);
-val def_lfp_Tarski = result();
-
-(*** General induction rule for least fixedpoints ***)
-
-val [hmono,indstep] = goal Fixedpt.thy
- "[| bnd_mono(D,h); !!x. x : h(Collect(lfp(D,h),P)) ==> P(x) \
-\ |] ==> h(Collect(lfp(D,h),P)) <= Collect(lfp(D,h),P)";
-by (rtac subsetI 1);
-by (rtac CollectI 1);
-by (etac indstep 2);
-by (rtac (hmono RS lfp_lemma2 RS subsetD) 1);
-by (rtac (hmono RS bnd_monoD2 RS subsetD) 1);
-by (REPEAT (ares_tac [Collect_subset, lfp_subset] 1));
-val Collect_is_pre_fixedpt = result();
-
-(*This rule yields an induction hypothesis in which the components of a
- data structure may be assumed to be elements of lfp(D,h)*)
-val prems = goal Fixedpt.thy
- "[| bnd_mono(D,h); a : lfp(D,h); \
-\ !!x. x : h(Collect(lfp(D,h),P)) ==> P(x) \
-\ |] ==> P(a)";
-by (rtac (Collect_is_pre_fixedpt RS lfp_lowerbound RS subsetD RS CollectD2) 1);
-by (rtac (lfp_subset RS (Collect_subset RS subset_trans)) 3);
-by (REPEAT (ares_tac prems 1));
-val induct = result();
-
-(*Definition form, to control unfolding*)
-val rew::prems = goal Fixedpt.thy
- "[| A == lfp(D,h); bnd_mono(D,h); a:A; \
-\ !!x. x : h(Collect(A,P)) ==> P(x) \
-\ |] ==> P(a)";
-by (rtac induct 1);
-by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems) 1));
-val def_induct = result();
-
-(*This version is useful when "A" is not a subset of D;
- second premise could simply be h(D Int A) <= D or !!X. X<=D ==> h(X)<=D *)
-val [hsub,hmono] = goal Fixedpt.thy
- "[| h(D Int A) <= A; bnd_mono(D,h) |] ==> lfp(D,h) <= A";
-by (rtac (lfp_lowerbound RS subset_trans) 1);
-by (rtac (hmono RS bnd_mono_subset RS Int_greatest) 1);
-by (REPEAT (resolve_tac [hsub,Int_lower1,Int_lower2] 1));
-val lfp_Int_lowerbound = result();
-
-(*Monotonicity of lfp, where h precedes i under a domain-like partial order
- monotonicity of h is not strictly necessary; h must be bounded by D*)
-val [hmono,imono,subhi] = goal Fixedpt.thy
- "[| bnd_mono(D,h); bnd_mono(E,i); \
-\ !!X. X<=D ==> h(X) <= i(X) |] ==> lfp(D,h) <= lfp(E,i)";
-by (rtac (bnd_monoD1 RS lfp_greatest) 1);
-by (rtac imono 1);
-by (rtac (hmono RSN (2, lfp_Int_lowerbound)) 1);
-by (rtac (Int_lower1 RS subhi RS subset_trans) 1);
-by (rtac (imono RS bnd_monoD2 RS subset_trans) 1);
-by (REPEAT (ares_tac [Int_lower2] 1));
-val lfp_mono = result();
-
-(*This (unused) version illustrates that monotonicity is not really needed,
- but both lfp's must be over the SAME set D; Inter is anti-monotonic!*)
-val [isubD,subhi] = goal Fixedpt.thy
- "[| i(D) <= D; !!X. X<=D ==> h(X) <= i(X) |] ==> lfp(D,h) <= lfp(D,i)";
-by (rtac lfp_greatest 1);
-by (rtac isubD 1);
-by (rtac lfp_lowerbound 1);
-by (etac (subhi RS subset_trans) 1);
-by (REPEAT (assume_tac 1));
-val lfp_mono2 = result();
-
-
-(**** Proof of Knaster-Tarski Theorem for the gfp ****)
-
-(*gfp contains each post-fixedpoint that is contained in D*)
-val prems = goalw Fixedpt.thy [gfp_def]
- "[| A <= h(A); A<=D |] ==> A <= gfp(D,h)";
-by (rtac (PowI RS CollectI RS Union_upper) 1);
-by (REPEAT (resolve_tac prems 1));
-val gfp_upperbound = result();
-
-goalw Fixedpt.thy [gfp_def] "gfp(D,h) <= D";
-by (fast_tac ZF_cs 1);
-val gfp_subset = result();
-
-(*Used in datatype package*)
-val [rew] = goal Fixedpt.thy "A==gfp(D,h) ==> A <= D";
-by (rewtac rew);
-by (rtac gfp_subset 1);
-val def_gfp_subset = result();
-
-val hmono::prems = goalw Fixedpt.thy [gfp_def]
- "[| bnd_mono(D,h); !!X. [| X <= h(X); X<=D |] ==> X<=A |] ==> \
-\ gfp(D,h) <= A";
-by (fast_tac (subset_cs addIs ((hmono RS bnd_monoD1)::prems)) 1);
-val gfp_least = result();
-
-val hmono::prems = goal Fixedpt.thy
- "[| bnd_mono(D,h); A<=h(A); A<=D |] ==> A <= h(gfp(D,h))";
-by (rtac (hmono RS bnd_monoD2 RSN (2,subset_trans)) 1);
-by (rtac gfp_subset 3);
-by (rtac gfp_upperbound 2);
-by (REPEAT (resolve_tac prems 1));
-val gfp_lemma1 = result();
-
-val [hmono] = goal Fixedpt.thy
- "bnd_mono(D,h) ==> gfp(D,h) <= h(gfp(D,h))";
-by (rtac gfp_least 1);
-by (rtac gfp_lemma1 2);
-by (REPEAT (ares_tac [hmono] 1));
-val gfp_lemma2 = result();
-
-val [hmono] = goal Fixedpt.thy
- "bnd_mono(D,h) ==> h(gfp(D,h)) <= gfp(D,h)";
-by (rtac gfp_upperbound 1);
-by (rtac (hmono RS bnd_monoD2) 1);
-by (rtac (hmono RS gfp_lemma2) 1);
-by (REPEAT (rtac ([hmono, gfp_subset] MRS bnd_mono_subset) 1));
-val gfp_lemma3 = result();
-
-val prems = goal Fixedpt.thy
- "bnd_mono(D,h) ==> gfp(D,h) = h(gfp(D,h))";
-by (REPEAT (resolve_tac (prems@[equalityI,gfp_lemma2,gfp_lemma3]) 1));
-val gfp_Tarski = result();
-
-(*Definition form, to control unfolding*)
-val [rew,mono] = goal Fixedpt.thy
- "[| A==gfp(D,h); bnd_mono(D,h) |] ==> A = h(A)";
-by (rewtac rew);
-by (rtac (mono RS gfp_Tarski) 1);
-val def_gfp_Tarski = result();
-
-
-(*** Coinduction rules for greatest fixed points ***)
-
-(*weak version*)
-goal Fixedpt.thy "!!X h. [| a: X; X <= h(X); X <= D |] ==> a : gfp(D,h)";
-by (REPEAT (ares_tac [gfp_upperbound RS subsetD] 1));
-val weak_coinduct = result();
-
-val [subs_h,subs_D,mono] = goal Fixedpt.thy
- "[| X <= h(X Un gfp(D,h)); X <= D; bnd_mono(D,h) |] ==> \
-\ X Un gfp(D,h) <= h(X Un gfp(D,h))";
-by (rtac (subs_h RS Un_least) 1);
-by (rtac (mono RS gfp_lemma2 RS subset_trans) 1);
-by (rtac (Un_upper2 RS subset_trans) 1);
-by (rtac ([mono, subs_D, gfp_subset] MRS bnd_mono_Un) 1);
-val coinduct_lemma = result();
-
-(*strong version*)
-goal Fixedpt.thy
- "!!X D. [| bnd_mono(D,h); a: X; X <= h(X Un gfp(D,h)); X <= D |] ==> \
-\ a : gfp(D,h)";
-by (rtac (coinduct_lemma RSN (2, weak_coinduct)) 1);
-by (REPEAT (ares_tac [gfp_subset, UnI1, Un_least] 1));
-val coinduct = result();
-
-(*Definition form, to control unfolding*)
-val rew::prems = goal Fixedpt.thy
- "[| A == gfp(D,h); bnd_mono(D,h); a: X; X <= h(X Un A); X <= D |] ==> \
-\ a : A";
-by (rewtac rew);
-by (rtac coinduct 1);
-by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems) 1));
-val def_coinduct = result();
-
-(*Lemma used immediately below!*)
-val [subsA,XimpP] = goal ZF.thy
- "[| X <= A; !!z. z:X ==> P(z) |] ==> X <= Collect(A,P)";
-by (rtac (subsA RS subsetD RS CollectI RS subsetI) 1);
-by (assume_tac 1);
-by (etac XimpP 1);
-val subset_Collect = result();
-
-(*The version used in the induction/coinduction package*)
-val prems = goal Fixedpt.thy
- "[| A == gfp(D, %w. Collect(D,P(w))); bnd_mono(D, %w. Collect(D,P(w))); \
-\ a: X; X <= D; !!z. z: X ==> P(X Un A, z) |] ==> \
-\ a : A";
-by (rtac def_coinduct 1);
-by (REPEAT (ares_tac (subset_Collect::prems) 1));
-val def_Collect_coinduct = result();
-
-(*Monotonicity of gfp!*)
-val [hmono,subde,subhi] = goal Fixedpt.thy
- "[| bnd_mono(D,h); D <= E; \
-\ !!X. X<=D ==> h(X) <= i(X) |] ==> gfp(D,h) <= gfp(E,i)";
-by (rtac gfp_upperbound 1);
-by (rtac (hmono RS gfp_lemma2 RS subset_trans) 1);
-by (rtac (gfp_subset RS subhi) 1);
-by (rtac ([gfp_subset, subde] MRS subset_trans) 1);
-val gfp_mono = result();
-
--- a/src/ZF/fixedpt.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,23 +0,0 @@
-(* Title: ZF/fixedpt.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Least and greatest fixed points
-*)
-
-Fixedpt = ZF + "domrange" +
-consts
- bnd_mono :: "[i,i=>i]=>o"
- lfp, gfp :: "[i,i=>i]=>i"
-
-rules
- (*monotone operator from Pow(D) to itself*)
- bnd_mono_def
- "bnd_mono(D,h) == h(D)<=D & (ALL W X. W<=X --> X<=D --> h(W) <= h(X))"
-
- lfp_def "lfp(D,h) == Inter({X: Pow(D). h(X) <= X})"
-
- gfp_def "gfp(D,h) == Union({X: Pow(D). X <= h(X)})"
-
-end
--- a/src/ZF/ind-syntax.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,162 +0,0 @@
-(* Title: ZF/ind-syntax.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Abstract Syntax functions for Inductive Definitions
-*)
-
-
-(*SHOULD BE ABLE TO DELETE THESE!*)
-fun flatten_typ sign T =
- let val {syn,...} = Sign.rep_sg sign
- in Pretty.str_of (Syntax.pretty_typ syn T)
- end;
-fun flatten_term sign t = Pretty.str_of (Sign.pretty_term sign t);
-
-(*Add constants to a theory*)
-infix addconsts;
-fun thy addconsts const_decs =
- extend_theory thy (space_implode "_" (flat (map #1 const_decs))
- ^ "_Theory")
- ([], [], [], [], const_decs, None) [];
-
-
-(*Make a definition, lhs==rhs, checking that vars on lhs contain *)
-fun mk_defpair sign (lhs,rhs) =
- let val Const(name,_) = head_of lhs
- val dummy = assert (term_vars rhs subset term_vars lhs
- andalso
- term_frees rhs subset term_frees lhs
- andalso
- term_tvars rhs subset term_tvars lhs
- andalso
- term_tfrees rhs subset term_tfrees lhs)
- ("Extra variables on RHS in definition of " ^ name)
- in (name ^ "_def",
- flatten_term sign (Logic.mk_equals (lhs,rhs)))
- end;
-
-fun lookup_const sign a = Symtab.lookup(#const_tab (Sign.rep_sg sign), a);
-
-(*export to Pure/library? *)
-fun assert_all pred l msg_fn =
- let fun asl [] = ()
- | asl (x::xs) = if pred x then asl xs
- else error (msg_fn x)
- in asl l end;
-
-
-(** Abstract syntax definitions for FOL and ZF **)
-
-val iT = Type("i",[])
-and oT = Type("o",[]);
-
-fun ap t u = t$u;
-fun app t (u1,u2) = t $ u1 $ u2;
-
-(*Given u expecting arguments of types [T1,...,Tn], create term of
- type T1*...*Tn => i using split*)
-fun ap_split split u [ ] = Abs("null", iT, u)
- | ap_split split u [_] = u
- | ap_split split u [_,_] = split $ u
- | ap_split split u (T::Ts) =
- split $ (Abs("v", T, ap_split split (u $ Bound(length Ts - 2)) Ts));
-
-val conj = Const("op &", [oT,oT]--->oT)
-and disj = Const("op |", [oT,oT]--->oT)
-and imp = Const("op -->", [oT,oT]--->oT);
-
-val eq_const = Const("op =", [iT,iT]--->oT);
-
-val mem_const = Const("op :", [iT,iT]--->oT);
-
-val exists_const = Const("Ex", [iT-->oT]--->oT);
-fun mk_exists (Free(x,T),P) = exists_const $ (absfree (x,T,P));
-
-val all_const = Const("All", [iT-->oT]--->oT);
-fun mk_all (Free(x,T),P) = all_const $ (absfree (x,T,P));
-
-(*Creates All(%v.v:A --> P(v)) rather than Ball(A,P) *)
-fun mk_all_imp (A,P) =
- all_const $ Abs("v", iT, imp $ (mem_const $ Bound 0 $ A) $ (P $ Bound 0));
-
-
-val Part_const = Const("Part", [iT,iT-->iT]--->iT);
-
-val Collect_const = Const("Collect", [iT,iT-->oT]--->iT);
-fun mk_Collect (a,D,t) = Collect_const $ D $ absfree(a, iT, t);
-
-val Trueprop = Const("Trueprop",oT-->propT);
-fun mk_tprop P = Trueprop $ P;
-fun dest_tprop (Const("Trueprop",_) $ P) = P;
-
-(*Prove a goal stated as a term, with exception handling*)
-fun prove_term sign defs (P,tacsf) =
- let val ct = Sign.cterm_of sign P
- in prove_goalw_cterm defs ct tacsf
- handle e => (writeln ("Exception in proof of\n" ^
- Sign.string_of_cterm ct);
- raise e)
- end;
-
-(*Read an assumption in the given theory*)
-fun assume_read thy a = assume (Sign.read_cterm (sign_of thy) (a,propT));
-
-(*Make distinct individual variables a1, a2, a3, ..., an. *)
-fun mk_frees a [] = []
- | mk_frees a (T::Ts) = Free(a,T) :: mk_frees (bump_string a) Ts;
-
-(*Used by intr-elim.ML and in individual datatype definitions*)
-val basic_monos = [subset_refl, imp_refl, disj_mono, conj_mono,
- ex_mono, Collect_mono, Part_mono, in_mono];
-
-(*Return the conclusion of a rule, of the form t:X*)
-fun rule_concl rl =
- case dest_tprop (Logic.strip_imp_concl rl) of
- Const("op :",_) $ t $ X => (t,X)
- | _ => error "Conclusion of rule should be a set membership";
-
-(*For deriving cases rules. CollectD2 discards the domain, which is redundant;
- read_instantiate replaces a propositional variable by a formula variable*)
-val equals_CollectD =
- read_instantiate [("W","?Q")]
- (make_elim (equalityD1 RS subsetD RS CollectD2));
-
-
-(*From HOL/ex/meson.ML: raises exception if no rules apply -- unlike RL*)
-fun tryres (th, rl::rls) = (th RS rl handle THM _ => tryres(th,rls))
- | tryres (th, []) = raise THM("tryres", 0, [th]);
-
-fun gen_make_elim elim_rls rl =
- standard (tryres (rl, elim_rls @ [revcut_rl]));
-
-(** For constructor.ML **)
-
-(*Avoids duplicate definitions by removing constants already declared mixfix*)
-fun remove_mixfixes None decs = decs
- | remove_mixfixes (Some sext) decs =
- let val mixtab = Symtab.st_of_declist(Syntax.constants sext, Symtab.null)
- fun is_mix c = case Symtab.lookup(mixtab,c) of
- None=>false | Some _ => true
- in map (fn (cs,styp)=> (filter_out is_mix cs, styp)) decs
- end;
-
-fun ext_constants None = []
- | ext_constants (Some sext) = Syntax.constants sext;
-
-
-(*Could go to FOL, but it's hardly general*)
-val [def] = goal IFOL.thy "a==b ==> a=c <-> c=b";
-by (rewtac def);
-by (rtac iffI 1);
-by (REPEAT (etac sym 1));
-val def_swap_iff = result();
-
-val def_trans = prove_goal IFOL.thy "[| f==g; g(a)=b |] ==> f(a)=b"
- (fn [rew,prem] => [ rewtac rew, rtac prem 1 ]);
-
-(*Delete needless equality assumptions*)
-val refl_thin = prove_goal IFOL.thy "!!P. [| a=a; P |] ==> P"
- (fn _ => [assume_tac 1]);
-
--- a/src/ZF/inductive.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,228 +0,0 @@
-(* Title: ZF/inductive.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-(Co)Inductive Definitions for Zermelo-Fraenkel Set Theory
-
-Inductive definitions use least fixedpoints with standard products and sums
-Coinductive definitions use greatest fixedpoints with Quine products and sums
-
-Sums are used only for mutual recursion;
-Products are used only to derive "streamlined" induction rules for relations
-*)
-
-local open Ind_Syntax
-in
-structure Lfp =
- struct
- val oper = Const("lfp", [iT,iT-->iT]--->iT)
- val bnd_mono = Const("bnd_mono", [iT,iT-->iT]--->oT)
- val bnd_monoI = bnd_monoI
- val subs = def_lfp_subset
- val Tarski = def_lfp_Tarski
- val induct = def_induct
- end;
-
-structure Standard_Prod =
- struct
- val sigma = Const("Sigma", [iT, iT-->iT]--->iT)
- val pair = Const("Pair", [iT,iT]--->iT)
- val split_const = Const("split", [[iT,iT]--->iT, iT]--->iT)
- val fsplit_const = Const("fsplit", [[iT,iT]--->oT, iT]--->oT)
- val pair_iff = Pair_iff
- val split_eq = split
- val fsplitI = fsplitI
- val fsplitD = fsplitD
- val fsplitE = fsplitE
- end;
-
-structure Standard_Sum =
- struct
- val sum = Const("op +", [iT,iT]--->iT)
- val inl = Const("Inl", iT-->iT)
- val inr = Const("Inr", iT-->iT)
- val elim = Const("case", [iT-->iT, iT-->iT, iT]--->iT)
- val case_inl = case_Inl
- val case_inr = case_Inr
- val inl_iff = Inl_iff
- val inr_iff = Inr_iff
- val distinct = Inl_Inr_iff
- val distinct' = Inr_Inl_iff
- end;
-end;
-
-functor Ind_section_Fun (Inductive: sig include INDUCTIVE_ARG INDUCTIVE_I end)
- : sig include INTR_ELIM INDRULE end =
-struct
-structure Intr_elim =
- Intr_elim_Fun(structure Inductive=Inductive and Fp=Lfp and
- Pr=Standard_Prod and Su=Standard_Sum);
-
-structure Indrule = Indrule_Fun (structure Inductive=Inductive and
- Pr=Standard_Prod and Intr_elim=Intr_elim);
-
-open Intr_elim Indrule
-end;
-
-
-structure Ind = Add_inductive_def_Fun
- (structure Fp=Lfp and Pr=Standard_Prod and Su=Standard_Sum);
-
-
-signature INDUCTIVE_STRING =
- sig
- val thy_name : string (*name of the new theory*)
- val rec_doms : (string*string) list (*recursion terms and their domains*)
- val sintrs : string list (*desired introduction rules*)
- end;
-
-
-(*For upwards compatibility: can be called directly from ML*)
-functor Inductive_Fun
- (Inductive: sig include INDUCTIVE_STRING INDUCTIVE_ARG end)
- : sig include INTR_ELIM INDRULE end =
-Ind_section_Fun
- (open Inductive Ind_Syntax
- val sign = sign_of thy;
- val rec_tms = map (readtm sign iT o #1) rec_doms
- and domts = map (readtm sign iT o #2) rec_doms
- and intr_tms = map (readtm sign propT) sintrs;
- val thy = thy |> Ind.add_fp_def_i(rec_tms, domts, intr_tms)
- |> add_thyname thy_name);
-
-
-
-local open Ind_Syntax
-in
-structure Gfp =
- struct
- val oper = Const("gfp", [iT,iT-->iT]--->iT)
- val bnd_mono = Const("bnd_mono", [iT,iT-->iT]--->oT)
- val bnd_monoI = bnd_monoI
- val subs = def_gfp_subset
- val Tarski = def_gfp_Tarski
- val induct = def_Collect_coinduct
- end;
-
-structure Quine_Prod =
- struct
- val sigma = Const("QSigma", [iT, iT-->iT]--->iT)
- val pair = Const("QPair", [iT,iT]--->iT)
- val split_const = Const("qsplit", [[iT,iT]--->iT, iT]--->iT)
- val fsplit_const = Const("qfsplit", [[iT,iT]--->oT, iT]--->oT)
- val pair_iff = QPair_iff
- val split_eq = qsplit
- val fsplitI = qfsplitI
- val fsplitD = qfsplitD
- val fsplitE = qfsplitE
- end;
-
-structure Quine_Sum =
- struct
- val sum = Const("op <+>", [iT,iT]--->iT)
- val inl = Const("QInl", iT-->iT)
- val inr = Const("QInr", iT-->iT)
- val elim = Const("qcase", [iT-->iT, iT-->iT, iT]--->iT)
- val case_inl = qcase_QInl
- val case_inr = qcase_QInr
- val inl_iff = QInl_iff
- val inr_iff = QInr_iff
- val distinct = QInl_QInr_iff
- val distinct' = QInr_QInl_iff
- end;
-end;
-
-
-signature COINDRULE =
- sig
- val coinduct : thm
- end;
-
-
-functor CoInd_section_Fun
- (Inductive: sig include INDUCTIVE_ARG INDUCTIVE_I end)
- : sig include INTR_ELIM COINDRULE end =
-struct
-structure Intr_elim =
- Intr_elim_Fun(structure Inductive=Inductive and Fp=Gfp and
- Pr=Quine_Prod and Su=Quine_Sum);
-
-open Intr_elim
-val coinduct = raw_induct
-end;
-
-
-structure CoInd =
- Add_inductive_def_Fun(structure Fp=Gfp and Pr=Quine_Prod and Su=Quine_Sum);
-
-
-(*For upwards compatibility: can be called directly from ML*)
-functor CoInductive_Fun
- (Inductive: sig include INDUCTIVE_STRING INDUCTIVE_ARG end)
- : sig include INTR_ELIM COINDRULE end =
-CoInd_section_Fun
- (open Inductive Ind_Syntax
- val sign = sign_of thy;
- val rec_tms = map (readtm sign iT o #1) rec_doms
- and domts = map (readtm sign iT o #2) rec_doms
- and intr_tms = map (readtm sign propT) sintrs;
- val thy = thy |> CoInd.add_fp_def_i(rec_tms, domts, intr_tms)
- |> add_thyname thy_name);
-
-
-
-(*For installing the theory section. co is either "" or "Co"*)
-fun inductive_decl co =
- let open ThyParse Ind_Syntax
- fun mk_intr_name (s,_) = (*the "op" cancels any infix status*)
- if Syntax.is_identifier s then "op " ^ s else "_"
- fun mk_params (((((domains: (string*string) list, ipairs),
- monos), con_defs), type_intrs), type_elims) =
- let val big_rec_name = space_implode "_"
- (map (scan_to_id o trim o #1) domains)
- and srec_tms = mk_list (map #1 domains)
- and sdoms = mk_list (map #2 domains)
- and sintrs = mk_big_list (map snd ipairs)
- val stri_name = big_rec_name ^ "_Intrnl"
- in
- (";\n\n\
- \structure " ^ stri_name ^ " =\n\
- \ let open Ind_Syntax in\n\
- \ struct\n\
- \ val rec_tms\t= map (readtm (sign_of thy) iT) "
- ^ srec_tms ^ "\n\
- \ and domts\t= map (readtm (sign_of thy) iT) "
- ^ sdoms ^ "\n\
- \ and intr_tms\t= map (readtm (sign_of thy) propT)\n"
- ^ sintrs ^ "\n\
- \ end\n\
- \ end;\n\n\
- \val thy = thy |> " ^ co ^ "Ind.add_fp_def_i \n (" ^
- stri_name ^ ".rec_tms, " ^
- stri_name ^ ".domts, " ^
- stri_name ^ ".intr_tms)"
- ,
- "structure " ^ big_rec_name ^ " =\n\
- \ struct\n\
- \ val _ = writeln \"" ^ co ^
- "Inductive definition " ^ big_rec_name ^ "\"\n\
- \ structure Result = " ^ co ^ "Ind_section_Fun\n\
- \ (open " ^ stri_name ^ "\n\
- \ val thy\t\t= thy\n\
- \ val monos\t\t= " ^ monos ^ "\n\
- \ val con_defs\t\t= " ^ con_defs ^ "\n\
- \ val type_intrs\t= " ^ type_intrs ^ "\n\
- \ val type_elims\t= " ^ type_elims ^ ");\n\n\
- \ val " ^ mk_list (map mk_intr_name ipairs) ^ " = Result.intrs;\n\
- \ open Result\n\
- \ end\n"
- )
- end
- val domains = "domains" $$-- repeat1 (string --$$ "<=" -- !! string)
- val ipairs = "intrs" $$-- repeat1 (ident -- !! string)
- fun optstring s = optional (s $$-- string) "\"[]\"" >> trim
- in domains -- ipairs -- optstring "monos" -- optstring "con_defs"
- -- optstring "type_intrs" -- optstring "type_elims"
- >> mk_params
- end;
--- a/src/ZF/inductive.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-inductive = "indrule"
--- a/src/ZF/intr-elim.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,297 +0,0 @@
-(* Title: ZF/intr-elim.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Introduction/elimination rule module -- for Inductive/Coinductive Definitions
-
-Features:
-* least or greatest fixedpoints
-* user-specified product and sum constructions
-* mutually recursive definitions
-* definitions involving arbitrary monotone operators
-* automatically proves introduction and elimination rules
-
-The recursive sets must *already* be declared as constants in parent theory!
-
- Introduction rules have the form
- [| ti:M(Sj), ..., P(x), ... |] ==> t: Sk |]
- where M is some monotone operator (usually the identity)
- P(x) is any (non-conjunctive) side condition on the free variables
- ti, t are any terms
- Sj, Sk are two of the sets being defined in mutual recursion
-
-Sums are used only for mutual recursion;
-Products are used only to derive "streamlined" induction rules for relations
-*)
-
-signature FP = (** Description of a fixed point operator **)
- sig
- val oper : term (*fixed point operator*)
- val bnd_mono : term (*monotonicity predicate*)
- val bnd_monoI : thm (*intro rule for bnd_mono*)
- val subs : thm (*subset theorem for fp*)
- val Tarski : thm (*Tarski's fixed point theorem*)
- val induct : thm (*induction/coinduction rule*)
- end;
-
-signature PR = (** Description of a Cartesian product **)
- sig
- val sigma : term (*Cartesian product operator*)
- val pair : term (*pairing operator*)
- val split_const : term (*splitting operator*)
- val fsplit_const : term (*splitting operator for formulae*)
- val pair_iff : thm (*injectivity of pairing, using <->*)
- val split_eq : thm (*equality rule for split*)
- val fsplitI : thm (*intro rule for fsplit*)
- val fsplitD : thm (*destruct rule for fsplit*)
- val fsplitE : thm (*elim rule for fsplit*)
- end;
-
-signature SU = (** Description of a disjoint sum **)
- sig
- val sum : term (*disjoint sum operator*)
- val inl : term (*left injection*)
- val inr : term (*right injection*)
- val elim : term (*case operator*)
- val case_inl : thm (*inl equality rule for case*)
- val case_inr : thm (*inr equality rule for case*)
- val inl_iff : thm (*injectivity of inl, using <->*)
- val inr_iff : thm (*injectivity of inr, using <->*)
- val distinct : thm (*distinctness of inl, inr using <->*)
- val distinct' : thm (*distinctness of inr, inl using <->*)
- end;
-
-signature INDUCTIVE = (** Description of a (co)inductive defn **)
- sig
- val thy : theory (*parent theory*)
- val rec_doms : (string*string) list (*recursion ops and their domains*)
- val sintrs : string list (*desired introduction rules*)
- val monos : thm list (*monotonicity of each M operator*)
- val con_defs : thm list (*definitions of the constructors*)
- val type_intrs : thm list (*type-checking intro rules*)
- val type_elims : thm list (*type-checking elim rules*)
- end;
-
-signature INTR_ELIM =
- sig
- val thy : theory (*new theory*)
- val defs : thm list (*definitions made in thy*)
- val bnd_mono : thm (*monotonicity for the lfp definition*)
- val unfold : thm (*fixed-point equation*)
- val dom_subset : thm (*inclusion of recursive set in dom*)
- val intrs : thm list (*introduction rules*)
- val elim : thm (*case analysis theorem*)
- val raw_induct : thm (*raw induction rule from Fp.induct*)
- val mk_cases : thm list -> string -> thm (*generates case theorems*)
- (*internal items...*)
- val big_rec_tm : term (*the lhs of the fixedpoint defn*)
- val rec_tms : term list (*the mutually recursive sets*)
- val domts : term list (*domains of the recursive sets*)
- val intr_tms : term list (*terms for the introduction rules*)
- val rec_params : term list (*parameters of the recursion*)
- val sumprod_free_SEs : thm list (*destruct rules for Su and Pr*)
- end;
-
-
-functor Intr_elim_Fun (structure Ind: INDUCTIVE and
- Fp: FP and Pr : PR and Su : SU) : INTR_ELIM =
-struct
-open Logic Ind;
-
-(*** Extract basic information from arguments ***)
-
-val sign = sign_of Ind.thy;
-
-fun rd T a =
- Sign.read_cterm sign (a,T)
- handle ERROR => error ("The error above occurred for " ^ a);
-
-val rec_names = map #1 rec_doms
-and domts = map (Sign.term_of o rd iT o #2) rec_doms;
-
-val dummy = assert_all Syntax.is_identifier rec_names
- (fn a => "Name of recursive set not an identifier: " ^ a);
-
-val dummy = assert_all (is_some o lookup_const sign) rec_names
- (fn a => "Name of recursive set not declared as constant: " ^ a);
-
-val intr_tms = map (Sign.term_of o rd propT) sintrs;
-
-local (*Checking the introduction rules*)
- val intr_sets = map (#2 o rule_concl) intr_tms;
-
- fun intr_ok set =
- case head_of set of Const(a,recT) => a mem rec_names | _ => false;
-
- val dummy = assert_all intr_ok intr_sets
- (fn t => "Conclusion of rule does not name a recursive set: " ^
- Sign.string_of_term sign t);
-in
-val (Const(_,recT),rec_params) = strip_comb (hd intr_sets)
-end;
-
-val rec_hds = map (fn a=> Const(a,recT)) rec_names;
-val rec_tms = map (fn rec_hd=> list_comb(rec_hd,rec_params)) rec_hds;
-
-val dummy = assert_all is_Free rec_params
- (fn t => "Param in recursion term not a free variable: " ^
- Sign.string_of_term sign t);
-
-(*** Construct the lfp definition ***)
-
-val mk_variant = variant (foldr add_term_names (intr_tms,[]));
-
-val z' = mk_variant"z"
-and X' = mk_variant"X"
-and w' = mk_variant"w";
-
-(*simple error-checking in the premises*)
-fun chk_prem rec_hd (Const("op &",_) $ _ $ _) =
- error"Premises may not be conjuctive"
- | chk_prem rec_hd (Const("op :",_) $ t $ X) =
- deny (rec_hd occs t) "Recursion term on left of member symbol"
- | chk_prem rec_hd t =
- deny (rec_hd occs t) "Recursion term in side formula";
-
-(*Makes a disjunct from an introduction rule*)
-fun lfp_part intr = (*quantify over rule's free vars except parameters*)
- let val prems = map dest_tprop (strip_imp_prems intr)
- val dummy = seq (fn rec_hd => seq (chk_prem rec_hd) prems) rec_hds
- val exfrees = term_frees intr \\ rec_params
- val zeq = eq_const $ (Free(z',iT)) $ (#1 (rule_concl intr))
- in foldr mk_exists (exfrees, fold_bal (app conj) (zeq::prems)) end;
-
-val dom_sum = fold_bal (app Su.sum) domts;
-
-(*The Part(A,h) terms -- compose injections to make h*)
-fun mk_Part (Bound 0) = Free(X',iT) (*no mutual rec, no Part needed*)
- | mk_Part h = Part_const $ Free(X',iT) $ Abs(w',iT,h);
-
-(*Access to balanced disjoint sums via injections*)
-val parts =
- map mk_Part (accesses_bal (ap Su.inl, ap Su.inr, Bound 0)
- (length rec_doms));
-
-(*replace each set by the corresponding Part(A,h)*)
-val part_intrs = map (subst_free (rec_tms ~~ parts) o lfp_part) intr_tms;
-
-val lfp_abs = absfree(X', iT,
- mk_Collect(z', dom_sum, fold_bal (app disj) part_intrs));
-
-val lfp_rhs = Fp.oper $ dom_sum $ lfp_abs
-
-val dummy = seq (fn rec_hd => deny (rec_hd occs lfp_rhs)
- "Illegal occurrence of recursion operator")
- rec_hds;
-
-(*** Make the new theory ***)
-
-(*A key definition:
- If no mutual recursion then it equals the one recursive set.
- If mutual recursion then it differs from all the recursive sets. *)
-val big_rec_name = space_implode "_" rec_names;
-
-(*Big_rec... is the union of the mutually recursive sets*)
-val big_rec_tm = list_comb(Const(big_rec_name,recT), rec_params);
-
-(*The individual sets must already be declared*)
-val axpairs = map (mk_defpair sign)
- ((big_rec_tm, lfp_rhs) ::
- (case parts of
- [_] => [] (*no mutual recursion*)
- | _ => rec_tms ~~ (*define the sets as Parts*)
- map (subst_atomic [(Free(X',iT),big_rec_tm)]) parts));
-
-val thy = extend_theory Ind.thy (big_rec_name ^ "_Inductive")
- ([], [], [], [], [], None) axpairs;
-
-val defs = map (get_axiom thy o #1) axpairs;
-
-val big_rec_def::part_rec_defs = defs;
-
-val prove = prove_term (sign_of thy);
-
-(********)
-val dummy = writeln "Proving monotonocity...";
-
-val bnd_mono =
- prove [] (mk_tprop (Fp.bnd_mono $ dom_sum $ lfp_abs),
- fn _ =>
- [rtac (Collect_subset RS bnd_monoI) 1,
- REPEAT (ares_tac (basic_monos @ monos) 1)]);
-
-val dom_subset = standard (big_rec_def RS Fp.subs);
-
-val unfold = standard (bnd_mono RS (big_rec_def RS Fp.Tarski));
-
-(********)
-val dummy = writeln "Proving the introduction rules...";
-
-(*Mutual recursion: Needs subset rules for the individual sets???*)
-val rec_typechecks = [dom_subset] RL (asm_rl::monos) RL [subsetD];
-
-(*Type-checking is hardest aspect of proof;
- disjIn selects the correct disjunct after unfolding*)
-fun intro_tacsf disjIn prems =
- [(*insert prems and underlying sets*)
- cut_facts_tac prems 1,
- rtac (unfold RS ssubst) 1,
- REPEAT (resolve_tac [Part_eqI,CollectI] 1),
- (*Now 2-3 subgoals: typechecking, the disjunction, perhaps equality.*)
- rtac disjIn 2,
- REPEAT (ares_tac [refl,exI,conjI] 2),
- rewrite_goals_tac con_defs,
- (*Now can solve the trivial equation*)
- REPEAT (rtac refl 2),
- REPEAT (FIRSTGOAL (eresolve_tac (asm_rl::PartE::type_elims)
- ORELSE' hyp_subst_tac
- ORELSE' dresolve_tac rec_typechecks)),
- DEPTH_SOLVE (swap_res_tac type_intrs 1)];
-
-(*combines disjI1 and disjI2 to access the corresponding nested disjunct...*)
-val mk_disj_rls =
- let fun f rl = rl RS disjI1
- and g rl = rl RS disjI2
- in accesses_bal(f, g, asm_rl) end;
-
-val intrs = map (prove part_rec_defs)
- (intr_tms ~~ map intro_tacsf (mk_disj_rls(length intr_tms)));
-
-(********)
-val dummy = writeln "Proving the elimination rule...";
-
-(*Includes rules for succ and Pair since they are common constructions*)
-val elim_rls = [asm_rl, FalseE, succ_neq_0, sym RS succ_neq_0,
- Pair_neq_0, sym RS Pair_neq_0, make_elim succ_inject,
- refl_thin, conjE, exE, disjE];
-
-val sumprod_free_SEs =
- map (gen_make_elim [conjE,FalseE])
- ([Su.distinct, Su.distinct', Su.inl_iff, Su.inr_iff, Pr.pair_iff]
- RL [iffD1]);
-
-(*Breaks down logical connectives in the monotonic function*)
-val basic_elim_tac =
- REPEAT (SOMEGOAL (eresolve_tac (elim_rls@sumprod_free_SEs)
- ORELSE' bound_hyp_subst_tac))
- THEN prune_params_tac;
-
-val elim = rule_by_tactic basic_elim_tac (unfold RS equals_CollectD);
-
-(*Applies freeness of the given constructors, which *must* be unfolded by
- the given defs. Cannot simply use the local con_defs because con_defs=[]
- for inference systems. *)
-fun con_elim_tac defs =
- rewrite_goals_tac defs THEN basic_elim_tac THEN fold_tac defs;
-
-(*String s should have the form t:Si where Si is an inductive set*)
-fun mk_cases defs s =
- rule_by_tactic (con_elim_tac defs)
- (assume_read thy s RS elim);
-
-val defs = big_rec_def::part_rec_defs;
-
-val raw_induct = standard ([big_rec_def, bnd_mono] MRS Fp.induct);
-
-end;
--- a/src/ZF/list.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,76 +0,0 @@
-(* Title: ZF/list.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Datatype definition of Lists
-*)
-
-structure List = Datatype_Fun
- (val thy = Univ.thy
- val rec_specs = [("list", "univ(A)",
- [(["Nil"], "i"),
- (["Cons"], "[i,i]=>i")])]
- val rec_styp = "i=>i"
- val ext = None
- val sintrs = ["Nil : list(A)",
- "[| a: A; l: list(A) |] ==> Cons(a,l) : list(A)"]
- val monos = []
- val type_intrs = datatype_intrs
- val type_elims = datatype_elims);
-
-store_theory "List" List.thy;
-
-val [NilI, ConsI] = List.intrs;
-
-(*An elimination rule, for type-checking*)
-val ConsE = List.mk_cases List.con_defs "Cons(a,l) : list(A)";
-
-(*Proving freeness results*)
-val Cons_iff = List.mk_free "Cons(a,l)=Cons(a',l') <-> a=a' & l=l'";
-val Nil_Cons_iff = List.mk_free "~ Nil=Cons(a,l)";
-
-(*Perform induction on l, then prove the major premise using prems. *)
-fun list_ind_tac a prems i =
- EVERY [res_inst_tac [("x",a)] List.induct i,
- rename_last_tac a ["1"] (i+2),
- ares_tac prems i];
-
-(** Lemmas to justify using "list" in other recursive type definitions **)
-
-goalw List.thy List.defs "!!A B. A<=B ==> list(A) <= list(B)";
-by (rtac lfp_mono 1);
-by (REPEAT (rtac List.bnd_mono 1));
-by (REPEAT (ares_tac (univ_mono::basic_monos) 1));
-val list_mono = result();
-
-(*There is a similar proof by list induction.*)
-goalw List.thy (List.defs@List.con_defs) "list(univ(A)) <= univ(A)";
-by (rtac lfp_lowerbound 1);
-by (rtac (A_subset_univ RS univ_mono) 2);
-by (fast_tac (ZF_cs addSIs [zero_in_univ, Inl_in_univ, Inr_in_univ,
- Pair_in_univ]) 1);
-val list_univ = result();
-
-val list_subset_univ = standard ([list_mono, list_univ] MRS subset_trans);
-
-val major::prems = goal List.thy
- "[| l: list(A); \
-\ c: C(Nil); \
-\ !!x y. [| x: A; y: list(A) |] ==> h(x,y): C(Cons(x,y)) \
-\ |] ==> list_case(c,h,l) : C(l)";
-by (rtac (major RS List.induct) 1);
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps (List.case_eqns @ prems))));
-val list_case_type = result();
-
-
-(** For recursion **)
-
-goalw List.thy List.con_defs "rank(a) < rank(Cons(a,l))";
-by (simp_tac rank_ss 1);
-val rank_Cons1 = result();
-
-goalw List.thy List.con_defs "rank(l) < rank(Cons(a,l))";
-by (simp_tac rank_ss 1);
-val rank_Cons2 = result();
-
--- a/src/ZF/list.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,3 +0,0 @@
-(*Dummy theory to document dependencies *)
-
-list = Univ + "Datatype" + "intr_elim"
--- a/src/ZF/listfn.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,366 +0,0 @@
-(* Title: ZF/list-fn.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For list-fn.thy. Lists in Zermelo-Fraenkel Set Theory
-*)
-
-open ListFn;
-
-(** hd and tl **)
-
-goalw ListFn.thy [hd_def] "hd(Cons(a,l)) = a";
-by (resolve_tac List.case_eqns 1);
-val hd_Cons = result();
-
-goalw ListFn.thy [tl_def] "tl(Nil) = Nil";
-by (resolve_tac List.case_eqns 1);
-val tl_Nil = result();
-
-goalw ListFn.thy [tl_def] "tl(Cons(a,l)) = l";
-by (resolve_tac List.case_eqns 1);
-val tl_Cons = result();
-
-goal ListFn.thy "!!l. l: list(A) ==> tl(l) : list(A)";
-by (etac List.elim 1);
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps (List.intrs @ [tl_Nil,tl_Cons]))));
-val tl_type = result();
-
-(** drop **)
-
-goalw ListFn.thy [drop_def] "drop(0, l) = l";
-by (rtac rec_0 1);
-val drop_0 = result();
-
-goalw ListFn.thy [drop_def] "!!i. i:nat ==> drop(i, Nil) = Nil";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [tl_Nil])));
-val drop_Nil = result();
-
-goalw ListFn.thy [drop_def]
- "!!i. i:nat ==> drop(succ(i), Cons(a,l)) = drop(i,l)";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [tl_Cons])));
-val drop_succ_Cons = result();
-
-goalw ListFn.thy [drop_def]
- "!!i l. [| i:nat; l: list(A) |] ==> drop(i,l) : list(A)";
-by (etac nat_induct 1);
-by (ALLGOALS (asm_simp_tac (nat_ss addsimps [tl_type])));
-val drop_type = result();
-
-(** list_rec -- by Vset recursion **)
-
-goal ListFn.thy "list_rec(Nil,c,h) = c";
-by (rtac (list_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (ZF_ss addsimps List.case_eqns) 1);
-val list_rec_Nil = result();
-
-goal ListFn.thy "list_rec(Cons(a,l), c, h) = h(a, l, list_rec(l,c,h))";
-by (rtac (list_rec_def RS def_Vrec RS trans) 1);
-by (simp_tac (rank_ss addsimps (rank_Cons2::List.case_eqns)) 1);
-val list_rec_Cons = result();
-
-(*Type checking -- proved by induction, as usual*)
-val prems = goal ListFn.thy
- "[| l: list(A); \
-\ c: C(Nil); \
-\ !!x y r. [| x:A; y: list(A); r: C(y) |] ==> h(x,y,r): C(Cons(x,y)) \
-\ |] ==> list_rec(l,c,h) : C(l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac
- (ZF_ss addsimps (prems@[list_rec_Nil,list_rec_Cons]))));
-val list_rec_type = result();
-
-(** Versions for use with definitions **)
-
-val [rew] = goal ListFn.thy
- "[| !!l. j(l)==list_rec(l, c, h) |] ==> j(Nil) = c";
-by (rewtac rew);
-by (rtac list_rec_Nil 1);
-val def_list_rec_Nil = result();
-
-val [rew] = goal ListFn.thy
- "[| !!l. j(l)==list_rec(l, c, h) |] ==> j(Cons(a,l)) = h(a,l,j(l))";
-by (rewtac rew);
-by (rtac list_rec_Cons 1);
-val def_list_rec_Cons = result();
-
-fun list_recs def = map standard
- ([def] RL [def_list_rec_Nil, def_list_rec_Cons]);
-
-(** map **)
-
-val [map_Nil,map_Cons] = list_recs map_def;
-
-val prems = goalw ListFn.thy [map_def]
- "[| l: list(A); !!x. x: A ==> h(x): B |] ==> map(h,l) : list(B)";
-by (REPEAT (ares_tac (prems@[list_rec_type, NilI, ConsI]) 1));
-val map_type = result();
-
-val [major] = goal ListFn.thy "l: list(A) ==> map(h,l) : list({h(u). u:A})";
-by (rtac (major RS map_type) 1);
-by (etac RepFunI 1);
-val map_type2 = result();
-
-(** length **)
-
-val [length_Nil,length_Cons] = list_recs length_def;
-
-goalw ListFn.thy [length_def]
- "!!l. l: list(A) ==> length(l) : nat";
-by (REPEAT (ares_tac [list_rec_type, nat_0I, nat_succI] 1));
-val length_type = result();
-
-(** app **)
-
-val [app_Nil,app_Cons] = list_recs app_def;
-
-goalw ListFn.thy [app_def]
- "!!xs ys. [| xs: list(A); ys: list(A) |] ==> xs@ys : list(A)";
-by (REPEAT (ares_tac [list_rec_type, ConsI] 1));
-val app_type = result();
-
-(** rev **)
-
-val [rev_Nil,rev_Cons] = list_recs rev_def;
-
-val prems = goalw ListFn.thy [rev_def]
- "xs: list(A) ==> rev(xs) : list(A)";
-by (REPEAT (ares_tac (prems @ [list_rec_type, NilI, ConsI, app_type]) 1));
-val rev_type = result();
-
-
-(** flat **)
-
-val [flat_Nil,flat_Cons] = list_recs flat_def;
-
-val prems = goalw ListFn.thy [flat_def]
- "ls: list(list(A)) ==> flat(ls) : list(A)";
-by (REPEAT (ares_tac (prems @ [list_rec_type, NilI, ConsI, app_type]) 1));
-val flat_type = result();
-
-
-(** list_add **)
-
-val [list_add_Nil,list_add_Cons] = list_recs list_add_def;
-
-val prems = goalw ListFn.thy [list_add_def]
- "xs: list(nat) ==> list_add(xs) : nat";
-by (REPEAT (ares_tac (prems @ [list_rec_type, nat_0I, add_type]) 1));
-val list_add_type = result();
-
-(** ListFn simplification **)
-
-val list_typechecks =
- [NilI, ConsI, list_rec_type,
- map_type, map_type2, app_type, length_type, rev_type, flat_type,
- list_add_type];
-
-val list_ss = arith_ss
- addsimps List.case_eqns
- addsimps [list_rec_Nil, list_rec_Cons,
- map_Nil, map_Cons,
- app_Nil, app_Cons,
- length_Nil, length_Cons,
- rev_Nil, rev_Cons,
- flat_Nil, flat_Cons,
- list_add_Nil, list_add_Cons]
- setsolver (type_auto_tac list_typechecks);
-(*Could also rewrite using the list_typechecks...*)
-
-(*** theorems about map ***)
-
-val prems = goal ListFn.thy
- "l: list(A) ==> map(%u.u, l) = l";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_ident = result();
-
-val prems = goal ListFn.thy
- "l: list(A) ==> map(h, map(j,l)) = map(%u.h(j(u)), l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_compose = result();
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> map(h, xs@ys) = map(h,xs) @ map(h,ys)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_app_distrib = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> map(h, flat(ls)) = flat(map(map(h),ls))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [map_app_distrib])));
-val map_flat = result();
-
-val prems = goal ListFn.thy
- "l: list(A) ==> \
-\ list_rec(map(h,l), c, d) = \
-\ list_rec(l, c, %x xs r. d(h(x), map(h,xs), r))";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val list_rec_map = result();
-
-(** theorems about list(Collect(A,P)) -- used in ex/term.ML **)
-
-(* c : list(Collect(B,P)) ==> c : list(B) *)
-val list_CollectD = standard (Collect_subset RS list_mono RS subsetD);
-
-val prems = goal ListFn.thy
- "l: list({x:A. h(x)=j(x)}) ==> map(h,l) = map(j,l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val map_list_Collect = result();
-
-(*** theorems about length ***)
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> length(map(h,xs)) = length(xs)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val length_map = result();
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> length(xs@ys) = length(xs) #+ length(ys)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val length_app = result();
-
-(* [| m: nat; n: nat |] ==> m #+ succ(n) = succ(n) #+ m
- Used for rewriting below*)
-val add_commute_succ = nat_succI RSN (2,add_commute);
-
-val prems = goal ListFn.thy
- "xs: list(A) ==> length(rev(xs)) = length(xs)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [length_app, add_commute_succ])));
-val length_rev = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> length(flat(ls)) = list_add(map(length,ls))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [length_app])));
-val length_flat = result();
-
-(** Length and drop **)
-
-(*Lemma for the inductive step of drop_length*)
-goal ListFn.thy
- "!!xs. xs: list(A) ==> \
-\ ALL x. EX z zs. drop(length(xs), Cons(x,xs)) = Cons(z,zs)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [drop_0,drop_succ_Cons])));
-by (fast_tac ZF_cs 1);
-val drop_length_Cons_lemma = result();
-val drop_length_Cons = standard (drop_length_Cons_lemma RS spec);
-
-goal ListFn.thy
- "!!l. l: list(A) ==> ALL i: length(l). EX z zs. drop(i,l) = Cons(z,zs)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps bquant_simps)));
-by (rtac conjI 1);
-by (etac drop_length_Cons 1);
-by (rtac ballI 1);
-by (rtac natE 1);
-by (etac ([asm_rl, length_type, Ord_nat] MRS Ord_trans) 1);
-by (assume_tac 1);
-by (asm_simp_tac (list_ss addsimps [drop_0]) 1);
-by (fast_tac ZF_cs 1);
-by (asm_simp_tac (list_ss addsimps [drop_succ_Cons]) 1);
-by (dtac bspec 1);
-by (fast_tac ZF_cs 2);
-by (fast_tac (ZF_cs addEs [succ_in_naturalD,length_type]) 1);
-val drop_length_lemma = result();
-val drop_length = standard (drop_length_lemma RS bspec);
-
-
-(*** theorems about app ***)
-
-val [major] = goal ListFn.thy "xs: list(A) ==> xs@Nil=xs";
-by (rtac (major RS List.induct) 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val app_right_Nil = result();
-
-val prems = goal ListFn.thy "xs: list(A) ==> (xs@ys)@zs = xs@(ys@zs)";
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS (asm_simp_tac list_ss));
-val app_assoc = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> flat(ls@ms) = flat(ls)@flat(ms)";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [app_assoc])));
-val flat_app_distrib = result();
-
-(*** theorems about rev ***)
-
-val prems = goal ListFn.thy "l: list(A) ==> rev(map(h,l)) = map(h,rev(l))";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [map_app_distrib])));
-val rev_map_distrib = result();
-
-(*Simplifier needs the premises as assumptions because rewriting will not
- instantiate the variable ?A in the rules' typing conditions; note that
- rev_type does not instantiate ?A. Only the premises do.
-*)
-goal ListFn.thy
- "!!xs. [| xs: list(A); ys: list(A) |] ==> rev(xs@ys) = rev(ys)@rev(xs)";
-by (etac List.induct 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [app_right_Nil,app_assoc])));
-val rev_app_distrib = result();
-
-val prems = goal ListFn.thy "l: list(A) ==> rev(rev(l))=l";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [rev_app_distrib])));
-val rev_rev_ident = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(A)) ==> rev(flat(ls)) = flat(map(rev,rev(ls)))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps
- [map_app_distrib, flat_app_distrib, rev_app_distrib, app_right_Nil])));
-val rev_flat = result();
-
-
-(*** theorems about list_add ***)
-
-val prems = goal ListFn.thy
- "[| xs: list(nat); ys: list(nat) |] ==> \
-\ list_add(xs@ys) = list_add(ys) #+ list_add(xs)";
-by (cut_facts_tac prems 1);
-by (list_ind_tac "xs" prems 1);
-by (ALLGOALS
- (asm_simp_tac (list_ss addsimps [add_0_right, add_assoc RS sym])));
-by (rtac (add_commute RS subst_context) 1);
-by (REPEAT (ares_tac [refl, list_add_type] 1));
-val list_add_app = result();
-
-val prems = goal ListFn.thy
- "l: list(nat) ==> list_add(rev(l)) = list_add(l)";
-by (list_ind_tac "l" prems 1);
-by (ALLGOALS
- (asm_simp_tac (list_ss addsimps [list_add_app, add_0_right])));
-val list_add_rev = result();
-
-val prems = goal ListFn.thy
- "ls: list(list(nat)) ==> list_add(flat(ls)) = list_add(map(list_add,ls))";
-by (list_ind_tac "ls" prems 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps [list_add_app])));
-by (REPEAT (ares_tac [refl, list_add_type, map_type, add_commute] 1));
-val list_add_flat = result();
-
-(** New induction rule **)
-
-val major::prems = goal ListFn.thy
- "[| l: list(A); \
-\ P(Nil); \
-\ !!x y. [| x: A; y: list(A); P(y) |] ==> P(y @ [x]) \
-\ |] ==> P(l)";
-by (rtac (major RS rev_rev_ident RS subst) 1);
-by (rtac (major RS rev_type RS List.induct) 1);
-by (ALLGOALS (asm_simp_tac (list_ss addsimps prems)));
-val list_append_induct = result();
-
--- a/src/ZF/listfn.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,50 +0,0 @@
-(* Title: ZF/list-fn
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Functions for Lists in Zermelo-Fraenkel Set Theory
-
-map is a binding operator -- it applies to meta-level functions, not
-object-level functions. This simplifies the final form of term_rec_conv,
-although complicating its derivation.
-*)
-
-ListFn = List + "constructor" +
-consts
- "@" :: "[i,i]=>i" (infixr 60)
- list_rec :: "[i, i, [i,i,i]=>i] => i"
- map :: "[i=>i, i] => i"
- length,rev :: "i=>i"
- flat :: "i=>i"
- list_add :: "i=>i"
- hd,tl :: "i=>i"
- drop :: "[i,i]=>i"
-
- (* List Enumeration *)
- "[]" :: "i" ("[]")
- "@List" :: "is => i" ("[(_)]")
-
-
-translations
- "[x, xs]" == "Cons(x, [xs])"
- "[x]" == "Cons(x, [])"
- "[]" == "Nil"
-
-
-rules
-
- hd_def "hd(l) == list_case(0, %x xs.x, l)"
- tl_def "tl(l) == list_case(Nil, %x xs.xs, l)"
- drop_def "drop(i,l) == rec(i, l, %j r. tl(r))"
-
- list_rec_def
- "list_rec(l,c,h) == Vrec(l, %l g.list_case(c, %x xs. h(x, xs, g`xs), l))"
-
- map_def "map(f,l) == list_rec(l, Nil, %x xs r. Cons(f(x), r))"
- length_def "length(l) == list_rec(l, 0, %x xs r. succ(r))"
- app_def "xs@ys == list_rec(xs, ys, %x xs r. Cons(x,r))"
- rev_def "rev(l) == list_rec(l, Nil, %x xs r. r @ [x])"
- flat_def "flat(ls) == list_rec(ls, Nil, %l ls r. l @ r)"
- list_add_def "list_add(l) == list_rec(l, 0, %x xs r. x#+r)"
-end
--- a/src/ZF/nat.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,211 +0,0 @@
-(* Title: ZF/nat.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For nat.thy. Natural numbers in Zermelo-Fraenkel Set Theory
-*)
-
-open Nat;
-
-goal Nat.thy "bnd_mono(Inf, %X. {0} Un {succ(i). i:X})";
-by (rtac bnd_monoI 1);
-by (REPEAT (ares_tac [subset_refl, RepFun_mono, Un_mono] 2));
-by (cut_facts_tac [infinity] 1);
-by (fast_tac ZF_cs 1);
-val nat_bnd_mono = result();
-
-(* nat = {0} Un {succ(x). x:nat} *)
-val nat_unfold = nat_bnd_mono RS (nat_def RS def_lfp_Tarski);
-
-(** Type checking of 0 and successor **)
-
-goal Nat.thy "0 : nat";
-by (rtac (nat_unfold RS ssubst) 1);
-by (rtac (singletonI RS UnI1) 1);
-val nat_0I = result();
-
-val prems = goal Nat.thy "n : nat ==> succ(n) : nat";
-by (rtac (nat_unfold RS ssubst) 1);
-by (rtac (RepFunI RS UnI2) 1);
-by (resolve_tac prems 1);
-val nat_succI = result();
-
-goal Nat.thy "1 : nat";
-by (rtac (nat_0I RS nat_succI) 1);
-val nat_1I = result();
-
-goal Nat.thy "bool <= nat";
-by (REPEAT (ares_tac [subsetI,nat_0I,nat_1I] 1
- ORELSE eresolve_tac [boolE,ssubst] 1));
-val bool_subset_nat = result();
-
-val bool_into_nat = bool_subset_nat RS subsetD;
-
-
-(** Injectivity properties and induction **)
-
-(*Mathematical induction*)
-val major::prems = goal Nat.thy
- "[| n: nat; P(0); !!x. [| x: nat; P(x) |] ==> P(succ(x)) |] ==> P(n)";
-by (rtac ([nat_def, nat_bnd_mono, major] MRS def_induct) 1);
-by (fast_tac (ZF_cs addIs prems) 1);
-val nat_induct = result();
-
-(*Perform induction on n, then prove the n:nat subgoal using prems. *)
-fun nat_ind_tac a prems i =
- EVERY [res_inst_tac [("n",a)] nat_induct i,
- rename_last_tac a ["1"] (i+2),
- ares_tac prems i];
-
-val major::prems = goal Nat.thy
- "[| n: nat; n=0 ==> P; !!x. [| x: nat; n=succ(x) |] ==> P |] ==> P";
-by (rtac (major RS (nat_unfold RS equalityD1 RS subsetD) RS UnE) 1);
-by (DEPTH_SOLVE (eresolve_tac [singletonE,RepFunE] 1
- ORELSE ares_tac prems 1));
-val natE = result();
-
-val prems = goal Nat.thy "n: nat ==> Ord(n)";
-by (nat_ind_tac "n" prems 1);
-by (REPEAT (ares_tac [Ord_0, Ord_succ] 1));
-val naturals_are_ordinals = result();
-
-(* i: nat ==> 0 le i *)
-val nat_0_le = naturals_are_ordinals RS Ord_0_le;
-
-goal Nat.thy "!!n. n: nat ==> n=0 | 0:n";
-by (etac nat_induct 1);
-by (fast_tac ZF_cs 1);
-by (fast_tac (ZF_cs addIs [nat_0_le]) 1);
-val natE0 = result();
-
-goal Nat.thy "Ord(nat)";
-by (rtac OrdI 1);
-by (etac (naturals_are_ordinals RS Ord_is_Transset) 2);
-by (rewtac Transset_def);
-by (rtac ballI 1);
-by (etac nat_induct 1);
-by (REPEAT (ares_tac [empty_subsetI,succ_subsetI] 1));
-val Ord_nat = result();
-
-(* succ(i): nat ==> i: nat *)
-val succ_natD = [succI1, asm_rl, Ord_nat] MRS Ord_trans;
-
-(* [| succ(i): k; k: nat |] ==> i: k *)
-val succ_in_naturalD = [succI1, asm_rl, naturals_are_ordinals] MRS Ord_trans;
-
-goal Nat.thy "!!m n. [| m<n; n: nat |] ==> m: nat";
-by (etac ltE 1);
-by (etac (Ord_nat RSN (3,Ord_trans)) 1);
-by (assume_tac 1);
-val lt_nat_in_nat = result();
-
-
-(** Variations on mathematical induction **)
-
-(*complete induction*)
-val complete_induct = Ord_nat RSN (2, Ord_induct);
-
-val prems = goal Nat.thy
- "[| m: nat; n: nat; \
-\ !!x. [| x: nat; m le x; P(x) |] ==> P(succ(x)) \
-\ |] ==> m le n --> P(m) --> P(n)";
-by (nat_ind_tac "n" prems 1);
-by (ALLGOALS
- (asm_simp_tac
- (ZF_ss addsimps (prems@distrib_rews@[le0_iff, le_succ_iff]))));
-val nat_induct_from_lemma = result();
-
-(*Induction starting from m rather than 0*)
-val prems = goal Nat.thy
- "[| m le n; m: nat; n: nat; \
-\ P(m); \
-\ !!x. [| x: nat; m le x; P(x) |] ==> P(succ(x)) \
-\ |] ==> P(n)";
-by (rtac (nat_induct_from_lemma RS mp RS mp) 1);
-by (REPEAT (ares_tac prems 1));
-val nat_induct_from = result();
-
-(*Induction suitable for subtraction and less-than*)
-val prems = goal Nat.thy
- "[| m: nat; n: nat; \
-\ !!x. x: nat ==> P(x,0); \
-\ !!y. y: nat ==> P(0,succ(y)); \
-\ !!x y. [| x: nat; y: nat; P(x,y) |] ==> P(succ(x),succ(y)) \
-\ |] ==> P(m,n)";
-by (res_inst_tac [("x","m")] bspec 1);
-by (resolve_tac prems 2);
-by (nat_ind_tac "n" prems 1);
-by (rtac ballI 2);
-by (nat_ind_tac "x" [] 2);
-by (REPEAT (ares_tac (prems@[ballI]) 1 ORELSE etac bspec 1));
-val diff_induct = result();
-
-(** Induction principle analogous to trancl_induct **)
-
-goal Nat.thy
- "!!m. m: nat ==> P(m,succ(m)) --> (ALL x: nat. P(m,x) --> P(m,succ(x))) --> \
-\ (ALL n:nat. m<n --> P(m,n))";
-by (etac nat_induct 1);
-by (ALLGOALS
- (EVERY' [rtac (impI RS impI), rtac (nat_induct RS ballI), assume_tac,
- fast_tac lt_cs, fast_tac lt_cs]));
-val succ_lt_induct_lemma = result();
-
-val prems = goal Nat.thy
- "[| m<n; n: nat; \
-\ P(m,succ(m)); \
-\ !!x. [| x: nat; P(m,x) |] ==> P(m,succ(x)) \
-\ |] ==> P(m,n)";
-by (res_inst_tac [("P4","P")]
- (succ_lt_induct_lemma RS mp RS mp RS bspec RS mp) 1);
-by (REPEAT (ares_tac (prems @ [ballI, impI, lt_nat_in_nat]) 1));
-val succ_lt_induct = result();
-
-(** nat_case **)
-
-goalw Nat.thy [nat_case_def] "nat_case(a,b,0) = a";
-by (fast_tac (ZF_cs addIs [the_equality]) 1);
-val nat_case_0 = result();
-
-goalw Nat.thy [nat_case_def] "nat_case(a,b,succ(m)) = b(m)";
-by (fast_tac (ZF_cs addIs [the_equality]) 1);
-val nat_case_succ = result();
-
-val major::prems = goal Nat.thy
- "[| n: nat; a: C(0); !!m. m: nat ==> b(m): C(succ(m)) \
-\ |] ==> nat_case(a,b,n) : C(n)";
-by (rtac (major RS nat_induct) 1);
-by (ALLGOALS
- (asm_simp_tac (ZF_ss addsimps (prems @ [nat_case_0, nat_case_succ]))));
-val nat_case_type = result();
-
-
-(** nat_rec -- used to define eclose and transrec, then obsolete;
- rec, from arith.ML, has fewer typing conditions **)
-
-val nat_rec_trans = wf_Memrel RS (nat_rec_def RS def_wfrec RS trans);
-
-goal Nat.thy "nat_rec(0,a,b) = a";
-by (rtac nat_rec_trans 1);
-by (rtac nat_case_0 1);
-val nat_rec_0 = result();
-
-val [prem] = goal Nat.thy
- "m: nat ==> nat_rec(succ(m),a,b) = b(m, nat_rec(m,a,b))";
-by (rtac nat_rec_trans 1);
-by (simp_tac (ZF_ss addsimps [prem, nat_case_succ, nat_succI, Memrel_iff,
- vimage_singleton_iff]) 1);
-val nat_rec_succ = result();
-
-(** The union of two natural numbers is a natural number -- their maximum **)
-
-goal Nat.thy "!!i j. [| i: nat; j: nat |] ==> i Un j: nat";
-by (rtac (Un_least_lt RS ltD) 1);
-by (REPEAT (ares_tac [ltI, Ord_nat] 1));
-val Un_nat_type = result();
-
-goal Nat.thy "!!i j. [| i: nat; j: nat |] ==> i Int j: nat";
-by (rtac (Int_greatest_lt RS ltD) 1);
-by (REPEAT (ares_tac [ltI, Ord_nat] 1));
-val Int_nat_type = result();
--- a/src/ZF/nat.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,26 +0,0 @@
-(* Title: ZF/nat.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Natural numbers in Zermelo-Fraenkel Set Theory
-*)
-
-Nat = Ord + Bool + "mono" +
-consts
- nat :: "i"
- nat_case :: "[i, i=>i, i]=>i"
- nat_rec :: "[i, i, [i,i]=>i]=>i"
-
-rules
-
- nat_def "nat == lfp(Inf, %X. {0} Un {succ(i). i:X})"
-
- nat_case_def
- "nat_case(a,b,k) == THE y. k=0 & y=a | (EX x. k=succ(x) & y=b(x))"
-
- nat_rec_def
- "nat_rec(k,a,b) == \
-\ wfrec(Memrel(nat), k, %n f. nat_case(a, %m. b(m, f`m), n))"
-
-end
--- a/src/ZF/ord.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,524 +0,0 @@
-(* Title: ZF/ordinal.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For ordinal.thy. Ordinals in Zermelo-Fraenkel Set Theory
-*)
-
-open Ord;
-
-(*** Rules for Transset ***)
-
-(** Two neat characterisations of Transset **)
-
-goalw Ord.thy [Transset_def] "Transset(A) <-> A<=Pow(A)";
-by (fast_tac ZF_cs 1);
-val Transset_iff_Pow = result();
-
-goalw Ord.thy [Transset_def] "Transset(A) <-> Union(succ(A)) = A";
-by (fast_tac (eq_cs addSEs [equalityE]) 1);
-val Transset_iff_Union_succ = result();
-
-(** Consequences of downwards closure **)
-
-goalw Ord.thy [Transset_def]
- "!!C a b. [| Transset(C); {a,b}: C |] ==> a:C & b: C";
-by (fast_tac ZF_cs 1);
-val Transset_doubleton_D = result();
-
-val [prem1,prem2] = goalw Ord.thy [Pair_def]
- "[| Transset(C); <a,b>: C |] ==> a:C & b: C";
-by (cut_facts_tac [prem2] 1);
-by (fast_tac (ZF_cs addSDs [prem1 RS Transset_doubleton_D]) 1);
-val Transset_Pair_D = result();
-
-val prem1::prems = goal Ord.thy
- "[| Transset(C); A*B <= C; b: B |] ==> A <= C";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addSDs [prem1 RS Transset_Pair_D]) 1);
-val Transset_includes_domain = result();
-
-val prem1::prems = goal Ord.thy
- "[| Transset(C); A*B <= C; a: A |] ==> B <= C";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addSDs [prem1 RS Transset_Pair_D]) 1);
-val Transset_includes_range = result();
-
-val [prem1,prem2] = goalw (merge_theories(Ord.thy,Sum.thy)) [sum_def]
- "[| Transset(C); A+B <= C |] ==> A <= C & B <= C";
-by (rtac (prem2 RS (Un_subset_iff RS iffD1) RS conjE) 1);
-by (REPEAT (etac (prem1 RS Transset_includes_range) 1
- ORELSE resolve_tac [conjI, singletonI] 1));
-val Transset_includes_summands = result();
-
-val [prem] = goalw (merge_theories(Ord.thy,Sum.thy)) [sum_def]
- "Transset(C) ==> (A+B) Int C <= (A Int C) + (B Int C)";
-by (rtac (Int_Un_distrib RS ssubst) 1);
-by (fast_tac (ZF_cs addSDs [prem RS Transset_Pair_D]) 1);
-val Transset_sum_Int_subset = result();
-
-(** Closure properties **)
-
-goalw Ord.thy [Transset_def] "Transset(0)";
-by (fast_tac ZF_cs 1);
-val Transset_0 = result();
-
-goalw Ord.thy [Transset_def]
- "!!i j. [| Transset(i); Transset(j) |] ==> Transset(i Un j)";
-by (fast_tac ZF_cs 1);
-val Transset_Un = result();
-
-goalw Ord.thy [Transset_def]
- "!!i j. [| Transset(i); Transset(j) |] ==> Transset(i Int j)";
-by (fast_tac ZF_cs 1);
-val Transset_Int = result();
-
-goalw Ord.thy [Transset_def] "!!i. Transset(i) ==> Transset(succ(i))";
-by (fast_tac ZF_cs 1);
-val Transset_succ = result();
-
-goalw Ord.thy [Transset_def] "!!i. Transset(i) ==> Transset(Pow(i))";
-by (fast_tac ZF_cs 1);
-val Transset_Pow = result();
-
-goalw Ord.thy [Transset_def] "!!A. Transset(A) ==> Transset(Union(A))";
-by (fast_tac ZF_cs 1);
-val Transset_Union = result();
-
-val [Transprem] = goalw Ord.thy [Transset_def]
- "[| !!i. i:A ==> Transset(i) |] ==> Transset(Union(A))";
-by (fast_tac (ZF_cs addEs [Transprem RS bspec RS subsetD]) 1);
-val Transset_Union_family = result();
-
-val [prem,Transprem] = goalw Ord.thy [Transset_def]
- "[| j:A; !!i. i:A ==> Transset(i) |] ==> Transset(Inter(A))";
-by (cut_facts_tac [prem] 1);
-by (fast_tac (ZF_cs addEs [Transprem RS bspec RS subsetD]) 1);
-val Transset_Inter_family = result();
-
-(*** Natural Deduction rules for Ord ***)
-
-val prems = goalw Ord.thy [Ord_def]
- "[| Transset(i); !!x. x:i ==> Transset(x) |] ==> Ord(i) ";
-by (REPEAT (ares_tac (prems@[ballI,conjI]) 1));
-val OrdI = result();
-
-val [major] = goalw Ord.thy [Ord_def]
- "Ord(i) ==> Transset(i)";
-by (rtac (major RS conjunct1) 1);
-val Ord_is_Transset = result();
-
-val [major,minor] = goalw Ord.thy [Ord_def]
- "[| Ord(i); j:i |] ==> Transset(j) ";
-by (rtac (minor RS (major RS conjunct2 RS bspec)) 1);
-val Ord_contains_Transset = result();
-
-(*** Lemmas for ordinals ***)
-
-goalw Ord.thy [Ord_def,Transset_def] "!!i j. [| Ord(i); j:i |] ==> Ord(j) ";
-by (fast_tac ZF_cs 1);
-val Ord_in_Ord = result();
-
-(* Ord(succ(j)) ==> Ord(j) *)
-val Ord_succD = succI1 RSN (2, Ord_in_Ord);
-
-goal Ord.thy "!!i j. [| Ord(i); Transset(j); j<=i |] ==> Ord(j)";
-by (REPEAT (ares_tac [OrdI] 1
- ORELSE eresolve_tac [Ord_contains_Transset, subsetD] 1));
-val Ord_subset_Ord = result();
-
-goalw Ord.thy [Ord_def,Transset_def] "!!i j. [| j:i; Ord(i) |] ==> j<=i";
-by (fast_tac ZF_cs 1);
-val OrdmemD = result();
-
-goal Ord.thy "!!i j k. [| i:j; j:k; Ord(k) |] ==> i:k";
-by (REPEAT (ares_tac [OrdmemD RS subsetD] 1));
-val Ord_trans = result();
-
-goal Ord.thy "!!i j. [| i:j; Ord(j) |] ==> succ(i) <= j";
-by (REPEAT (ares_tac [OrdmemD RSN (2,succ_subsetI)] 1));
-val Ord_succ_subsetI = result();
-
-
-(*** The construction of ordinals: 0, succ, Union ***)
-
-goal Ord.thy "Ord(0)";
-by (REPEAT (ares_tac [OrdI,Transset_0] 1 ORELSE etac emptyE 1));
-val Ord_0 = result();
-
-goal Ord.thy "!!i. Ord(i) ==> Ord(succ(i))";
-by (REPEAT (ares_tac [OrdI,Transset_succ] 1
- ORELSE eresolve_tac [succE,ssubst,Ord_is_Transset,
- Ord_contains_Transset] 1));
-val Ord_succ = result();
-
-goal Ord.thy "Ord(succ(i)) <-> Ord(i)";
-by (fast_tac (ZF_cs addIs [Ord_succ] addDs [Ord_succD]) 1);
-val Ord_succ_iff = result();
-
-goalw Ord.thy [Ord_def] "!!i j. [| Ord(i); Ord(j) |] ==> Ord(i Un j)";
-by (fast_tac (ZF_cs addSIs [Transset_Un]) 1);
-val Ord_Un = result();
-
-goalw Ord.thy [Ord_def] "!!i j. [| Ord(i); Ord(j) |] ==> Ord(i Int j)";
-by (fast_tac (ZF_cs addSIs [Transset_Int]) 1);
-val Ord_Int = result();
-
-val nonempty::prems = goal Ord.thy
- "[| j:A; !!i. i:A ==> Ord(i) |] ==> Ord(Inter(A))";
-by (rtac (nonempty RS Transset_Inter_family RS OrdI) 1);
-by (rtac Ord_is_Transset 1);
-by (REPEAT (ares_tac ([Ord_contains_Transset,nonempty]@prems) 1
- ORELSE etac InterD 1));
-val Ord_Inter = result();
-
-val jmemA::prems = goal Ord.thy
- "[| j:A; !!x. x:A ==> Ord(B(x)) |] ==> Ord(INT x:A. B(x))";
-by (rtac (jmemA RS RepFunI RS Ord_Inter) 1);
-by (etac RepFunE 1);
-by (etac ssubst 1);
-by (eresolve_tac prems 1);
-val Ord_INT = result();
-
-
-(*** < is 'less than' for ordinals ***)
-
-goalw Ord.thy [lt_def] "!!i j. [| i:j; Ord(j) |] ==> i<j";
-by (REPEAT (ares_tac [conjI] 1));
-val ltI = result();
-
-val major::prems = goalw Ord.thy [lt_def]
- "[| i<j; [| i:j; Ord(i); Ord(j) |] ==> P |] ==> P";
-by (rtac (major RS conjE) 1);
-by (REPEAT (ares_tac (prems@[Ord_in_Ord]) 1));
-val ltE = result();
-
-goal Ord.thy "!!i j. i<j ==> i:j";
-by (etac ltE 1);
-by (assume_tac 1);
-val ltD = result();
-
-goalw Ord.thy [lt_def] "~ i<0";
-by (fast_tac ZF_cs 1);
-val not_lt0 = result();
-
-(* i<0 ==> R *)
-val lt0E = standard (not_lt0 RS notE);
-
-goal Ord.thy "!!i j k. [| i<j; j<k |] ==> i<k";
-by (fast_tac (ZF_cs addSIs [ltI] addSEs [ltE, Ord_trans]) 1);
-val lt_trans = result();
-
-goalw Ord.thy [lt_def] "!!i j. [| i<j; j<i |] ==> P";
-by (REPEAT (eresolve_tac [asm_rl, conjE, mem_anti_sym] 1));
-val lt_anti_sym = result();
-
-val lt_anti_refl = prove_goal Ord.thy "i<i ==> P"
- (fn [major]=> [ (rtac (major RS (major RS lt_anti_sym)) 1) ]);
-
-val lt_not_refl = prove_goal Ord.thy "~ i<i"
- (fn _=> [ (rtac notI 1), (etac lt_anti_refl 1) ]);
-
-(** le is less than or equals; recall i le j abbrevs i<succ(j) !! **)
-
-goalw Ord.thy [lt_def] "i le j <-> i<j | (i=j & Ord(j))";
-by (fast_tac (ZF_cs addSIs [Ord_succ] addSDs [Ord_succD]) 1);
-val le_iff = result();
-
-goal Ord.thy "!!i j. i<j ==> i le j";
-by (asm_simp_tac (ZF_ss addsimps [le_iff]) 1);
-val leI = result();
-
-goal Ord.thy "!!i. [| i=j; Ord(j) |] ==> i le j";
-by (asm_simp_tac (ZF_ss addsimps [le_iff]) 1);
-val le_eqI = result();
-
-val le_refl = refl RS le_eqI;
-
-val [prem] = goal Ord.thy "(~ (i=j & Ord(j)) ==> i<j) ==> i le j";
-by (rtac (disjCI RS (le_iff RS iffD2)) 1);
-by (etac prem 1);
-val leCI = result();
-
-val major::prems = goal Ord.thy
- "[| i le j; i<j ==> P; [| i=j; Ord(j) |] ==> P |] ==> P";
-by (rtac (major RS (le_iff RS iffD1 RS disjE)) 1);
-by (DEPTH_SOLVE (ares_tac prems 1 ORELSE etac conjE 1));
-val leE = result();
-
-goal Ord.thy "!!i j. [| i le j; j le i |] ==> i=j";
-by (asm_full_simp_tac (ZF_ss addsimps [le_iff]) 1);
-by (fast_tac (ZF_cs addEs [lt_anti_sym]) 1);
-val le_asym = result();
-
-goal Ord.thy "i le 0 <-> i=0";
-by (fast_tac (ZF_cs addSIs [Ord_0 RS le_refl] addSEs [leE, lt0E]) 1);
-val le0_iff = result();
-
-val le0D = standard (le0_iff RS iffD1);
-
-val lt_cs =
- ZF_cs addSIs [le_refl, leCI]
- addSDs [le0D]
- addSEs [lt_anti_refl, lt0E, leE];
-
-
-(*** Natural Deduction rules for Memrel ***)
-
-goalw Ord.thy [Memrel_def] "<a,b> : Memrel(A) <-> a:b & a:A & b:A";
-by (fast_tac ZF_cs 1);
-val Memrel_iff = result();
-
-val prems = goal Ord.thy "[| a: b; a: A; b: A |] ==> <a,b> : Memrel(A)";
-by (REPEAT (resolve_tac (prems@[conjI, Memrel_iff RS iffD2]) 1));
-val MemrelI = result();
-
-val [major,minor] = goal Ord.thy
- "[| <a,b> : Memrel(A); \
-\ [| a: A; b: A; a:b |] ==> P \
-\ |] ==> P";
-by (rtac (major RS (Memrel_iff RS iffD1) RS conjE) 1);
-by (etac conjE 1);
-by (rtac minor 1);
-by (REPEAT (assume_tac 1));
-val MemrelE = result();
-
-(*The membership relation (as a set) is well-founded.
- Proof idea: show A<=B by applying the foundation axiom to A-B *)
-goalw Ord.thy [wf_def] "wf(Memrel(A))";
-by (EVERY1 [rtac (foundation RS disjE RS allI),
- etac disjI1,
- etac bexE,
- rtac (impI RS allI RS bexI RS disjI2),
- etac MemrelE,
- etac bspec,
- REPEAT o assume_tac]);
-val wf_Memrel = result();
-
-(*** Transfinite induction ***)
-
-(*Epsilon induction over a transitive set*)
-val major::prems = goalw Ord.thy [Transset_def]
- "[| i: k; Transset(k); \
-\ !!x.[| x: k; ALL y:x. P(y) |] ==> P(x) \
-\ |] ==> P(i)";
-by (rtac (major RS (wf_Memrel RS wf_induct2)) 1);
-by (fast_tac (ZF_cs addEs [MemrelE]) 1);
-by (resolve_tac prems 1);
-by (assume_tac 1);
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addIs [MemrelI]) 1);
-val Transset_induct = result();
-
-(*Induction over an ordinal*)
-val Ord_induct = Ord_is_Transset RSN (2, Transset_induct);
-
-(*Induction over the class of ordinals -- a useful corollary of Ord_induct*)
-val [major,indhyp] = goal Ord.thy
- "[| Ord(i); \
-\ !!x.[| Ord(x); ALL y:x. P(y) |] ==> P(x) \
-\ |] ==> P(i)";
-by (rtac (major RS Ord_succ RS (succI1 RS Ord_induct)) 1);
-by (rtac indhyp 1);
-by (rtac (major RS Ord_succ RS Ord_in_Ord) 1);
-by (REPEAT (assume_tac 1));
-val trans_induct = result();
-
-(*Perform induction on i, then prove the Ord(i) subgoal using prems. *)
-fun trans_ind_tac a prems i =
- EVERY [res_inst_tac [("i",a)] trans_induct i,
- rename_last_tac a ["1"] (i+1),
- ares_tac prems i];
-
-
-(*** Fundamental properties of the epsilon ordering (< on ordinals) ***)
-
-(*Finds contradictions for the following proof*)
-val Ord_trans_tac = EVERY' [etac notE, etac Ord_trans, REPEAT o atac];
-
-(** Proving that < is a linear ordering on the ordinals **)
-
-val prems = goal Ord.thy
- "Ord(i) ==> (ALL j. Ord(j) --> i:j | i=j | j:i)";
-by (trans_ind_tac "i" prems 1);
-by (rtac (impI RS allI) 1);
-by (trans_ind_tac "j" [] 1);
-by (DEPTH_SOLVE (swap_res_tac [disjCI,equalityI,subsetI] 1
- ORELSE ball_tac 1
- ORELSE eresolve_tac [impE,disjE,allE] 1
- ORELSE hyp_subst_tac 1
- ORELSE Ord_trans_tac 1));
-val Ord_linear_lemma = result();
-
-(*The trichotomy law for ordinals!*)
-val ordi::ordj::prems = goalw Ord.thy [lt_def]
- "[| Ord(i); Ord(j); i<j ==> P; i=j ==> P; j<i ==> P |] ==> P";
-by (rtac ([ordi,ordj] MRS (Ord_linear_lemma RS spec RS impE)) 1);
-by (REPEAT (FIRSTGOAL (etac disjE)));
-by (DEPTH_SOLVE (ares_tac ([ordi,ordj,conjI] @ prems) 1));
-val Ord_linear_lt = result();
-
-val prems = goal Ord.thy
- "[| Ord(i); Ord(j); i le j ==> P; j le i ==> P |] ==> P";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_lt 1);
-by (DEPTH_SOLVE (ares_tac ([leI,le_eqI] @ prems) 1));
-val Ord_linear_le = result();
-
-goal Ord.thy "!!i j. j le i ==> ~ i<j";
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 1);
-val le_imp_not_lt = result();
-
-goal Ord.thy "!!i j. [| ~ i<j; Ord(i); Ord(j) |] ==> j le i";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_le 1);
-by (REPEAT (SOMEGOAL assume_tac));
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 1);
-val not_lt_imp_le = result();
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> ~ i<j <-> j le i";
-by (REPEAT (ares_tac [iffI, le_imp_not_lt, not_lt_imp_le] 1));
-val not_lt_iff_le = result();
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> ~ i le j <-> j<i";
-by (asm_simp_tac (ZF_ss addsimps [not_lt_iff_le RS iff_sym]) 1);
-val not_le_iff_lt = result();
-
-goal Ord.thy "!!i. Ord(i) ==> 0 le i";
-by (etac (not_lt_iff_le RS iffD1) 1);
-by (REPEAT (resolve_tac [Ord_0, not_lt0] 1));
-val Ord_0_le = result();
-
-goal Ord.thy "!!i. [| Ord(i); i~=0 |] ==> 0<i";
-by (etac (not_le_iff_lt RS iffD1) 1);
-by (rtac Ord_0 1);
-by (fast_tac lt_cs 1);
-val Ord_0_lt = result();
-
-(*** Results about less-than or equals ***)
-
-(** For ordinals, j<=i (subset) implies j le i (less-than or equals) **)
-
-goal Ord.thy "!!i j. [| j<=i; Ord(i); Ord(j) |] ==> j le i";
-by (rtac (not_lt_iff_le RS iffD1) 1);
-by (assume_tac 1);
-by (assume_tac 1);
-by (fast_tac (ZF_cs addEs [ltE, mem_anti_refl]) 1);
-val subset_imp_le = result();
-
-goal Ord.thy "!!i j. i le j ==> i<=j";
-by (etac leE 1);
-by (fast_tac ZF_cs 2);
-by (fast_tac (subset_cs addIs [OrdmemD] addEs [ltE]) 1);
-val le_imp_subset = result();
-
-goal Ord.thy "j le i <-> j<=i & Ord(i) & Ord(j)";
-by (fast_tac (ZF_cs addSEs [subset_imp_le, le_imp_subset]
- addEs [ltE, make_elim Ord_succD]) 1);
-val le_subset_iff = result();
-
-goal Ord.thy "i le succ(j) <-> i le j | i=succ(j) & Ord(i)";
-by (simp_tac (ZF_ss addsimps [le_iff]) 1);
-by (fast_tac (ZF_cs addIs [Ord_succ] addDs [Ord_succD]) 1);
-val le_succ_iff = result();
-
-goal Ord.thy "!!i j. [| i le j; j<k |] ==> i<k";
-by (fast_tac (ZF_cs addEs [leE, lt_trans]) 1);
-val lt_trans1 = result();
-
-goal Ord.thy "!!i j. [| i<j; j le k |] ==> i<k";
-by (fast_tac (ZF_cs addEs [leE, lt_trans]) 1);
-val lt_trans2 = result();
-
-goal Ord.thy "!!i j. [| i le j; j le k |] ==> i le k";
-by (REPEAT (ares_tac [lt_trans1] 1));
-val le_trans = result();
-
-goal Ord.thy "!!i j. i<j ==> succ(i) le j";
-by (rtac (not_lt_iff_le RS iffD1) 1);
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 3);
-by (ALLGOALS (fast_tac (ZF_cs addEs [ltE] addIs [Ord_succ])));
-val succ_leI = result();
-
-goal Ord.thy "!!i j. succ(i) le j ==> i<j";
-by (rtac (not_le_iff_lt RS iffD1) 1);
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 3);
-by (ALLGOALS (fast_tac (ZF_cs addEs [ltE, make_elim Ord_succD])));
-val succ_leE = result();
-
-goal Ord.thy "succ(i) le j <-> i<j";
-by (REPEAT (ares_tac [iffI,succ_leI,succ_leE] 1));
-val succ_le_iff = result();
-
-(** Union and Intersection **)
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> i le i Un j";
-by (rtac (Un_upper1 RS subset_imp_le) 1);
-by (REPEAT (ares_tac [Ord_Un] 1));
-val Un_upper1_le = result();
-
-goal Ord.thy "!!i j. [| Ord(i); Ord(j) |] ==> j le i Un j";
-by (rtac (Un_upper2 RS subset_imp_le) 1);
-by (REPEAT (ares_tac [Ord_Un] 1));
-val Un_upper2_le = result();
-
-(*Replacing k by succ(k') yields the similar rule for le!*)
-goal Ord.thy "!!i j k. [| i<k; j<k |] ==> i Un j < k";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_le 1);
-by (rtac (Un_commute RS ssubst) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Un_iff]) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Un_iff]) 3);
-by (REPEAT (eresolve_tac [asm_rl, ltE] 1));
-val Un_least_lt = result();
-
-(*Replacing k by succ(k') yields the similar rule for le!*)
-goal Ord.thy "!!i j k. [| i<k; j<k |] ==> i Int j < k";
-by (res_inst_tac [("i","i"),("j","j")] Ord_linear_le 1);
-by (rtac (Int_commute RS ssubst) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Int_iff]) 4);
-by (asm_full_simp_tac (ZF_ss addsimps [le_subset_iff, subset_Int_iff]) 3);
-by (REPEAT (eresolve_tac [asm_rl, ltE] 1));
-val Int_greatest_lt = result();
-
-(*** Results about limits ***)
-
-val prems = goal Ord.thy "[| !!i. i:A ==> Ord(i) |] ==> Ord(Union(A))";
-by (rtac (Ord_is_Transset RS Transset_Union_family RS OrdI) 1);
-by (REPEAT (etac UnionE 1 ORELSE ares_tac ([Ord_contains_Transset]@prems) 1));
-val Ord_Union = result();
-
-val prems = goal Ord.thy "[| !!x. x:A ==> Ord(B(x)) |] ==> Ord(UN x:A. B(x))";
-by (rtac Ord_Union 1);
-by (etac RepFunE 1);
-by (etac ssubst 1);
-by (eresolve_tac prems 1);
-val Ord_UN = result();
-
-(* No < version; consider (UN i:nat.i)=nat *)
-val [ordi,limit] = goal Ord.thy
- "[| Ord(i); !!x. x:A ==> b(x) le i |] ==> (UN x:A. b(x)) le i";
-by (rtac (le_imp_subset RS UN_least RS subset_imp_le) 1);
-by (REPEAT (ares_tac [ordi, Ord_UN, limit] 1 ORELSE etac (limit RS ltE) 1));
-val UN_least_le = result();
-
-val [jlti,limit] = goal Ord.thy
- "[| j<i; !!x. x:A ==> b(x)<j |] ==> (UN x:A. succ(b(x))) < i";
-by (rtac (jlti RS ltE) 1);
-by (rtac (UN_least_le RS lt_trans2) 1);
-by (REPEAT (ares_tac [jlti, succ_leI, limit] 1));
-val UN_succ_least_lt = result();
-
-val prems = goal Ord.thy
- "[| a: A; i le b(a); !!x. x:A ==> Ord(b(x)) |] ==> i le (UN x:A. b(x))";
-by (resolve_tac (prems RL [ltE]) 1);
-by (rtac (le_imp_subset RS subset_trans RS subset_imp_le) 1);
-by (REPEAT (ares_tac (prems @ [UN_upper, Ord_UN]) 1));
-val UN_upper_le = result();
-
-goal Ord.thy "!!i. Ord(i) ==> (UN y:i. succ(y)) = i";
-by (fast_tac (eq_cs addEs [Ord_trans]) 1);
-val Ord_equality = result();
-
-(*Holds for all transitive sets, not just ordinals*)
-goal Ord.thy "!!i. Ord(i) ==> Union(i) <= i";
-by (fast_tac (ZF_cs addSEs [Ord_trans]) 1);
-val Ord_Union_subset = result();
--- a/src/ZF/ord.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,25 +0,0 @@
-(* Title: ZF/ordinal.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Ordinals in Zermelo-Fraenkel Set Theory
-*)
-
-Ord = WF + "simpdata" + "equalities" +
-consts
- Memrel :: "i=>i"
- Transset,Ord :: "i=>o"
- "<" :: "[i,i] => o" (infixl 50) (*less than on ordinals*)
- "le" :: "[i,i] => o" (infixl 50) (*less than or equals*)
-
-translations
- "x le y" == "x < succ(y)"
-
-rules
- Memrel_def "Memrel(A) == {z: A*A . EX x y. z=<x,y> & x:y }"
- Transset_def "Transset(i) == ALL x:i. x<=i"
- Ord_def "Ord(i) == Transset(i) & (ALL x:i. Transset(x))"
- lt_def "i<j == i:j & Ord(j)"
-
-end
--- a/src/ZF/perm.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,442 +0,0 @@
-(* Title: ZF/perm.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1991 University of Cambridge
-
-For perm.thy. The theory underlying permutation groups
- -- Composition of relations, the identity relation
- -- Injections, surjections, bijections
- -- Lemmas for the Schroeder-Bernstein Theorem
-*)
-
-open Perm;
-
-(** Surjective function space **)
-
-goalw Perm.thy [surj_def] "!!f A B. f: surj(A,B) ==> f: A->B";
-by (etac CollectD1 1);
-val surj_is_fun = result();
-
-goalw Perm.thy [surj_def] "!!f A B. f : Pi(A,B) ==> f: surj(A,range(f))";
-by (fast_tac (ZF_cs addIs [apply_equality]
- addEs [range_of_fun,domain_type]) 1);
-val fun_is_surj = result();
-
-goalw Perm.thy [surj_def] "!!f A B. f: surj(A,B) ==> range(f)=B";
-by (best_tac (ZF_cs addIs [equalityI,apply_Pair] addEs [range_type]) 1);
-val surj_range = result();
-
-
-(** Injective function space **)
-
-goalw Perm.thy [inj_def] "!!f A B. f: inj(A,B) ==> f: A->B";
-by (etac CollectD1 1);
-val inj_is_fun = result();
-
-goalw Perm.thy [inj_def]
- "!!f A B. [| <a,b>:f; <c,b>:f; f: inj(A,B) |] ==> a=c";
-by (REPEAT (eresolve_tac [asm_rl, Pair_mem_PiE, CollectE] 1));
-by (fast_tac ZF_cs 1);
-val inj_equality = result();
-
-(** Bijections -- simple lemmas but no intro/elim rules -- use unfolding **)
-
-goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> f: inj(A,B)";
-by (etac IntD1 1);
-val bij_is_inj = result();
-
-goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> f: surj(A,B)";
-by (etac IntD2 1);
-val bij_is_surj = result();
-
-(* f: bij(A,B) ==> f: A->B *)
-val bij_is_fun = standard (bij_is_inj RS inj_is_fun);
-
-
-(** Identity function **)
-
-val [prem] = goalw Perm.thy [id_def] "a:A ==> <a,a> : id(A)";
-by (rtac (prem RS lamI) 1);
-val idI = result();
-
-val major::prems = goalw Perm.thy [id_def]
- "[| p: id(A); !!x.[| x:A; p=<x,x> |] ==> P \
-\ |] ==> P";
-by (rtac (major RS lamE) 1);
-by (REPEAT (ares_tac prems 1));
-val idE = result();
-
-goalw Perm.thy [id_def] "id(A) : A->A";
-by (rtac lam_type 1);
-by (assume_tac 1);
-val id_type = result();
-
-val [prem] = goalw Perm.thy [id_def] "A<=B ==> id(A) <= id(B)";
-by (rtac (prem RS lam_mono) 1);
-val id_mono = result();
-
-goalw Perm.thy [inj_def,id_def] "id(A): inj(A,A)";
-by (REPEAT (ares_tac [CollectI,lam_type] 1));
-by (simp_tac ZF_ss 1);
-val id_inj = result();
-
-goalw Perm.thy [id_def,surj_def] "id(A): surj(A,A)";
-by (fast_tac (ZF_cs addIs [lam_type,beta]) 1);
-val id_surj = result();
-
-goalw Perm.thy [bij_def] "id(A): bij(A,A)";
-by (fast_tac (ZF_cs addIs [id_inj,id_surj]) 1);
-val id_bij = result();
-
-
-(** Converse of a relation **)
-
-val [prem] = goal Perm.thy "f: inj(A,B) ==> converse(f) : range(f)->A";
-by (rtac (prem RS inj_is_fun RS PiE) 1);
-by (rtac (converse_type RS PiI) 1);
-by (fast_tac ZF_cs 1);
-by (fast_tac (ZF_cs addEs [prem RSN (3,inj_equality)]) 1);
-by flexflex_tac;
-val inj_converse_fun = result();
-
-val prems = goalw Perm.thy [surj_def]
- "f: inj(A,B) ==> converse(f): surj(range(f), A)";
-by (fast_tac (ZF_cs addIs (prems@[inj_converse_fun,apply_Pair,apply_equality,
- converseI,inj_is_fun])) 1);
-val inj_converse_surj = result();
-
-(*The premises are equivalent to saying that f is injective...*)
-val prems = goal Perm.thy
- "[| f: A->B; converse(f): C->A; a: A |] ==> converse(f)`(f`a) = a";
-by (fast_tac (ZF_cs addIs (prems@[apply_Pair,apply_equality,converseI])) 1);
-val left_inverse_lemma = result();
-
-val prems = goal Perm.thy
- "[| f: inj(A,B); a: A |] ==> converse(f)`(f`a) = a";
-by (fast_tac (ZF_cs addIs (prems@
- [left_inverse_lemma,inj_converse_fun,inj_is_fun])) 1);
-val left_inverse = result();
-
-val prems = goal Perm.thy
- "[| f: A->B; converse(f): C->A; b: C |] ==> f`(converse(f)`b) = b";
-by (rtac (apply_Pair RS (converseD RS apply_equality)) 1);
-by (REPEAT (resolve_tac prems 1));
-val right_inverse_lemma = result();
-
-val prems = goal Perm.thy
- "[| f: inj(A,B); b: range(f) |] ==> f`(converse(f)`b) = b";
-by (rtac right_inverse_lemma 1);
-by (REPEAT (resolve_tac (prems@ [inj_converse_fun,inj_is_fun]) 1));
-val right_inverse = result();
-
-val prems = goal Perm.thy
- "f: inj(A,B) ==> converse(f): inj(range(f), A)";
-bw inj_def; (*rewrite subgoal but not prems!!*)
-by (cut_facts_tac prems 1);
-by (safe_tac ZF_cs);
-(*apply f to both sides and simplify using right_inverse
- -- could also use etac[subst_context RS box_equals] in this proof *)
-by (rtac simp_equals 2);
-by (REPEAT (eresolve_tac [inj_converse_fun, right_inverse RS sym, ssubst] 1
- ORELSE ares_tac [refl,rangeI] 1));
-val inj_converse_inj = result();
-
-goalw Perm.thy [bij_def] "!!f A B. f: bij(A,B) ==> converse(f): bij(B,A)";
-by (etac IntE 1);
-by (eresolve_tac [(surj_range RS subst)] 1);
-by (rtac IntI 1);
-by (etac inj_converse_inj 1);
-by (etac inj_converse_surj 1);
-val bij_converse_bij = result();
-
-
-(** Composition of two relations **)
-
-(*The inductive definition package could derive these theorems for R o S*)
-
-goalw Perm.thy [comp_def] "!!r s. [| <a,b>:s; <b,c>:r |] ==> <a,c> : r O s";
-by (fast_tac ZF_cs 1);
-val compI = result();
-
-val prems = goalw Perm.thy [comp_def]
- "[| xz : r O s; \
-\ !!x y z. [| xz=<x,z>; <x,y>:s; <y,z>:r |] ==> P \
-\ |] ==> P";
-by (cut_facts_tac prems 1);
-by (REPEAT (eresolve_tac [CollectE, exE, conjE] 1 ORELSE ares_tac prems 1));
-val compE = result();
-
-val compEpair =
- rule_by_tactic (REPEAT_FIRST (etac Pair_inject ORELSE' bound_hyp_subst_tac)
- THEN prune_params_tac)
- (read_instantiate [("xz","<a,c>")] compE);
-
-val comp_cs = ZF_cs addIs [compI,idI] addSEs [compE,idE];
-
-(** Domain and Range -- see Suppes, section 3.1 **)
-
-(*Boyer et al., Set Theory in First-Order Logic, JAR 2 (1986), 287-327*)
-goal Perm.thy "range(r O s) <= range(r)";
-by (fast_tac comp_cs 1);
-val range_comp = result();
-
-goal Perm.thy "!!r s. domain(r) <= range(s) ==> range(r O s) = range(r)";
-by (rtac (range_comp RS equalityI) 1);
-by (fast_tac comp_cs 1);
-val range_comp_eq = result();
-
-goal Perm.thy "domain(r O s) <= domain(s)";
-by (fast_tac comp_cs 1);
-val domain_comp = result();
-
-goal Perm.thy "!!r s. range(s) <= domain(r) ==> domain(r O s) = domain(s)";
-by (rtac (domain_comp RS equalityI) 1);
-by (fast_tac comp_cs 1);
-val domain_comp_eq = result();
-
-goal Perm.thy "(r O s)``A = r``(s``A)";
-by (fast_tac (comp_cs addIs [equalityI]) 1);
-val image_comp = result();
-
-
-(** Other results **)
-
-goal Perm.thy "!!r s. [| r'<=r; s'<=s |] ==> (r' O s') <= (r O s)";
-by (fast_tac comp_cs 1);
-val comp_mono = result();
-
-(*composition preserves relations*)
-goal Perm.thy "!!r s. [| s<=A*B; r<=B*C |] ==> (r O s) <= A*C";
-by (fast_tac comp_cs 1);
-val comp_rel = result();
-
-(*associative law for composition*)
-goal Perm.thy "(r O s) O t = r O (s O t)";
-by (fast_tac (comp_cs addIs [equalityI]) 1);
-val comp_assoc = result();
-
-(*left identity of composition; provable inclusions are
- id(A) O r <= r
- and [| r<=A*B; B<=C |] ==> r <= id(C) O r *)
-goal Perm.thy "!!r A B. r<=A*B ==> id(B) O r = r";
-by (fast_tac (comp_cs addIs [equalityI]) 1);
-val left_comp_id = result();
-
-(*right identity of composition; provable inclusions are
- r O id(A) <= r
- and [| r<=A*B; A<=C |] ==> r <= r O id(C) *)
-goal Perm.thy "!!r A B. r<=A*B ==> r O id(A) = r";
-by (fast_tac (comp_cs addIs [equalityI]) 1);
-val right_comp_id = result();
-
-
-(** Composition preserves functions, injections, and surjections **)
-
-goal Perm.thy "!!f g. [| g: A->B; f: B->C |] ==> (f O g) : A->C";
-by (REPEAT (ares_tac [PiI,comp_rel,ex1I,compI] 1
- ORELSE eresolve_tac [fun_is_rel,apply_Pair,apply_type] 1));
-by (fast_tac (comp_cs addDs [apply_equality]) 1);
-val comp_func = result();
-
-goal Perm.thy "!!f g. [| g: A->B; f: B->C; a:A |] ==> (f O g)`a = f`(g`a)";
-by (REPEAT (ares_tac [comp_func,apply_equality,compI,
- apply_Pair,apply_type] 1));
-val comp_func_apply = result();
-
-goalw Perm.thy [inj_def]
- "!!f g. [| g: inj(A,B); f: inj(B,C) |] ==> (f O g) : inj(A,C)";
-by (REPEAT (eresolve_tac [bspec RS bspec RS mp, box_equals] 1
- ORELSE step_tac (ZF_cs addSIs [comp_func,apply_type,comp_func_apply]) 1));
-val comp_inj = result();
-
-goalw Perm.thy [surj_def]
- "!!f g. [| g: surj(A,B); f: surj(B,C) |] ==> (f O g) : surj(A,C)";
-by (best_tac (ZF_cs addSIs [comp_func,comp_func_apply]) 1);
-val comp_surj = result();
-
-goalw Perm.thy [bij_def]
- "!!f g. [| g: bij(A,B); f: bij(B,C) |] ==> (f O g) : bij(A,C)";
-by (fast_tac (ZF_cs addIs [comp_inj,comp_surj]) 1);
-val comp_bij = result();
-
-
-(** Dual properties of inj and surj -- useful for proofs from
- D Pastre. Automatic theorem proving in set theory.
- Artificial Intelligence, 10:1--27, 1978. **)
-
-goalw Perm.thy [inj_def]
- "!!f g. [| (f O g): inj(A,C); g: A->B; f: B->C |] ==> g: inj(A,B)";
-by (safe_tac comp_cs);
-by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp] 1));
-by (asm_simp_tac (FOL_ss addsimps [comp_func_apply]) 1);
-val comp_mem_injD1 = result();
-
-goalw Perm.thy [inj_def,surj_def]
- "!!f g. [| (f O g): inj(A,C); g: surj(A,B); f: B->C |] ==> f: inj(B,C)";
-by (safe_tac comp_cs);
-by (res_inst_tac [("x1", "x")] (bspec RS bexE) 1);
-by (eres_inst_tac [("x1", "w")] (bspec RS bexE) 3);
-by (REPEAT (assume_tac 1));
-by (safe_tac comp_cs);
-by (res_inst_tac [("t", "op `(g)")] subst_context 1);
-by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp] 1));
-by (asm_simp_tac (FOL_ss addsimps [comp_func_apply]) 1);
-val comp_mem_injD2 = result();
-
-goalw Perm.thy [surj_def]
- "!!f g. [| (f O g): surj(A,C); g: A->B; f: B->C |] ==> f: surj(B,C)";
-by (fast_tac (comp_cs addSIs [comp_func_apply RS sym, apply_type]) 1);
-val comp_mem_surjD1 = result();
-
-goal Perm.thy
- "!!f g. [| (f O g)`a = c; g: A->B; f: B->C; a:A |] ==> f`(g`a) = c";
-by (REPEAT (ares_tac [comp_func_apply RS sym RS trans] 1));
-val comp_func_applyD = result();
-
-goalw Perm.thy [inj_def,surj_def]
- "!!f g. [| (f O g): surj(A,C); g: A->B; f: inj(B,C) |] ==> g: surj(A,B)";
-by (safe_tac comp_cs);
-by (eres_inst_tac [("x1", "f`y")] (bspec RS bexE) 1);
-by (REPEAT (ares_tac [apply_type] 1 ORELSE dtac comp_func_applyD 1));
-by (best_tac (comp_cs addSIs [apply_type]) 1);
-val comp_mem_surjD2 = result();
-
-
-(** inverses of composition **)
-
-(*left inverse of composition; one inclusion is
- f: A->B ==> id(A) <= converse(f) O f *)
-val [prem] = goal Perm.thy
- "f: inj(A,B) ==> converse(f) O f = id(A)";
-val injfD = prem RSN (3,inj_equality);
-by (cut_facts_tac [prem RS inj_is_fun] 1);
-by (fast_tac (comp_cs addIs [equalityI,apply_Pair]
- addEs [domain_type, make_elim injfD]) 1);
-val left_comp_inverse = result();
-
-(*right inverse of composition; one inclusion is
- f: A->B ==> f O converse(f) <= id(B) *)
-val [prem] = goalw Perm.thy [surj_def]
- "f: surj(A,B) ==> f O converse(f) = id(B)";
-val appfD = (prem RS CollectD1) RSN (3,apply_equality2);
-by (cut_facts_tac [prem] 1);
-by (rtac equalityI 1);
-by (best_tac (comp_cs addEs [domain_type, range_type, make_elim appfD]) 1);
-by (best_tac (comp_cs addIs [apply_Pair]) 1);
-val right_comp_inverse = result();
-
-(*Injective case applies converse(f) to both sides then simplifies
- using left_inverse_lemma*)
-goalw Perm.thy [bij_def,inj_def,surj_def]
- "!!f A B. [| converse(f): B->A; f: A->B |] ==> f : bij(A,B)";
-val cf_cong = read_instantiate_sg (sign_of Perm.thy)
- [("t","%x.?f`x")] subst_context;
-by (fast_tac (ZF_cs addIs [left_inverse_lemma, right_inverse_lemma, apply_type]
- addEs [cf_cong RS box_equals]) 1);
-val invertible_imp_bijective = result();
-
-(** Unions of functions -- cf similar theorems on func.ML **)
-
-goal Perm.thy "converse(r Un s) = converse(r) Un converse(s)";
-by (rtac equalityI 1);
-by (DEPTH_SOLVE_1
- (resolve_tac [Un_least,converse_mono, Un_upper1,Un_upper2] 2));
-by (fast_tac ZF_cs 1);
-val converse_of_Un = result();
-
-goalw Perm.thy [surj_def]
- "!!f g. [| f: surj(A,B); g: surj(C,D); A Int C = 0 |] ==> \
-\ (f Un g) : surj(A Un C, B Un D)";
-by (DEPTH_SOLVE_1 (eresolve_tac [fun_disjoint_apply1, fun_disjoint_apply2] 1
- ORELSE ball_tac 1
- ORELSE (rtac trans 1 THEN atac 2)
- ORELSE step_tac (ZF_cs addIs [fun_disjoint_Un]) 1));
-val surj_disjoint_Un = result();
-
-(*A simple, high-level proof; the version for injections follows from it,
- using f:inj(A,B)<->f:bij(A,range(f)) *)
-goal Perm.thy
- "!!f g. [| f: bij(A,B); g: bij(C,D); A Int C = 0; B Int D = 0 |] ==> \
-\ (f Un g) : bij(A Un C, B Un D)";
-by (rtac invertible_imp_bijective 1);
-by (rtac (converse_of_Un RS ssubst) 1);
-by (REPEAT (ares_tac [fun_disjoint_Un, bij_is_fun, bij_converse_bij] 1));
-val bij_disjoint_Un = result();
-
-
-(** Restrictions as surjections and bijections *)
-
-val prems = goalw Perm.thy [surj_def]
- "f: Pi(A,B) ==> f: surj(A, f``A)";
-val rls = apply_equality :: (prems RL [apply_Pair,Pi_type]);
-by (fast_tac (ZF_cs addIs rls) 1);
-val surj_image = result();
-
-goal Perm.thy
- "!!f. [| f: Pi(C,B); A<=C |] ==> restrict(f,A)``A = f``A";
-by (rtac equalityI 1);
-by (SELECT_GOAL (rewtac restrict_def) 2);
-by (REPEAT (eresolve_tac [imageE, apply_equality RS subst] 2
- ORELSE ares_tac [subsetI,lamI,imageI] 2));
-by (REPEAT (ares_tac [image_mono,restrict_subset,subset_refl] 1));
-val restrict_image = result();
-
-goalw Perm.thy [inj_def]
- "!!f. [| f: inj(A,B); C<=A |] ==> restrict(f,C): inj(C,B)";
-by (safe_tac (ZF_cs addSEs [restrict_type2]));
-by (REPEAT (eresolve_tac [asm_rl, bspec RS bspec RS mp, subsetD,
- box_equals, restrict] 1));
-val restrict_inj = result();
-
-val prems = goal Perm.thy
- "[| f: Pi(A,B); C<=A |] ==> restrict(f,C): surj(C, f``C)";
-by (rtac (restrict_image RS subst) 1);
-by (rtac (restrict_type2 RS surj_image) 3);
-by (REPEAT (resolve_tac prems 1));
-val restrict_surj = result();
-
-goalw Perm.thy [inj_def,bij_def]
- "!!f. [| f: inj(A,B); C<=A |] ==> restrict(f,C): bij(C, f``C)";
-by (safe_tac ZF_cs);
-by (REPEAT (eresolve_tac [bspec RS bspec RS mp, subsetD,
- box_equals, restrict] 1
- ORELSE ares_tac [surj_is_fun,restrict_surj] 1));
-val restrict_bij = result();
-
-
-(*** Lemmas for Ramsey's Theorem ***)
-
-goalw Perm.thy [inj_def] "!!f. [| f: inj(A,B); B<=D |] ==> f: inj(A,D)";
-by (fast_tac (ZF_cs addSEs [fun_weaken_type]) 1);
-val inj_weaken_type = result();
-
-val [major] = goal Perm.thy
- "[| f: inj(succ(m), A) |] ==> restrict(f,m) : inj(m, A-{f`m})";
-by (rtac (major RS restrict_bij RS bij_is_inj RS inj_weaken_type) 1);
-by (fast_tac ZF_cs 1);
-by (cut_facts_tac [major] 1);
-by (rewtac inj_def);
-by (safe_tac ZF_cs);
-by (etac range_type 1);
-by (assume_tac 1);
-by (dtac apply_equality 1);
-by (assume_tac 1);
-by (res_inst_tac [("a","m")] mem_anti_refl 1);
-by (fast_tac ZF_cs 1);
-val inj_succ_restrict = result();
-
-goalw Perm.thy [inj_def]
- "!!f. [| f: inj(A,B); a~:A; b~:B |] ==> \
-\ cons(<a,b>,f) : inj(cons(a,A), cons(b,B))";
-(*cannot use safe_tac: must preserve the implication*)
-by (etac CollectE 1);
-by (rtac CollectI 1);
-by (etac fun_extend 1);
-by (REPEAT (ares_tac [ballI] 1));
-by (REPEAT_FIRST (eresolve_tac [consE,ssubst]));
-(*Assumption ALL w:A. ALL x:A. f`w = f`x --> w=x would make asm_simp_tac loop
- using ZF_ss! But FOL_ss ignores the assumption...*)
-by (ALLGOALS (asm_simp_tac
- (FOL_ss addsimps [fun_extend_apply2,fun_extend_apply1])));
-by (ALLGOALS (fast_tac (ZF_cs addIs [apply_type])));
-val inj_extend = result();
--- a/src/ZF/perm.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,36 +0,0 @@
-(* Title: ZF/perm
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1991 University of Cambridge
-
-The theory underlying permutation groups
- -- Composition of relations, the identity relation
- -- Injections, surjections, bijections
- -- Lemmas for the Schroeder-Bernstein Theorem
-*)
-
-Perm = ZF + "mono" +
-consts
- O :: "[i,i]=>i" (infixr 60)
- id :: "i=>i"
- inj,surj,bij:: "[i,i]=>i"
-
-rules
-
- (*composition of relations and functions; NOT Suppes's relative product*)
- comp_def "r O s == {xz : domain(s)*range(r) . \
-\ EX x y z. xz=<x,z> & <x,y>:s & <y,z>:r}"
-
- (*the identity function for A*)
- id_def "id(A) == (lam x:A. x)"
-
- (*one-to-one functions from A to B*)
- inj_def "inj(A,B) == { f: A->B. ALL w:A. ALL x:A. f`w=f`x --> w=x}"
-
- (*onto functions from A to B*)
- surj_def "surj(A,B) == { f: A->B . ALL y:B. EX x:A. f`x=y}"
-
- (*one-to-one and onto functions*)
- bij_def "bij(A,B) == inj(A,B) Int surj(A,B)"
-
-end
--- a/src/ZF/qpair.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,281 +0,0 @@
-(* Title: ZF/qpair.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For qpair.thy.
-
-Quine-inspired ordered pairs and disjoint sums, for non-well-founded data
-structures in ZF. Does not precisely follow Quine's construction. Thanks
-to Thomas Forster for suggesting this approach!
-
-W. V. Quine, On Ordered Pairs and Relations, in Selected Logic Papers,
-1966.
-
-Many proofs are borrowed from pair.ML and sum.ML
-
-Do we EVER have rank(a) < rank(<a;b>) ? Perhaps if the latter rank
- is not a limit ordinal?
-*)
-
-
-open QPair;
-
-(**** Quine ordered pairing ****)
-
-(** Lemmas for showing that <a;b> uniquely determines a and b **)
-
-val QPair_iff = prove_goalw QPair.thy [QPair_def]
- "<a;b> = <c;d> <-> a=c & b=d"
- (fn _=> [rtac sum_equal_iff 1]);
-
-val QPair_inject = standard (QPair_iff RS iffD1 RS conjE);
-
-val QPair_inject1 = prove_goal QPair.thy "<a;b> = <c;d> ==> a=c"
- (fn [major]=>
- [ (rtac (major RS QPair_inject) 1), (assume_tac 1) ]);
-
-val QPair_inject2 = prove_goal QPair.thy "<a;b> = <c;d> ==> b=d"
- (fn [major]=>
- [ (rtac (major RS QPair_inject) 1), (assume_tac 1) ]);
-
-
-(*** QSigma: Disjoint union of a family of sets
- Generalizes Cartesian product ***)
-
-val QSigmaI = prove_goalw QPair.thy [QSigma_def]
- "[| a:A; b:B(a) |] ==> <a;b> : QSigma(A,B)"
- (fn prems=> [ (REPEAT (resolve_tac (prems@[singletonI,UN_I]) 1)) ]);
-
-(*The general elimination rule*)
-val QSigmaE = prove_goalw QPair.thy [QSigma_def]
- "[| c: QSigma(A,B); \
-\ !!x y.[| x:A; y:B(x); c=<x;y> |] ==> P \
-\ |] ==> P"
- (fn major::prems=>
- [ (cut_facts_tac [major] 1),
- (REPEAT (eresolve_tac [UN_E, singletonE] 1 ORELSE ares_tac prems 1)) ]);
-
-(** Elimination rules for <a;b>:A*B -- introducing no eigenvariables **)
-
-val QSigmaE2 =
- rule_by_tactic (REPEAT_FIRST (etac QPair_inject ORELSE' bound_hyp_subst_tac)
- THEN prune_params_tac)
- (read_instantiate [("c","<a;b>")] QSigmaE);
-
-val QSigmaD1 = prove_goal QPair.thy "<a;b> : QSigma(A,B) ==> a : A"
- (fn [major]=>
- [ (rtac (major RS QSigmaE2) 1), (assume_tac 1) ]);
-
-val QSigmaD2 = prove_goal QPair.thy "<a;b> : QSigma(A,B) ==> b : B(a)"
- (fn [major]=>
- [ (rtac (major RS QSigmaE2) 1), (assume_tac 1) ]);
-
-val QSigma_cong = prove_goalw QPair.thy [QSigma_def]
- "[| A=A'; !!x. x:A' ==> B(x)=B'(x) |] ==> \
-\ QSigma(A,B) = QSigma(A',B')"
- (fn prems=> [ (simp_tac (ZF_ss addsimps prems) 1) ]);
-
-val QSigma_empty1 = prove_goal QPair.thy "QSigma(0,B) = 0"
- (fn _ => [ (fast_tac (ZF_cs addIs [equalityI] addSEs [QSigmaE]) 1) ]);
-
-val QSigma_empty2 = prove_goal QPair.thy "A <*> 0 = 0"
- (fn _ => [ (fast_tac (ZF_cs addIs [equalityI] addSEs [QSigmaE]) 1) ]);
-
-
-(*** Eliminator - qsplit ***)
-
-val qsplit = prove_goalw QPair.thy [qsplit_def]
- "qsplit(%x y.c(x,y), <a;b>) = c(a,b)"
- (fn _ => [ (fast_tac (ZF_cs addIs [the_equality] addEs [QPair_inject]) 1) ]);
-
-val qsplit_type = prove_goal QPair.thy
- "[| p:QSigma(A,B); \
-\ !!x y.[| x:A; y:B(x) |] ==> c(x,y):C(<x;y>) \
-\ |] ==> qsplit(%x y.c(x,y), p) : C(p)"
- (fn major::prems=>
- [ (rtac (major RS QSigmaE) 1),
- (etac ssubst 1),
- (REPEAT (ares_tac (prems @ [qsplit RS ssubst]) 1)) ]);
-
-
-val qpair_cs = ZF_cs addSIs [QSigmaI] addSEs [QSigmaE2, QSigmaE, QPair_inject];
-
-(*** qconverse ***)
-
-val qconverseI = prove_goalw QPair.thy [qconverse_def]
- "!!a b r. <a;b>:r ==> <b;a>:qconverse(r)"
- (fn _ => [ (fast_tac qpair_cs 1) ]);
-
-val qconverseD = prove_goalw QPair.thy [qconverse_def]
- "!!a b r. <a;b> : qconverse(r) ==> <b;a> : r"
- (fn _ => [ (fast_tac qpair_cs 1) ]);
-
-val qconverseE = prove_goalw QPair.thy [qconverse_def]
- "[| yx : qconverse(r); \
-\ !!x y. [| yx=<y;x>; <x;y>:r |] ==> P \
-\ |] ==> P"
- (fn [major,minor]=>
- [ (rtac (major RS ReplaceE) 1),
- (REPEAT (eresolve_tac [exE, conjE, minor] 1)),
- (hyp_subst_tac 1),
- (assume_tac 1) ]);
-
-val qconverse_cs = qpair_cs addSIs [qconverseI]
- addSEs [qconverseD,qconverseE];
-
-val qconverse_of_qconverse = prove_goal QPair.thy
- "!!A B r. r<=QSigma(A,B) ==> qconverse(qconverse(r)) = r"
- (fn _ => [ (fast_tac (qconverse_cs addSIs [equalityI]) 1) ]);
-
-val qconverse_type = prove_goal QPair.thy
- "!!A B r. r <= A <*> B ==> qconverse(r) <= B <*> A"
- (fn _ => [ (fast_tac qconverse_cs 1) ]);
-
-val qconverse_of_prod = prove_goal QPair.thy "qconverse(A <*> B) = B <*> A"
- (fn _ => [ (fast_tac (qconverse_cs addSIs [equalityI]) 1) ]);
-
-val qconverse_empty = prove_goal QPair.thy "qconverse(0) = 0"
- (fn _ => [ (fast_tac (qconverse_cs addSIs [equalityI]) 1) ]);
-
-
-(*** qsplit for predicates: result type o ***)
-
-goalw QPair.thy [qfsplit_def] "!!R a b. R(a,b) ==> qfsplit(R, <a;b>)";
-by (REPEAT (ares_tac [refl,exI,conjI] 1));
-val qfsplitI = result();
-
-val major::prems = goalw QPair.thy [qfsplit_def]
- "[| qfsplit(R,z); !!x y. [| z = <x;y>; R(x,y) |] ==> P |] ==> P";
-by (cut_facts_tac [major] 1);
-by (REPEAT (eresolve_tac (prems@[asm_rl,exE,conjE]) 1));
-val qfsplitE = result();
-
-goal QPair.thy "!!R a b. qfsplit(R,<a;b>) ==> R(a,b)";
-by (REPEAT (eresolve_tac [asm_rl,qfsplitE,QPair_inject,ssubst] 1));
-val qfsplitD = result();
-
-
-(**** The Quine-inspired notion of disjoint sum ****)
-
-val qsum_defs = [qsum_def,QInl_def,QInr_def,qcase_def];
-
-(** Introduction rules for the injections **)
-
-goalw QPair.thy qsum_defs "!!a A B. a : A ==> QInl(a) : A <+> B";
-by (REPEAT (ares_tac [UnI1,QSigmaI,singletonI] 1));
-val QInlI = result();
-
-goalw QPair.thy qsum_defs "!!b A B. b : B ==> QInr(b) : A <+> B";
-by (REPEAT (ares_tac [UnI2,QSigmaI,singletonI] 1));
-val QInrI = result();
-
-(** Elimination rules **)
-
-val major::prems = goalw QPair.thy qsum_defs
- "[| u: A <+> B; \
-\ !!x. [| x:A; u=QInl(x) |] ==> P; \
-\ !!y. [| y:B; u=QInr(y) |] ==> P \
-\ |] ==> P";
-by (rtac (major RS UnE) 1);
-by (REPEAT (rtac refl 1
- ORELSE eresolve_tac (prems@[QSigmaE,singletonE,ssubst]) 1));
-val qsumE = result();
-
-(** Injection and freeness equivalences, for rewriting **)
-
-goalw QPair.thy qsum_defs "QInl(a)=QInl(b) <-> a=b";
-by (simp_tac (ZF_ss addsimps [QPair_iff]) 1);
-val QInl_iff = result();
-
-goalw QPair.thy qsum_defs "QInr(a)=QInr(b) <-> a=b";
-by (simp_tac (ZF_ss addsimps [QPair_iff]) 1);
-val QInr_iff = result();
-
-goalw QPair.thy qsum_defs "QInl(a)=QInr(b) <-> False";
-by (simp_tac (ZF_ss addsimps [QPair_iff, one_not_0 RS not_sym]) 1);
-val QInl_QInr_iff = result();
-
-goalw QPair.thy qsum_defs "QInr(b)=QInl(a) <-> False";
-by (simp_tac (ZF_ss addsimps [QPair_iff, one_not_0]) 1);
-val QInr_QInl_iff = result();
-
-(*Injection and freeness rules*)
-
-val QInl_inject = standard (QInl_iff RS iffD1);
-val QInr_inject = standard (QInr_iff RS iffD1);
-val QInl_neq_QInr = standard (QInl_QInr_iff RS iffD1 RS FalseE);
-val QInr_neq_QInl = standard (QInr_QInl_iff RS iffD1 RS FalseE);
-
-val qsum_cs =
- ZF_cs addIs [QInlI,QInrI] addSEs [qsumE,QInl_neq_QInr,QInr_neq_QInl]
- addSDs [QInl_inject,QInr_inject];
-
-goal QPair.thy "!!A B. QInl(a): A<+>B ==> a: A";
-by (fast_tac qsum_cs 1);
-val QInlD = result();
-
-goal QPair.thy "!!A B. QInr(b): A<+>B ==> b: B";
-by (fast_tac qsum_cs 1);
-val QInrD = result();
-
-(** <+> is itself injective... who cares?? **)
-
-goal QPair.thy
- "u: A <+> B <-> (EX x. x:A & u=QInl(x)) | (EX y. y:B & u=QInr(y))";
-by (fast_tac qsum_cs 1);
-val qsum_iff = result();
-
-goal QPair.thy "A <+> B <= C <+> D <-> A<=C & B<=D";
-by (fast_tac qsum_cs 1);
-val qsum_subset_iff = result();
-
-goal QPair.thy "A <+> B = C <+> D <-> A=C & B=D";
-by (simp_tac (ZF_ss addsimps [extension,qsum_subset_iff]) 1);
-by (fast_tac ZF_cs 1);
-val qsum_equal_iff = result();
-
-(*** Eliminator -- qcase ***)
-
-goalw QPair.thy qsum_defs "qcase(c, d, QInl(a)) = c(a)";
-by (rtac (qsplit RS trans) 1);
-by (rtac cond_0 1);
-val qcase_QInl = result();
-
-goalw QPair.thy qsum_defs "qcase(c, d, QInr(b)) = d(b)";
-by (rtac (qsplit RS trans) 1);
-by (rtac cond_1 1);
-val qcase_QInr = result();
-
-val major::prems = goal QPair.thy
- "[| u: A <+> B; \
-\ !!x. x: A ==> c(x): C(QInl(x)); \
-\ !!y. y: B ==> d(y): C(QInr(y)) \
-\ |] ==> qcase(c,d,u) : C(u)";
-by (rtac (major RS qsumE) 1);
-by (ALLGOALS (etac ssubst));
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps
- (prems@[qcase_QInl,qcase_QInr]))));
-val qcase_type = result();
-
-(** Rules for the Part primitive **)
-
-goal QPair.thy "Part(A <+> B,QInl) = {QInl(x). x: A}";
-by (fast_tac (qsum_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_QInl = result();
-
-goal QPair.thy "Part(A <+> B,QInr) = {QInr(y). y: B}";
-by (fast_tac (qsum_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_QInr = result();
-
-goal QPair.thy "Part(A <+> B, %x.QInr(h(x))) = {QInr(y). y: Part(B,h)}";
-by (fast_tac (qsum_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_QInr2 = result();
-
-goal QPair.thy "!!A B C. C <= A <+> B ==> Part(C,QInl) Un Part(C,QInr) = C";
-by (rtac equalityI 1);
-by (rtac Un_least 1);
-by (rtac Part_subset 1);
-by (rtac Part_subset 1);
-by (fast_tac (ZF_cs addIs [PartI] addSEs [qsumE]) 1);
-val Part_qsum_equality = result();
--- a/src/ZF/qpair.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,48 +0,0 @@
-(* Title: ZF/qpair.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Quine-inspired ordered pairs and disjoint sums, for non-well-founded data
-structures in ZF. Does not precisely follow Quine's construction. Thanks
-to Thomas Forster for suggesting this approach!
-
-W. V. Quine, On Ordered Pairs and Relations, in Selected Logic Papers,
-1966.
-*)
-
-QPair = Sum + "simpdata" +
-consts
- QPair :: "[i, i] => i" ("<(_;/ _)>")
- qsplit :: "[[i,i] => i, i] => i"
- qfsplit :: "[[i,i] => o, i] => o"
- qconverse :: "i => i"
- "@QSUM" :: "[idt, i, i] => i" ("(3QSUM _:_./ _)" 10)
- " <*>" :: "[i, i] => i" ("(_ <*>/ _)" [81, 80] 80)
- QSigma :: "[i, i => i] => i"
-
- "<+>" :: "[i,i]=>i" (infixr 65)
- QInl,QInr :: "i=>i"
- qcase :: "[i=>i, i=>i, i]=>i"
-
-translations
- "QSUM x:A. B" => "QSigma(A, %x. B)"
- "A <*> B" => "QSigma(A, _K(B))"
-
-rules
- QPair_def "<a;b> == a+b"
- qsplit_def "qsplit(c,p) == THE y. EX a b. p=<a;b> & y=c(a,b)"
- qfsplit_def "qfsplit(R,z) == EX x y. z=<x;y> & R(x,y)"
- qconverse_def "qconverse(r) == {z. w:r, EX x y. w=<x;y> & z=<y;x>}"
- QSigma_def "QSigma(A,B) == UN x:A. UN y:B(x). {<x;y>}"
-
- qsum_def "A <+> B == ({0} <*> A) Un ({1} <*> B)"
- QInl_def "QInl(a) == <0;a>"
- QInr_def "QInr(b) == <1;b>"
- qcase_def "qcase(c,d) == qsplit(%y z. cond(y, d(z), c(z)))"
-end
-
-ML
-
-val print_translation =
- [("QSigma", dependent_tr' ("@QSUM", " <*>"))];
--- a/src/ZF/quniv.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,222 +0,0 @@
-(* Title: ZF/quniv
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-For quniv.thy. A small universe for lazy recursive types
-*)
-
-open QUniv;
-
-(** Introduction and elimination rules avoid tiresome folding/unfolding **)
-
-goalw QUniv.thy [quniv_def]
- "!!X A. X <= univ(eclose(A)) ==> X : quniv(A)";
-by (etac PowI 1);
-val qunivI = result();
-
-goalw QUniv.thy [quniv_def]
- "!!X A. X : quniv(A) ==> X <= univ(eclose(A))";
-by (etac PowD 1);
-val qunivD = result();
-
-goalw QUniv.thy [quniv_def] "!!A B. A<=B ==> quniv(A) <= quniv(B)";
-by (etac (eclose_mono RS univ_mono RS Pow_mono) 1);
-val quniv_mono = result();
-
-(*** Closure properties ***)
-
-goalw QUniv.thy [quniv_def] "univ(eclose(A)) <= quniv(A)";
-by (rtac (Transset_iff_Pow RS iffD1) 1);
-by (rtac (Transset_eclose RS Transset_univ) 1);
-val univ_eclose_subset_quniv = result();
-
-(*Key property for proving A_subset_quniv; requires eclose in def of quniv*)
-goal QUniv.thy "univ(A) <= quniv(A)";
-by (rtac (arg_subset_eclose RS univ_mono RS subset_trans) 1);
-by (rtac univ_eclose_subset_quniv 1);
-val univ_subset_quniv = result();
-
-val univ_into_quniv = standard (univ_subset_quniv RS subsetD);
-
-goalw QUniv.thy [quniv_def] "Pow(univ(A)) <= quniv(A)";
-by (rtac (arg_subset_eclose RS univ_mono RS Pow_mono) 1);
-val Pow_univ_subset_quniv = result();
-
-val univ_subset_into_quniv = standard
- (PowI RS (Pow_univ_subset_quniv RS subsetD));
-
-val zero_in_quniv = standard (zero_in_univ RS univ_into_quniv);
-val one_in_quniv = standard (one_in_univ RS univ_into_quniv);
-val two_in_quniv = standard (two_in_univ RS univ_into_quniv);
-
-val A_subset_quniv = standard
- ([A_subset_univ, univ_subset_quniv] MRS subset_trans);
-
-val A_into_quniv = A_subset_quniv RS subsetD;
-
-(*** univ(A) closure for Quine-inspired pairs and injections ***)
-
-(*Quine ordered pairs*)
-goalw QUniv.thy [QPair_def]
- "!!A a. [| a <= univ(A); b <= univ(A) |] ==> <a;b> <= univ(A)";
-by (REPEAT (ares_tac [sum_subset_univ] 1));
-val QPair_subset_univ = result();
-
-(** Quine disjoint sum **)
-
-goalw QUniv.thy [QInl_def] "!!A a. a <= univ(A) ==> QInl(a) <= univ(A)";
-by (etac (empty_subsetI RS QPair_subset_univ) 1);
-val QInl_subset_univ = result();
-
-val naturals_subset_nat =
- rewrite_rule [Transset_def] (Ord_nat RS Ord_is_Transset)
- RS bspec;
-
-val naturals_subset_univ =
- [naturals_subset_nat, nat_subset_univ] MRS subset_trans;
-
-goalw QUniv.thy [QInr_def] "!!A a. a <= univ(A) ==> QInr(a) <= univ(A)";
-by (etac (nat_1I RS naturals_subset_univ RS QPair_subset_univ) 1);
-val QInr_subset_univ = result();
-
-(*** Closure for Quine-inspired products and sums ***)
-
-(*Quine ordered pairs*)
-goalw QUniv.thy [quniv_def,QPair_def]
- "!!A a. [| a: quniv(A); b: quniv(A) |] ==> <a;b> : quniv(A)";
-by (REPEAT (dtac PowD 1));
-by (REPEAT (ares_tac [PowI, sum_subset_univ] 1));
-val QPair_in_quniv = result();
-
-goal QUniv.thy "quniv(A) <*> quniv(A) <= quniv(A)";
-by (REPEAT (ares_tac [subsetI, QPair_in_quniv] 1
- ORELSE eresolve_tac [QSigmaE, ssubst] 1));
-val QSigma_quniv = result();
-
-val QSigma_subset_quniv = standard
- (QSigma_mono RS (QSigma_quniv RSN (2,subset_trans)));
-
-(*The opposite inclusion*)
-goalw QUniv.thy [quniv_def,QPair_def]
- "!!A a b. <a;b> : quniv(A) ==> a: quniv(A) & b: quniv(A)";
-by (etac ([Transset_eclose RS Transset_univ, PowD] MRS
- Transset_includes_summands RS conjE) 1);
-by (REPEAT (ares_tac [conjI,PowI] 1));
-val quniv_QPair_D = result();
-
-val quniv_QPair_E = standard (quniv_QPair_D RS conjE);
-
-goal QUniv.thy "<a;b> : quniv(A) <-> a: quniv(A) & b: quniv(A)";
-by (REPEAT (ares_tac [iffI, QPair_in_quniv, quniv_QPair_D] 1
- ORELSE etac conjE 1));
-val quniv_QPair_iff = result();
-
-
-(** Quine disjoint sum **)
-
-goalw QUniv.thy [QInl_def] "!!A a. a: quniv(A) ==> QInl(a) : quniv(A)";
-by (REPEAT (ares_tac [zero_in_quniv,QPair_in_quniv] 1));
-val QInl_in_quniv = result();
-
-goalw QUniv.thy [QInr_def] "!!A b. b: quniv(A) ==> QInr(b) : quniv(A)";
-by (REPEAT (ares_tac [one_in_quniv, QPair_in_quniv] 1));
-val QInr_in_quniv = result();
-
-goal QUniv.thy "quniv(C) <+> quniv(C) <= quniv(C)";
-by (REPEAT (ares_tac [subsetI, QInl_in_quniv, QInr_in_quniv] 1
- ORELSE eresolve_tac [qsumE, ssubst] 1));
-val qsum_quniv = result();
-
-val qsum_subset_quniv = standard
- (qsum_mono RS (qsum_quniv RSN (2,subset_trans)));
-
-(*** The natural numbers ***)
-
-val nat_subset_quniv = standard
- ([nat_subset_univ, univ_subset_quniv] MRS subset_trans);
-
-(* n:nat ==> n:quniv(A) *)
-val nat_into_quniv = standard (nat_subset_quniv RS subsetD);
-
-val bool_subset_quniv = standard
- ([bool_subset_univ, univ_subset_quniv] MRS subset_trans);
-
-val bool_into_quniv = standard (bool_subset_quniv RS subsetD);
-
-
-(**** Properties of Vfrom analogous to the "take-lemma" ****)
-
-(*** Intersecting a*b with Vfrom... ***)
-
-(*This version says a, b exist one level down, in the smaller set Vfrom(X,i)*)
-goal Univ.thy
- "!!X. [| {a,b} : Vfrom(X,succ(i)); Transset(X) |] ==> \
-\ a: Vfrom(X,i) & b: Vfrom(X,i)";
-by (dtac (Transset_Vfrom_succ RS equalityD1 RS subsetD RS PowD) 1);
-by (assume_tac 1);
-by (fast_tac ZF_cs 1);
-val doubleton_in_Vfrom_D = result();
-
-(*This weaker version says a, b exist at the same level*)
-val Vfrom_doubleton_D = standard (Transset_Vfrom RS Transset_doubleton_D);
-
-(** Using only the weaker theorem would prove <a,b> : Vfrom(X,i)
- implies a, b : Vfrom(X,i), which is useless for induction.
- Using only the stronger theorem would prove <a,b> : Vfrom(X,succ(succ(i)))
- implies a, b : Vfrom(X,i), leaving the succ(i) case untreated.
- The combination gives a reduction by precisely one level, which is
- most convenient for proofs.
-**)
-
-goalw Univ.thy [Pair_def]
- "!!X. [| <a,b> : Vfrom(X,succ(i)); Transset(X) |] ==> \
-\ a: Vfrom(X,i) & b: Vfrom(X,i)";
-by (fast_tac (ZF_cs addSDs [doubleton_in_Vfrom_D, Vfrom_doubleton_D]) 1);
-val Pair_in_Vfrom_D = result();
-
-goal Univ.thy
- "!!X. Transset(X) ==> \
-\ (a*b) Int Vfrom(X, succ(i)) <= (a Int Vfrom(X,i)) * (b Int Vfrom(X,i))";
-by (fast_tac (ZF_cs addSDs [Pair_in_Vfrom_D]) 1);
-val product_Int_Vfrom_subset = result();
-
-(*** Intersecting <a;b> with Vfrom... ***)
-
-goalw QUniv.thy [QPair_def,sum_def]
- "!!X. Transset(X) ==> \
-\ <a;b> Int Vfrom(X, succ(i)) <= <a Int Vfrom(X,i); b Int Vfrom(X,i)>";
-by (rtac (Int_Un_distrib RS ssubst) 1);
-by (rtac Un_mono 1);
-by (REPEAT (ares_tac [product_Int_Vfrom_subset RS subset_trans,
- [Int_lower1, subset_refl] MRS Sigma_mono] 1));
-val QPair_Int_Vfrom_succ_subset = result();
-
-(**** "Take-lemma" rules for proving a=b by coinduction and c: quniv(A) ****)
-
-(*Rule for level i -- preserving the level, not decreasing it*)
-
-goalw QUniv.thy [QPair_def]
- "!!X. Transset(X) ==> \
-\ <a;b> Int Vfrom(X,i) <= <a Int Vfrom(X,i); b Int Vfrom(X,i)>";
-by (etac (Transset_Vfrom RS Transset_sum_Int_subset) 1);
-val QPair_Int_Vfrom_subset = result();
-
-(*[| a Int Vset(i) <= c; b Int Vset(i) <= d |] ==> <a;b> Int Vset(i) <= <c;d>*)
-val QPair_Int_Vset_subset_trans = standard
- ([Transset_0 RS QPair_Int_Vfrom_subset, QPair_mono] MRS subset_trans);
-
-goal QUniv.thy
- "!!i. [| Ord(i) \
-\ |] ==> <a;b> Int Vset(i) <= (UN j:i. <a Int Vset(j); b Int Vset(j)>)";
-by (etac Ord_cases 1 THEN REPEAT_FIRST hyp_subst_tac);
-(*0 case*)
-by (rtac (Vfrom_0 RS ssubst) 1);
-by (fast_tac ZF_cs 1);
-(*succ(j) case*)
-by (rtac (Transset_0 RS QPair_Int_Vfrom_succ_subset RS subset_trans) 1);
-by (rtac (succI1 RS UN_upper) 1);
-(*Limit(i) case*)
-by (asm_simp_tac (ZF_ss addsimps [Limit_Vfrom_eq, Int_UN_distrib, subset_refl,
- UN_mono, QPair_Int_Vset_subset_trans]) 1);
-val QPair_Int_Vset_subset_UN = result();
--- a/src/ZF/quniv.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,16 +0,0 @@
-(* Title: ZF/univ.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-A small universe for lazy recursive types
-*)
-
-QUniv = Univ + QPair + "mono" + "equalities" +
-consts
- quniv :: "i=>i"
-
-rules
- quniv_def "quniv(A) == Pow(univ(eclose(A)))"
-
-end
--- a/src/ZF/sum.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,158 +0,0 @@
-(* Title: ZF/sum
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Disjoint sums in Zermelo-Fraenkel Set Theory
-*)
-
-open Sum;
-
-val sum_defs = [sum_def,Inl_def,Inr_def,case_def];
-
-(** Introduction rules for the injections **)
-
-goalw Sum.thy sum_defs "!!a A B. a : A ==> Inl(a) : A+B";
-by (REPEAT (ares_tac [UnI1,SigmaI,singletonI] 1));
-val InlI = result();
-
-goalw Sum.thy sum_defs "!!b A B. b : B ==> Inr(b) : A+B";
-by (REPEAT (ares_tac [UnI2,SigmaI,singletonI] 1));
-val InrI = result();
-
-(** Elimination rules **)
-
-val major::prems = goalw Sum.thy sum_defs
- "[| u: A+B; \
-\ !!x. [| x:A; u=Inl(x) |] ==> P; \
-\ !!y. [| y:B; u=Inr(y) |] ==> P \
-\ |] ==> P";
-by (rtac (major RS UnE) 1);
-by (REPEAT (rtac refl 1
- ORELSE eresolve_tac (prems@[SigmaE,singletonE,ssubst]) 1));
-val sumE = result();
-
-(** Injection and freeness equivalences, for rewriting **)
-
-goalw Sum.thy sum_defs "Inl(a)=Inl(b) <-> a=b";
-by (simp_tac (ZF_ss addsimps [Pair_iff]) 1);
-val Inl_iff = result();
-
-goalw Sum.thy sum_defs "Inr(a)=Inr(b) <-> a=b";
-by (simp_tac (ZF_ss addsimps [Pair_iff]) 1);
-val Inr_iff = result();
-
-goalw Sum.thy sum_defs "Inl(a)=Inr(b) <-> False";
-by (simp_tac (ZF_ss addsimps [Pair_iff, one_not_0 RS not_sym]) 1);
-val Inl_Inr_iff = result();
-
-goalw Sum.thy sum_defs "Inr(b)=Inl(a) <-> False";
-by (simp_tac (ZF_ss addsimps [Pair_iff, one_not_0]) 1);
-val Inr_Inl_iff = result();
-
-(*Injection and freeness rules*)
-
-val Inl_inject = standard (Inl_iff RS iffD1);
-val Inr_inject = standard (Inr_iff RS iffD1);
-val Inl_neq_Inr = standard (Inl_Inr_iff RS iffD1 RS FalseE);
-val Inr_neq_Inl = standard (Inr_Inl_iff RS iffD1 RS FalseE);
-
-val sum_cs = ZF_cs addSIs [InlI,InrI] addSEs [sumE,Inl_neq_Inr,Inr_neq_Inl]
- addSDs [Inl_inject,Inr_inject];
-
-goal Sum.thy "!!A B. Inl(a): A+B ==> a: A";
-by (fast_tac sum_cs 1);
-val InlD = result();
-
-goal Sum.thy "!!A B. Inr(b): A+B ==> b: B";
-by (fast_tac sum_cs 1);
-val InrD = result();
-
-goal Sum.thy "u: A+B <-> (EX x. x:A & u=Inl(x)) | (EX y. y:B & u=Inr(y))";
-by (fast_tac sum_cs 1);
-val sum_iff = result();
-
-goal Sum.thy "A+B <= C+D <-> A<=C & B<=D";
-by (fast_tac sum_cs 1);
-val sum_subset_iff = result();
-
-goal Sum.thy "A+B = C+D <-> A=C & B=D";
-by (simp_tac (ZF_ss addsimps [extension,sum_subset_iff]) 1);
-by (fast_tac ZF_cs 1);
-val sum_equal_iff = result();
-
-(*** Eliminator -- case ***)
-
-goalw Sum.thy sum_defs "case(c, d, Inl(a)) = c(a)";
-by (rtac (split RS trans) 1);
-by (rtac cond_0 1);
-val case_Inl = result();
-
-goalw Sum.thy sum_defs "case(c, d, Inr(b)) = d(b)";
-by (rtac (split RS trans) 1);
-by (rtac cond_1 1);
-val case_Inr = result();
-
-val major::prems = goal Sum.thy
- "[| u: A+B; \
-\ !!x. x: A ==> c(x): C(Inl(x)); \
-\ !!y. y: B ==> d(y): C(Inr(y)) \
-\ |] ==> case(c,d,u) : C(u)";
-by (rtac (major RS sumE) 1);
-by (ALLGOALS (etac ssubst));
-by (ALLGOALS (asm_simp_tac (ZF_ss addsimps
- (prems@[case_Inl,case_Inr]))));
-val case_type = result();
-
-(** Rules for the Part primitive **)
-
-goalw Sum.thy [Part_def]
- "!!a b A h. [| a : A; a=h(b) |] ==> a : Part(A,h)";
-by (REPEAT (ares_tac [exI,CollectI] 1));
-val Part_eqI = result();
-
-val PartI = refl RSN (2,Part_eqI);
-
-val major::prems = goalw Sum.thy [Part_def]
- "[| a : Part(A,h); !!z. [| a : A; a=h(z) |] ==> P \
-\ |] ==> P";
-by (rtac (major RS CollectE) 1);
-by (etac exE 1);
-by (REPEAT (ares_tac prems 1));
-val PartE = result();
-
-goalw Sum.thy [Part_def] "Part(A,h) <= A";
-by (rtac Collect_subset 1);
-val Part_subset = result();
-
-goal Sum.thy "!!A B h. A<=B ==> Part(A,h)<=Part(B,h)";
-by (fast_tac (ZF_cs addIs [PartI] addSEs [PartE]) 1);
-val Part_mono = result();
-
-goal Sum.thy "Part(A+B,Inl) = {Inl(x). x: A}";
-by (fast_tac (sum_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_Inl = result();
-
-goal Sum.thy "Part(A+B,Inr) = {Inr(y). y: B}";
-by (fast_tac (sum_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_Inr = result();
-
-goalw Sum.thy [Part_def] "!!a. a : Part(A,h) ==> a : A";
-by (etac CollectD1 1);
-val PartD1 = result();
-
-goal Sum.thy "Part(A,%x.x) = A";
-by (fast_tac (ZF_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_id = result();
-
-goal Sum.thy "Part(A+B, %x.Inr(h(x))) = {Inr(y). y: Part(B,h)}";
-by (fast_tac (sum_cs addIs [PartI,equalityI] addSEs [PartE]) 1);
-val Part_Inr2 = result();
-
-goal Sum.thy "!!A B C. C <= A+B ==> Part(C,Inl) Un Part(C,Inr) = C";
-by (rtac equalityI 1);
-by (rtac Un_least 1);
-by (rtac Part_subset 1);
-by (rtac Part_subset 1);
-by (fast_tac (ZF_cs addIs [PartI] addSEs [sumE]) 1);
-val Part_sum_equality = result();
--- a/src/ZF/sum.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,25 +0,0 @@
-(* Title: ZF/sum.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Disjoint sums in Zermelo-Fraenkel Set Theory
-"Part" primitive for simultaneous recursive type definitions
-*)
-
-Sum = Bool + "simpdata" +
-consts
- "+" :: "[i,i]=>i" (infixr 65)
- Inl,Inr :: "i=>i"
- case :: "[i=>i, i=>i, i]=>i"
- Part :: "[i,i=>i] => i"
-
-rules
- sum_def "A+B == {0}*A Un {1}*B"
- Inl_def "Inl(a) == <0,a>"
- Inr_def "Inr(b) == <1,b>"
- case_def "case(c,d) == split(%y z. cond(y, d(z), c(z)))"
-
- (*operator for selecting out the various summands*)
- Part_def "Part(A,h) == {x: A. EX z. x = h(z)}"
-end
--- a/src/ZF/trancl.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,193 +0,0 @@
-(* Title: ZF/trancl.ML
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-For trancl.thy. Transitive closure of a relation
-*)
-
-open Trancl;
-
-val major::prems = goalw Trancl.thy [trans_def]
- "[| trans(r); <a,b>:r; <b,c>:r |] ==> <a,c>:r";
-by (rtac (major RS spec RS spec RS spec RS mp RS mp) 1);
-by (REPEAT (resolve_tac prems 1));
-val transD = result();
-
-goal Trancl.thy "bnd_mono(field(r)*field(r), %s. id(field(r)) Un (r O s))";
-by (rtac bnd_monoI 1);
-by (REPEAT (ares_tac [subset_refl, Un_mono, comp_mono] 2));
-by (fast_tac comp_cs 1);
-val rtrancl_bnd_mono = result();
-
-val [prem] = goalw Trancl.thy [rtrancl_def] "r<=s ==> r^* <= s^*";
-by (rtac lfp_mono 1);
-by (REPEAT (resolve_tac [rtrancl_bnd_mono, prem, subset_refl, id_mono,
- comp_mono, Un_mono, field_mono, Sigma_mono] 1));
-val rtrancl_mono = result();
-
-(* r^* = id(field(r)) Un ( r O r^* ) *)
-val rtrancl_unfold = rtrancl_bnd_mono RS (rtrancl_def RS def_lfp_Tarski);
-
-(** The relation rtrancl **)
-
-val rtrancl_type = standard (rtrancl_def RS def_lfp_subset);
-
-(*Reflexivity of rtrancl*)
-val [prem] = goal Trancl.thy "[| a: field(r) |] ==> <a,a> : r^*";
-by (resolve_tac [rtrancl_unfold RS ssubst] 1);
-by (rtac (prem RS idI RS UnI1) 1);
-val rtrancl_refl = result();
-
-(*Closure under composition with r *)
-val prems = goal Trancl.thy
- "[| <a,b> : r^*; <b,c> : r |] ==> <a,c> : r^*";
-by (resolve_tac [rtrancl_unfold RS ssubst] 1);
-by (rtac (compI RS UnI2) 1);
-by (resolve_tac prems 1);
-by (resolve_tac prems 1);
-val rtrancl_into_rtrancl = result();
-
-(*rtrancl of r contains all pairs in r *)
-val prems = goal Trancl.thy "<a,b> : r ==> <a,b> : r^*";
-by (resolve_tac [rtrancl_refl RS rtrancl_into_rtrancl] 1);
-by (REPEAT (resolve_tac (prems@[fieldI1]) 1));
-val r_into_rtrancl = result();
-
-(*The premise ensures that r consists entirely of pairs*)
-val prems = goal Trancl.thy "r <= Sigma(A,B) ==> r <= r^*";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addIs [r_into_rtrancl]) 1);
-val r_subset_rtrancl = result();
-
-goal Trancl.thy "field(r^*) = field(r)";
-by (fast_tac (eq_cs addIs [r_into_rtrancl]
- addSDs [rtrancl_type RS subsetD]) 1);
-val rtrancl_field = result();
-
-
-(** standard induction rule **)
-
-val major::prems = goal Trancl.thy
- "[| <a,b> : r^*; \
-\ !!x. x: field(r) ==> P(<x,x>); \
-\ !!x y z.[| P(<x,y>); <x,y>: r^*; <y,z>: r |] ==> P(<x,z>) |] \
-\ ==> P(<a,b>)";
-by (rtac ([rtrancl_def, rtrancl_bnd_mono, major] MRS def_induct) 1);
-by (fast_tac (ZF_cs addIs prems addSEs [idE,compE]) 1);
-val rtrancl_full_induct = result();
-
-(*nice induction rule.
- Tried adding the typing hypotheses y,z:field(r), but these
- caused expensive case splits!*)
-val major::prems = goal Trancl.thy
- "[| <a,b> : r^*; \
-\ P(a); \
-\ !!y z.[| <a,y> : r^*; <y,z> : r; P(y) |] ==> P(z) \
-\ |] ==> P(b)";
-(*by induction on this formula*)
-by (subgoal_tac "ALL y. <a,b> = <a,y> --> P(y)" 1);
-(*now solve first subgoal: this formula is sufficient*)
-by (EVERY1 [etac (spec RS mp), rtac refl]);
-(*now do the induction*)
-by (resolve_tac [major RS rtrancl_full_induct] 1);
-by (ALLGOALS (fast_tac (ZF_cs addIs prems)));
-val rtrancl_induct = result();
-
-(*transitivity of transitive closure!! -- by induction.*)
-goalw Trancl.thy [trans_def] "trans(r^*)";
-by (REPEAT (resolve_tac [allI,impI] 1));
-by (eres_inst_tac [("b","z")] rtrancl_induct 1);
-by (DEPTH_SOLVE (eresolve_tac [asm_rl, rtrancl_into_rtrancl] 1));
-val trans_rtrancl = result();
-
-(*elimination of rtrancl -- by induction on a special formula*)
-val major::prems = goal Trancl.thy
- "[| <a,b> : r^*; (a=b) ==> P; \
-\ !!y.[| <a,y> : r^*; <y,b> : r |] ==> P |] \
-\ ==> P";
-by (subgoal_tac "a = b | (EX y. <a,y> : r^* & <y,b> : r)" 1);
-(*see HOL/trancl*)
-by (rtac (major RS rtrancl_induct) 2);
-by (ALLGOALS (fast_tac (ZF_cs addSEs prems)));
-val rtranclE = result();
-
-
-(**** The relation trancl ****)
-
-(*Transitivity of r^+ is proved by transitivity of r^* *)
-goalw Trancl.thy [trans_def,trancl_def] "trans(r^+)";
-by (safe_tac comp_cs);
-by (rtac (rtrancl_into_rtrancl RS (trans_rtrancl RS transD RS compI)) 1);
-by (REPEAT (assume_tac 1));
-val trans_trancl = result();
-
-(** Conversions between trancl and rtrancl **)
-
-val [major] = goalw Trancl.thy [trancl_def] "<a,b> : r^+ ==> <a,b> : r^*";
-by (resolve_tac [major RS compEpair] 1);
-by (REPEAT (ares_tac [rtrancl_into_rtrancl] 1));
-val trancl_into_rtrancl = result();
-
-(*r^+ contains all pairs in r *)
-val [prem] = goalw Trancl.thy [trancl_def] "<a,b> : r ==> <a,b> : r^+";
-by (REPEAT (ares_tac [prem,compI,rtrancl_refl,fieldI1] 1));
-val r_into_trancl = result();
-
-(*The premise ensures that r consists entirely of pairs*)
-val prems = goal Trancl.thy "r <= Sigma(A,B) ==> r <= r^+";
-by (cut_facts_tac prems 1);
-by (fast_tac (ZF_cs addIs [r_into_trancl]) 1);
-val r_subset_trancl = result();
-
-(*intro rule by definition: from r^* and r *)
-val prems = goalw Trancl.thy [trancl_def]
- "[| <a,b> : r^*; <b,c> : r |] ==> <a,c> : r^+";
-by (REPEAT (resolve_tac ([compI]@prems) 1));
-val rtrancl_into_trancl1 = result();
-
-(*intro rule from r and r^* *)
-val prems = goal Trancl.thy
- "[| <a,b> : r; <b,c> : r^* |] ==> <a,c> : r^+";
-by (resolve_tac (prems RL [rtrancl_induct]) 1);
-by (resolve_tac (prems RL [r_into_trancl]) 1);
-by (etac (trans_trancl RS transD) 1);
-by (etac r_into_trancl 1);
-val rtrancl_into_trancl2 = result();
-
-(*Nice induction rule for trancl*)
-val major::prems = goal Trancl.thy
- "[| <a,b> : r^+; \
-\ !!y. [| <a,y> : r |] ==> P(y); \
-\ !!y z.[| <a,y> : r^+; <y,z> : r; P(y) |] ==> P(z) \
-\ |] ==> P(b)";
-by (rtac (rewrite_rule [trancl_def] major RS compEpair) 1);
-(*by induction on this formula*)
-by (subgoal_tac "ALL z. <y,z> : r --> P(z)" 1);
-(*now solve first subgoal: this formula is sufficient*)
-by (fast_tac ZF_cs 1);
-by (etac rtrancl_induct 1);
-by (ALLGOALS (fast_tac (ZF_cs addIs (rtrancl_into_trancl1::prems))));
-val trancl_induct = result();
-
-(*elimination of r^+ -- NOT an induction rule*)
-val major::prems = goal Trancl.thy
- "[| <a,b> : r^+; \
-\ <a,b> : r ==> P; \
-\ !!y.[| <a,y> : r^+; <y,b> : r |] ==> P \
-\ |] ==> P";
-by (subgoal_tac "<a,b> : r | (EX y. <a,y> : r^+ & <y,b> : r)" 1);
-by (fast_tac (ZF_cs addIs prems) 1);
-by (rtac (rewrite_rule [trancl_def] major RS compEpair) 1);
-by (etac rtranclE 1);
-by (ALLGOALS (fast_tac (ZF_cs addIs [rtrancl_into_trancl1])));
-val tranclE = result();
-
-goalw Trancl.thy [trancl_def] "r^+ <= field(r)*field(r)";
-by (fast_tac (ZF_cs addEs [compE, rtrancl_type RS subsetD RS SigmaE2]) 1);
-val trancl_type = result();
-
-val [prem] = goalw Trancl.thy [trancl_def] "r<=s ==> r^+ <= s^+";
-by (REPEAT (resolve_tac [prem, comp_mono, rtrancl_mono] 1));
-val trancl_mono = result();
-
--- a/src/ZF/trancl.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,21 +0,0 @@
-(* Title: ZF/trancl.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Transitive closure of a relation
-*)
-
-Trancl = Fixedpt + Perm + "mono" +
-consts
- "rtrancl" :: "i=>i" ("(_^*)" [100] 100) (*refl/transitive closure*)
- "trancl" :: "i=>i" ("(_^+)" [100] 100) (*transitive closure*)
- "trans" :: "i=>o" (*transitivity predicate*)
-
-rules
- trans_def "trans(r) == ALL x y z. <x,y>: r --> <y,z>: r --> <x,z>: r"
-
- rtrancl_def "r^* == lfp(field(r)*field(r), %s. id(field(r)) Un (r O s))"
-
- trancl_def "r^+ == r O r^*"
-end
--- a/src/ZF/univ.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,628 +0,0 @@
-(* Title: ZF/univ
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-The cumulative hierarchy and a small universe for recursive types
-*)
-
-open Univ;
-
-(*NOT SUITABLE FOR REWRITING -- RECURSIVE!*)
-goal Univ.thy "Vfrom(A,i) = A Un (UN j:i. Pow(Vfrom(A,j)))";
-by (rtac (Vfrom_def RS def_transrec RS ssubst) 1);
-by (simp_tac ZF_ss 1);
-val Vfrom = result();
-
-(** Monotonicity **)
-
-goal Univ.thy "!!A B. A<=B ==> ALL j. i<=j --> Vfrom(A,i) <= Vfrom(B,j)";
-by (eps_ind_tac "i" 1);
-by (rtac (impI RS allI) 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (etac Un_mono 1);
-by (rtac UN_mono 1);
-by (assume_tac 1);
-by (rtac Pow_mono 1);
-by (etac (bspec RS spec RS mp) 1);
-by (assume_tac 1);
-by (rtac subset_refl 1);
-val Vfrom_mono_lemma = result();
-
-(* [| A<=B; i<=x |] ==> Vfrom(A,i) <= Vfrom(B,x) *)
-val Vfrom_mono = standard (Vfrom_mono_lemma RS spec RS mp);
-
-
-(** A fundamental equality: Vfrom does not require ordinals! **)
-
-goal Univ.thy "Vfrom(A,x) <= Vfrom(A,rank(x))";
-by (eps_ind_tac "x" 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac (ZF_cs addSIs [rank_lt RS ltD]) 1);
-val Vfrom_rank_subset1 = result();
-
-goal Univ.thy "Vfrom(A,rank(x)) <= Vfrom(A,x)";
-by (eps_ind_tac "x" 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac (subset_refl RS Un_mono) 1);
-by (rtac UN_least 1);
-(*expand rank(x1) = (UN y:x1. succ(rank(y))) in assumptions*)
-by (etac (rank RS equalityD1 RS subsetD RS UN_E) 1);
-by (rtac subset_trans 1);
-by (etac UN_upper 2);
-by (rtac (subset_refl RS Vfrom_mono RS subset_trans RS Pow_mono) 1);
-by (etac (ltI RS le_imp_subset) 1);
-by (rtac (Ord_rank RS Ord_succ) 1);
-by (etac bspec 1);
-by (assume_tac 1);
-val Vfrom_rank_subset2 = result();
-
-goal Univ.thy "Vfrom(A,rank(x)) = Vfrom(A,x)";
-by (rtac equalityI 1);
-by (rtac Vfrom_rank_subset2 1);
-by (rtac Vfrom_rank_subset1 1);
-val Vfrom_rank_eq = result();
-
-
-(*** Basic closure properties ***)
-
-goal Univ.thy "!!x y. y:x ==> 0 : Vfrom(A,x)";
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac ZF_cs 1);
-val zero_in_Vfrom = result();
-
-goal Univ.thy "i <= Vfrom(A,i)";
-by (eps_ind_tac "i" 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac ZF_cs 1);
-val i_subset_Vfrom = result();
-
-goal Univ.thy "A <= Vfrom(A,i)";
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac Un_upper1 1);
-val A_subset_Vfrom = result();
-
-goal Univ.thy "!!A a i. a <= Vfrom(A,i) ==> a: Vfrom(A,succ(i))";
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac ZF_cs 1);
-val subset_mem_Vfrom = result();
-
-(** Finite sets and ordered pairs **)
-
-goal Univ.thy "!!a. a: Vfrom(A,i) ==> {a} : Vfrom(A,succ(i))";
-by (rtac subset_mem_Vfrom 1);
-by (safe_tac ZF_cs);
-val singleton_in_Vfrom = result();
-
-goal Univ.thy
- "!!A. [| a: Vfrom(A,i); b: Vfrom(A,i) |] ==> {a,b} : Vfrom(A,succ(i))";
-by (rtac subset_mem_Vfrom 1);
-by (safe_tac ZF_cs);
-val doubleton_in_Vfrom = result();
-
-goalw Univ.thy [Pair_def]
- "!!A. [| a: Vfrom(A,i); b: Vfrom(A,i) |] ==> \
-\ <a,b> : Vfrom(A,succ(succ(i)))";
-by (REPEAT (ares_tac [doubleton_in_Vfrom] 1));
-val Pair_in_Vfrom = result();
-
-val [prem] = goal Univ.thy
- "a<=Vfrom(A,i) ==> succ(a) : Vfrom(A,succ(succ(i)))";
-by (REPEAT (resolve_tac [subset_mem_Vfrom, succ_subsetI] 1));
-by (rtac (Vfrom_mono RSN (2,subset_trans)) 2);
-by (REPEAT (resolve_tac [prem, subset_refl, subset_succI] 1));
-val succ_in_Vfrom = result();
-
-(*** 0, successor and limit equations fof Vfrom ***)
-
-goal Univ.thy "Vfrom(A,0) = A";
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac eq_cs 1);
-val Vfrom_0 = result();
-
-goal Univ.thy "!!i. Ord(i) ==> Vfrom(A,succ(i)) = A Un Pow(Vfrom(A,i))";
-by (rtac (Vfrom RS trans) 1);
-by (rtac (succI1 RS RepFunI RS Union_upper RSN
- (2, equalityI RS subst_context)) 1);
-by (rtac UN_least 1);
-by (rtac (subset_refl RS Vfrom_mono RS Pow_mono) 1);
-by (etac (ltI RS le_imp_subset) 1);
-by (etac Ord_succ 1);
-val Vfrom_succ_lemma = result();
-
-goal Univ.thy "Vfrom(A,succ(i)) = A Un Pow(Vfrom(A,i))";
-by (res_inst_tac [("x1", "succ(i)")] (Vfrom_rank_eq RS subst) 1);
-by (res_inst_tac [("x1", "i")] (Vfrom_rank_eq RS subst) 1);
-by (rtac (rank_succ RS ssubst) 1);
-by (rtac (Ord_rank RS Vfrom_succ_lemma) 1);
-val Vfrom_succ = result();
-
-(*The premise distinguishes this from Vfrom(A,0); allowing X=0 forces
- the conclusion to be Vfrom(A,Union(X)) = A Un (UN y:X. Vfrom(A,y)) *)
-val [prem] = goal Univ.thy "y:X ==> Vfrom(A,Union(X)) = (UN y:X. Vfrom(A,y))";
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac equalityI 1);
-(*first inclusion*)
-by (rtac Un_least 1);
-by (rtac (A_subset_Vfrom RS subset_trans) 1);
-by (rtac (prem RS UN_upper) 1);
-by (rtac UN_least 1);
-by (etac UnionE 1);
-by (rtac subset_trans 1);
-by (etac UN_upper 2);
-by (rtac (Vfrom RS ssubst) 1);
-by (etac ([UN_upper, Un_upper2] MRS subset_trans) 1);
-(*opposite inclusion*)
-by (rtac UN_least 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac ZF_cs 1);
-val Vfrom_Union = result();
-
-(*** Limit ordinals -- general properties ***)
-
-goalw Univ.thy [Limit_def] "!!i. Limit(i) ==> Union(i) = i";
-by (fast_tac (eq_cs addSIs [ltI] addSEs [ltE] addEs [Ord_trans]) 1);
-val Limit_Union_eq = result();
-
-goalw Univ.thy [Limit_def] "!!i. Limit(i) ==> Ord(i)";
-by (etac conjunct1 1);
-val Limit_is_Ord = result();
-
-goalw Univ.thy [Limit_def] "!!i. Limit(i) ==> 0 < i";
-by (etac (conjunct2 RS conjunct1) 1);
-val Limit_has_0 = result();
-
-goalw Univ.thy [Limit_def] "!!i. [| Limit(i); j<i |] ==> succ(j) < i";
-by (fast_tac ZF_cs 1);
-val Limit_has_succ = result();
-
-goalw Univ.thy [Limit_def] "Limit(nat)";
-by (safe_tac (ZF_cs addSIs (ltI::nat_typechecks)));
-by (etac ltD 1);
-val Limit_nat = result();
-
-goalw Univ.thy [Limit_def]
- "!!i. [| 0<i; ALL y. succ(y) ~= i |] ==> Limit(i)";
-by (safe_tac subset_cs);
-by (rtac (not_le_iff_lt RS iffD1) 2);
-by (fast_tac (lt_cs addEs [lt_anti_sym]) 4);
-by (REPEAT (eresolve_tac [asm_rl, ltE, Ord_succ] 1));
-val non_succ_LimitI = result();
-
-goal Univ.thy "!!i. Ord(i) ==> i=0 | (EX j. i=succ(j)) | Limit(i)";
-by (fast_tac (ZF_cs addSIs [non_succ_LimitI, Ord_0_lt]) 1);
-val Ord_cases_lemma = result();
-
-val major::prems = goal Univ.thy
- "[| Ord(i); \
-\ i=0 ==> P; \
-\ !!j. i=succ(j) ==> P; \
-\ Limit(i) ==> P \
-\ |] ==> P";
-by (cut_facts_tac [major RS Ord_cases_lemma] 1);
-by (REPEAT (eresolve_tac (prems@[disjE, exE]) 1));
-val Ord_cases = result();
-
-
-(*** Vfrom applied to Limit ordinals ***)
-
-(*NB. limit ordinals are non-empty;
- Vfrom(A,0) = A = A Un (UN y:0. Vfrom(A,y)) *)
-val [limiti] = goal Univ.thy
- "Limit(i) ==> Vfrom(A,i) = (UN y:i. Vfrom(A,y))";
-by (rtac (limiti RS (Limit_has_0 RS ltD) RS Vfrom_Union RS subst) 1);
-by (rtac (limiti RS Limit_Union_eq RS ssubst) 1);
-by (rtac refl 1);
-val Limit_Vfrom_eq = result();
-
-goal Univ.thy "!!a. [| a: Vfrom(A,j); Limit(i); j<i |] ==> a : Vfrom(A,i)";
-by (rtac (Limit_Vfrom_eq RS equalityD2 RS subsetD) 1);
-by (REPEAT (ares_tac [ltD RS UN_I] 1));
-val Limit_VfromI = result();
-
-val prems = goal Univ.thy
- "[| a: Vfrom(A,i); Limit(i); \
-\ !!x. [| x<i; a: Vfrom(A,x) |] ==> R \
-\ |] ==> R";
-by (rtac (Limit_Vfrom_eq RS equalityD1 RS subsetD RS UN_E) 1);
-by (REPEAT (ares_tac (prems @ [ltI, Limit_is_Ord]) 1));
-val Limit_VfromE = result();
-
-val [major,limiti] = goal Univ.thy
- "[| a: Vfrom(A,i); Limit(i) |] ==> {a} : Vfrom(A,i)";
-by (rtac ([major,limiti] MRS Limit_VfromE) 1);
-by (etac ([singleton_in_Vfrom, limiti] MRS Limit_VfromI) 1);
-by (etac (limiti RS Limit_has_succ) 1);
-val singleton_in_Vfrom_limit = result();
-
-val Vfrom_UnI1 = Un_upper1 RS (subset_refl RS Vfrom_mono RS subsetD)
-and Vfrom_UnI2 = Un_upper2 RS (subset_refl RS Vfrom_mono RS subsetD);
-
-(*Hard work is finding a single j:i such that {a,b}<=Vfrom(A,j)*)
-val [aprem,bprem,limiti] = goal Univ.thy
- "[| a: Vfrom(A,i); b: Vfrom(A,i); Limit(i) |] ==> \
-\ {a,b} : Vfrom(A,i)";
-by (rtac ([aprem,limiti] MRS Limit_VfromE) 1);
-by (rtac ([bprem,limiti] MRS Limit_VfromE) 1);
-by (rtac ([doubleton_in_Vfrom, limiti] MRS Limit_VfromI) 1);
-by (etac Vfrom_UnI1 1);
-by (etac Vfrom_UnI2 1);
-by (REPEAT (ares_tac [limiti, Limit_has_succ, Un_least_lt] 1));
-val doubleton_in_Vfrom_limit = result();
-
-val [aprem,bprem,limiti] = goal Univ.thy
- "[| a: Vfrom(A,i); b: Vfrom(A,i); Limit(i) |] ==> \
-\ <a,b> : Vfrom(A,i)";
-(*Infer that a, b occur at ordinals x,xa < i.*)
-by (rtac ([aprem,limiti] MRS Limit_VfromE) 1);
-by (rtac ([bprem,limiti] MRS Limit_VfromE) 1);
-by (rtac ([Pair_in_Vfrom, limiti] MRS Limit_VfromI) 1);
-(*Infer that succ(succ(x Un xa)) < i *)
-by (etac Vfrom_UnI1 1);
-by (etac Vfrom_UnI2 1);
-by (REPEAT (ares_tac [limiti, Limit_has_succ, Un_least_lt] 1));
-val Pair_in_Vfrom_limit = result();
-
-
-(*** Properties assuming Transset(A) ***)
-
-goal Univ.thy "!!i A. Transset(A) ==> Transset(Vfrom(A,i))";
-by (eps_ind_tac "i" 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac (ZF_cs addSIs [Transset_Union_family, Transset_Un,
- Transset_Pow]) 1);
-val Transset_Vfrom = result();
-
-goal Univ.thy "!!A i. Transset(A) ==> Vfrom(A, succ(i)) = Pow(Vfrom(A,i))";
-by (rtac (Vfrom_succ RS trans) 1);
-by (rtac (Un_upper2 RSN (2,equalityI)) 1);
-by (rtac (subset_refl RSN (2,Un_least)) 1);
-by (rtac (A_subset_Vfrom RS subset_trans) 1);
-by (etac (Transset_Vfrom RS (Transset_iff_Pow RS iffD1)) 1);
-val Transset_Vfrom_succ = result();
-
-goalw Ord.thy [Pair_def,Transset_def]
- "!!C. [| <a,b> <= C; Transset(C) |] ==> a: C & b: C";
-by (fast_tac ZF_cs 1);
-val Transset_Pair_subset = result();
-
-goal Univ.thy
- "!!a b.[| <a,b> <= Vfrom(A,i); Transset(A); Limit(i) |] ==> \
-\ <a,b> : Vfrom(A,i)";
-by (etac (Transset_Pair_subset RS conjE) 1);
-by (etac Transset_Vfrom 1);
-by (REPEAT (ares_tac [Pair_in_Vfrom_limit] 1));
-val Transset_Pair_subset_Vfrom_limit = result();
-
-
-(*** Closure under product/sum applied to elements -- thus Vfrom(A,i)
- is a model of simple type theory provided A is a transitive set
- and i is a limit ordinal
-***)
-
-(*General theorem for membership in Vfrom(A,i) when i is a limit ordinal*)
-val [aprem,bprem,limiti,step] = goal Univ.thy
- "[| a: Vfrom(A,i); b: Vfrom(A,i); Limit(i); \
-\ !!x y j. [| j<i; 1:j; x: Vfrom(A,j); y: Vfrom(A,j) \
-\ |] ==> EX k. h(x,y): Vfrom(A,k) & k<i |] ==> \
-\ h(a,b) : Vfrom(A,i)";
-(*Infer that a, b occur at ordinals x,xa < i.*)
-by (rtac ([aprem,limiti] MRS Limit_VfromE) 1);
-by (rtac ([bprem,limiti] MRS Limit_VfromE) 1);
-by (res_inst_tac [("j1", "x Un xa Un succ(1)")] (step RS exE) 1);
-by (DO_GOAL [etac conjE, etac Limit_VfromI, rtac limiti, atac] 5);
-by (etac (Vfrom_UnI2 RS Vfrom_UnI1) 4);
-by (etac (Vfrom_UnI1 RS Vfrom_UnI1) 3);
-by (rtac (succI1 RS UnI2) 2);
-by (REPEAT (ares_tac [limiti, Limit_has_0, Limit_has_succ, Un_least_lt] 1));
-val in_Vfrom_limit = result();
-
-(** products **)
-
-goal Univ.thy
- "!!A. [| a: Vfrom(A,j); b: Vfrom(A,j); Transset(A) |] ==> \
-\ a*b : Vfrom(A, succ(succ(succ(j))))";
-by (dtac Transset_Vfrom 1);
-by (rtac subset_mem_Vfrom 1);
-by (rewtac Transset_def);
-by (fast_tac (ZF_cs addIs [Pair_in_Vfrom]) 1);
-val prod_in_Vfrom = result();
-
-val [aprem,bprem,limiti,transset] = goal Univ.thy
- "[| a: Vfrom(A,i); b: Vfrom(A,i); Limit(i); Transset(A) |] ==> \
-\ a*b : Vfrom(A,i)";
-by (rtac ([aprem,bprem,limiti] MRS in_Vfrom_limit) 1);
-by (REPEAT (ares_tac [exI, conjI, prod_in_Vfrom, transset,
- limiti RS Limit_has_succ] 1));
-val prod_in_Vfrom_limit = result();
-
-(** Disjoint sums, aka Quine ordered pairs **)
-
-goalw Univ.thy [sum_def]
- "!!A. [| a: Vfrom(A,j); b: Vfrom(A,j); Transset(A); 1:j |] ==> \
-\ a+b : Vfrom(A, succ(succ(succ(j))))";
-by (dtac Transset_Vfrom 1);
-by (rtac subset_mem_Vfrom 1);
-by (rewtac Transset_def);
-by (fast_tac (ZF_cs addIs [zero_in_Vfrom, Pair_in_Vfrom,
- i_subset_Vfrom RS subsetD]) 1);
-val sum_in_Vfrom = result();
-
-val [aprem,bprem,limiti,transset] = goal Univ.thy
- "[| a: Vfrom(A,i); b: Vfrom(A,i); Limit(i); Transset(A) |] ==> \
-\ a+b : Vfrom(A,i)";
-by (rtac ([aprem,bprem,limiti] MRS in_Vfrom_limit) 1);
-by (REPEAT (ares_tac [exI, conjI, sum_in_Vfrom, transset,
- limiti RS Limit_has_succ] 1));
-val sum_in_Vfrom_limit = result();
-
-(** function space! **)
-
-goalw Univ.thy [Pi_def]
- "!!A. [| a: Vfrom(A,j); b: Vfrom(A,j); Transset(A) |] ==> \
-\ a->b : Vfrom(A, succ(succ(succ(succ(j)))))";
-by (dtac Transset_Vfrom 1);
-by (rtac subset_mem_Vfrom 1);
-by (rtac (Collect_subset RS subset_trans) 1);
-by (rtac (Vfrom RS ssubst) 1);
-by (rtac (subset_trans RS subset_trans) 1);
-by (rtac Un_upper2 3);
-by (rtac (succI1 RS UN_upper) 2);
-by (rtac Pow_mono 1);
-by (rewtac Transset_def);
-by (fast_tac (ZF_cs addIs [Pair_in_Vfrom]) 1);
-val fun_in_Vfrom = result();
-
-val [aprem,bprem,limiti,transset] = goal Univ.thy
- "[| a: Vfrom(A,i); b: Vfrom(A,i); Limit(i); Transset(A) |] ==> \
-\ a->b : Vfrom(A,i)";
-by (rtac ([aprem,bprem,limiti] MRS in_Vfrom_limit) 1);
-by (REPEAT (ares_tac [exI, conjI, fun_in_Vfrom, transset,
- limiti RS Limit_has_succ] 1));
-val fun_in_Vfrom_limit = result();
-
-
-(*** The set Vset(i) ***)
-
-goal Univ.thy "Vset(i) = (UN j:i. Pow(Vset(j)))";
-by (rtac (Vfrom RS ssubst) 1);
-by (fast_tac eq_cs 1);
-val Vset = result();
-
-val Vset_succ = Transset_0 RS Transset_Vfrom_succ;
-
-val Transset_Vset = Transset_0 RS Transset_Vfrom;
-
-(** Characterisation of the elements of Vset(i) **)
-
-val [ordi] = goal Univ.thy "Ord(i) ==> ALL b. b : Vset(i) --> rank(b) < i";
-by (rtac (ordi RS trans_induct) 1);
-by (rtac (Vset RS ssubst) 1);
-by (safe_tac ZF_cs);
-by (rtac (rank RS ssubst) 1);
-by (rtac UN_succ_least_lt 1);
-by (fast_tac ZF_cs 2);
-by (REPEAT (ares_tac [ltI] 1));
-val Vset_rank_imp1 = result();
-
-(* [| Ord(i); x : Vset(i) |] ==> rank(x) < i *)
-val VsetD = standard (Vset_rank_imp1 RS spec RS mp);
-
-val [ordi] = goal Univ.thy "Ord(i) ==> ALL b. rank(b) : i --> b : Vset(i)";
-by (rtac (ordi RS trans_induct) 1);
-by (rtac allI 1);
-by (rtac (Vset RS ssubst) 1);
-by (fast_tac (ZF_cs addSIs [rank_lt RS ltD]) 1);
-val Vset_rank_imp2 = result();
-
-goal Univ.thy "!!x i. rank(x)<i ==> x : Vset(i)";
-by (etac ltE 1);
-by (etac (Vset_rank_imp2 RS spec RS mp) 1);
-by (assume_tac 1);
-val VsetI = result();
-
-goal Univ.thy "!!i. Ord(i) ==> b : Vset(i) <-> rank(b) < i";
-by (rtac iffI 1);
-by (REPEAT (eresolve_tac [asm_rl, VsetD, VsetI] 1));
-val Vset_Ord_rank_iff = result();
-
-goal Univ.thy "b : Vset(a) <-> rank(b) < rank(a)";
-by (rtac (Vfrom_rank_eq RS subst) 1);
-by (rtac (Ord_rank RS Vset_Ord_rank_iff) 1);
-val Vset_rank_iff = result();
-
-goal Univ.thy "!!i. Ord(i) ==> rank(Vset(i)) = i";
-by (rtac (rank RS ssubst) 1);
-by (rtac equalityI 1);
-by (safe_tac ZF_cs);
-by (EVERY' [rtac UN_I,
- etac (i_subset_Vfrom RS subsetD),
- etac (Ord_in_Ord RS rank_of_Ord RS ssubst),
- assume_tac,
- rtac succI1] 3);
-by (REPEAT (eresolve_tac [asm_rl, VsetD RS ltD, Ord_trans] 1));
-val rank_Vset = result();
-
-(** Lemmas for reasoning about sets in terms of their elements' ranks **)
-
-goal Univ.thy "a <= Vset(rank(a))";
-by (rtac subsetI 1);
-by (etac (rank_lt RS VsetI) 1);
-val arg_subset_Vset_rank = result();
-
-val [iprem] = goal Univ.thy
- "[| !!i. Ord(i) ==> a Int Vset(i) <= b |] ==> a <= b";
-by (rtac ([subset_refl, arg_subset_Vset_rank] MRS
- Int_greatest RS subset_trans) 1);
-by (rtac (Ord_rank RS iprem) 1);
-val Int_Vset_subset = result();
-
-(** Set up an environment for simplification **)
-
-val rank_rls = [rank_Inl, rank_Inr, rank_pair1, rank_pair2];
-val rank_trans_rls = rank_rls @ (rank_rls RLN (2, [lt_trans]));
-
-val rank_ss = ZF_ss
- addsimps [case_Inl, case_Inr, VsetI]
- addsimps rank_trans_rls;
-
-(** Recursion over Vset levels! **)
-
-(*NOT SUITABLE FOR REWRITING: recursive!*)
-goalw Univ.thy [Vrec_def] "Vrec(a,H) = H(a, lam x:Vset(rank(a)). Vrec(x,H))";
-by (rtac (transrec RS ssubst) 1);
-by (simp_tac (ZF_ss addsimps [Ord_rank, Ord_succ, VsetD RS ltD RS beta,
- VsetI RS beta, le_refl]) 1);
-val Vrec = result();
-
-(*This form avoids giant explosions in proofs. NOTE USE OF == *)
-val rew::prems = goal Univ.thy
- "[| !!x. h(x)==Vrec(x,H) |] ==> \
-\ h(a) = H(a, lam x: Vset(rank(a)). h(x))";
-by (rewtac rew);
-by (rtac Vrec 1);
-val def_Vrec = result();
-
-
-(*** univ(A) ***)
-
-goalw Univ.thy [univ_def] "!!A B. A<=B ==> univ(A) <= univ(B)";
-by (etac Vfrom_mono 1);
-by (rtac subset_refl 1);
-val univ_mono = result();
-
-goalw Univ.thy [univ_def] "!!A. Transset(A) ==> Transset(univ(A))";
-by (etac Transset_Vfrom 1);
-val Transset_univ = result();
-
-(** univ(A) as a limit **)
-
-goalw Univ.thy [univ_def] "univ(A) = (UN i:nat. Vfrom(A,i))";
-by (rtac (Limit_nat RS Limit_Vfrom_eq) 1);
-val univ_eq_UN = result();
-
-goal Univ.thy "!!c. c <= univ(A) ==> c = (UN i:nat. c Int Vfrom(A,i))";
-by (rtac (subset_UN_iff_eq RS iffD1) 1);
-by (etac (univ_eq_UN RS subst) 1);
-val subset_univ_eq_Int = result();
-
-val [aprem, iprem] = goal Univ.thy
- "[| a <= univ(X); \
-\ !!i. i:nat ==> a Int Vfrom(X,i) <= b \
-\ |] ==> a <= b";
-by (rtac (aprem RS subset_univ_eq_Int RS ssubst) 1);
-by (rtac UN_least 1);
-by (etac iprem 1);
-val univ_Int_Vfrom_subset = result();
-
-val prems = goal Univ.thy
- "[| a <= univ(X); b <= univ(X); \
-\ !!i. i:nat ==> a Int Vfrom(X,i) = b Int Vfrom(X,i) \
-\ |] ==> a = b";
-by (rtac equalityI 1);
-by (ALLGOALS
- (resolve_tac (prems RL [univ_Int_Vfrom_subset]) THEN'
- eresolve_tac (prems RL [equalityD1,equalityD2] RL [subset_trans]) THEN'
- rtac Int_lower1));
-val univ_Int_Vfrom_eq = result();
-
-(** Closure properties **)
-
-goalw Univ.thy [univ_def] "0 : univ(A)";
-by (rtac (nat_0I RS zero_in_Vfrom) 1);
-val zero_in_univ = result();
-
-goalw Univ.thy [univ_def] "A <= univ(A)";
-by (rtac A_subset_Vfrom 1);
-val A_subset_univ = result();
-
-val A_into_univ = A_subset_univ RS subsetD;
-
-(** Closure under unordered and ordered pairs **)
-
-goalw Univ.thy [univ_def] "!!A a. a: univ(A) ==> {a} : univ(A)";
-by (rtac singleton_in_Vfrom_limit 1);
-by (REPEAT (ares_tac [Ord_nat,Limit_nat] 1));
-val singleton_in_univ = result();
-
-goalw Univ.thy [univ_def]
- "!!A a. [| a: univ(A); b: univ(A) |] ==> {a,b} : univ(A)";
-by (rtac doubleton_in_Vfrom_limit 1);
-by (REPEAT (ares_tac [Ord_nat,Limit_nat] 1));
-val doubleton_in_univ = result();
-
-goalw Univ.thy [univ_def]
- "!!A a. [| a: univ(A); b: univ(A) |] ==> <a,b> : univ(A)";
-by (rtac Pair_in_Vfrom_limit 1);
-by (REPEAT (ares_tac [Ord_nat,Limit_nat] 1));
-val Pair_in_univ = result();
-
-goal Univ.thy "univ(A)*univ(A) <= univ(A)";
-by (REPEAT (ares_tac [subsetI,Pair_in_univ] 1
- ORELSE eresolve_tac [SigmaE, ssubst] 1));
-val product_univ = result();
-
-val Sigma_subset_univ = standard
- (Sigma_mono RS (product_univ RSN (2,subset_trans)));
-
-goalw Univ.thy [univ_def]
- "!!a b.[| <a,b> <= univ(A); Transset(A) |] ==> <a,b> : univ(A)";
-by (etac Transset_Pair_subset_Vfrom_limit 1);
-by (REPEAT (ares_tac [Ord_nat,Limit_nat] 1));
-val Transset_Pair_subset_univ = result();
-
-
-(** The natural numbers **)
-
-goalw Univ.thy [univ_def] "nat <= univ(A)";
-by (rtac i_subset_Vfrom 1);
-val nat_subset_univ = result();
-
-(* n:nat ==> n:univ(A) *)
-val nat_into_univ = standard (nat_subset_univ RS subsetD);
-
-(** instances for 1 and 2 **)
-
-goal Univ.thy "1 : univ(A)";
-by (REPEAT (ares_tac [nat_into_univ, nat_0I, nat_succI] 1));
-val one_in_univ = result();
-
-(*unused!*)
-goal Univ.thy "succ(1) : univ(A)";
-by (REPEAT (ares_tac [nat_into_univ, nat_0I, nat_succI] 1));
-val two_in_univ = result();
-
-goalw Univ.thy [bool_def] "bool <= univ(A)";
-by (fast_tac (ZF_cs addSIs [zero_in_univ,one_in_univ]) 1);
-val bool_subset_univ = result();
-
-val bool_into_univ = standard (bool_subset_univ RS subsetD);
-
-
-(** Closure under disjoint union **)
-
-goalw Univ.thy [Inl_def] "!!A a. a: univ(A) ==> Inl(a) : univ(A)";
-by (REPEAT (ares_tac [zero_in_univ,Pair_in_univ] 1));
-val Inl_in_univ = result();
-
-goalw Univ.thy [Inr_def] "!!A b. b: univ(A) ==> Inr(b) : univ(A)";
-by (REPEAT (ares_tac [one_in_univ, Pair_in_univ] 1));
-val Inr_in_univ = result();
-
-goal Univ.thy "univ(C)+univ(C) <= univ(C)";
-by (REPEAT (ares_tac [subsetI,Inl_in_univ,Inr_in_univ] 1
- ORELSE eresolve_tac [sumE, ssubst] 1));
-val sum_univ = result();
-
-val sum_subset_univ = standard
- (sum_mono RS (sum_univ RSN (2,subset_trans)));
-
-
-(** Closure under binary union -- use Un_least **)
-(** Closure under Collect -- use (Collect_subset RS subset_trans) **)
-(** Closure under RepFun -- use RepFun_subset **)
-
-
--- a/src/ZF/univ.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,33 +0,0 @@
-(* Title: ZF/univ.thy
- ID: $Id$
- Author: Lawrence C Paulson, Cambridge University Computer Laboratory
- Copyright 1992 University of Cambridge
-
-The cumulative hierarchy and a small universe for recursive types
-
-Standard notation for Vset(i) is V(i), but users might want V for a variable
-*)
-
-Univ = Arith + Sum + "mono" +
-consts
- Limit :: "i=>o"
- Vfrom :: "[i,i]=>i"
- Vset :: "i=>i"
- Vrec :: "[i, [i,i]=>i] =>i"
- univ :: "i=>i"
-
-translations
- "Vset(x)" == "Vfrom(0,x)"
-
-rules
- Limit_def "Limit(i) == Ord(i) & 0<i & (ALL y. y<i --> succ(y)<i)"
-
- Vfrom_def "Vfrom(A,i) == transrec(i, %x f. A Un (UN y:x. Pow(f`y)))"
-
- Vrec_def
- "Vrec(a,H) == transrec(rank(a), %x g. lam z: Vset(succ(x)). \
-\ H(z, lam w:Vset(x). g`rank(w)`w)) ` a"
-
- univ_def "univ(A) == Vfrom(A,nat)"
-
-end
--- a/src/ZF/wf.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,249 +0,0 @@
-(* Title: ZF/wf.ML
- ID: $Id$
- Author: Tobias Nipkow and Lawrence C Paulson
- Copyright 1992 University of Cambridge
-
-For wf.thy. Well-founded Recursion
-
-Derived first for transitive relations, and finally for arbitrary WF relations
-via wf_trancl and trans_trancl.
-
-It is difficult to derive this general case directly, using r^+ instead of
-r. In is_recfun, the two occurrences of the relation must have the same
-form. Inserting r^+ in the_recfun or wftrec yields a recursion rule with
-r^+ -`` {a} instead of r-``{a}. This recursion rule is stronger in
-principle, but harder to use, especially to prove wfrec_eclose_eq in
-epsilon.ML. Expanding out the definition of wftrec in wfrec would yield
-a mess.
-*)
-
-open WF;
-
-
-(*** Well-founded relations ***)
-
-(*Are these two theorems at all useful??*)
-
-(*If every subset of field(r) possesses an r-minimal element then wf(r).
- Seems impossible to prove this for domain(r) or range(r) instead...
- Consider in particular finite wf relations!*)
-val [prem1,prem2] = goalw WF.thy [wf_def]
- "[| field(r)<=A; \
-\ !!Z u. [| Z<=A; u:Z; ALL x:Z. EX y:Z. <y,x>:r |] ==> False |] \
-\ ==> wf(r)";
-by (rtac (equals0I RS disjCI RS allI) 1);
-by (rtac prem2 1);
-by (res_inst_tac [ ("B1", "Z") ] (prem1 RS (Int_lower1 RS subset_trans)) 1);
-by (fast_tac ZF_cs 1);
-by (fast_tac ZF_cs 1);
-val wfI = result();
-
-(*If r allows well-founded induction then wf(r)*)
-val [prem1,prem2] = goal WF.thy
- "[| field(r)<=A; \
-\ !!B. ALL x:A. (ALL y. <y,x>: r --> y:B) --> x:B ==> A<=B |] \
-\ ==> wf(r)";
-by (rtac (prem1 RS wfI) 1);
-by (res_inst_tac [ ("B", "A-Z") ] (prem2 RS subsetCE) 1);
-by (fast_tac ZF_cs 3);
-by (fast_tac ZF_cs 2);
-by (fast_tac ZF_cs 1);
-val wfI2 = result();
-
-
-(** Well-founded Induction **)
-
-(*Consider the least z in domain(r) Un {a} such that P(z) does not hold...*)
-val major::prems = goalw WF.thy [wf_def]
- "[| wf(r); \
-\ !!x.[| ALL y. <y,x>: r --> P(y) |] ==> P(x) \
-\ |] ==> P(a)";
-by (res_inst_tac [ ("x", "{z:domain(r) Un {a}. ~P(z)}") ] (major RS allE) 1);
-by (etac disjE 1);
-by (rtac classical 1);
-by (etac equals0D 1);
-by (etac (singletonI RS UnI2 RS CollectI) 1);
-by (etac bexE 1);
-by (etac CollectE 1);
-by (etac swap 1);
-by (resolve_tac prems 1);
-by (fast_tac ZF_cs 1);
-val wf_induct = result();
-
-(*Perform induction on i, then prove the wf(r) subgoal using prems. *)
-fun wf_ind_tac a prems i =
- EVERY [res_inst_tac [("a",a)] wf_induct i,
- rename_last_tac a ["1"] (i+1),
- ares_tac prems i];
-
-(*The form of this rule is designed to match wfI2*)
-val wfr::amem::prems = goal WF.thy
- "[| wf(r); a:A; field(r)<=A; \
-\ !!x.[| x: A; ALL y. <y,x>: r --> P(y) |] ==> P(x) \
-\ |] ==> P(a)";
-by (rtac (amem RS rev_mp) 1);
-by (wf_ind_tac "a" [wfr] 1);
-by (rtac impI 1);
-by (eresolve_tac prems 1);
-by (fast_tac (ZF_cs addIs (prems RL [subsetD])) 1);
-val wf_induct2 = result();
-
-val prems = goal WF.thy "[| wf(r); <a,x>:r; <x,a>:r |] ==> False";
-by (subgoal_tac "ALL x. <a,x>:r --> <x,a>:r --> False" 1);
-by (wf_ind_tac "a" prems 2);
-by (fast_tac ZF_cs 2);
-by (fast_tac (FOL_cs addIs prems) 1);
-val wf_anti_sym = result();
-
-(*transitive closure of a WF relation is WF!*)
-val [prem] = goal WF.thy "wf(r) ==> wf(r^+)";
-by (rtac (trancl_type RS field_rel_subset RS wfI2) 1);
-by (rtac subsetI 1);
-(*must retain the universal formula for later use!*)
-by (rtac (bspec RS mp) 1 THEN assume_tac 1 THEN assume_tac 1);
-by (eres_inst_tac [("a","x")] (prem RS wf_induct2) 1);
-by (rtac subset_refl 1);
-by (rtac (impI RS allI) 1);
-by (etac tranclE 1);
-by (etac (bspec RS mp) 1);
-by (etac fieldI1 1);
-by (fast_tac ZF_cs 1);
-by (fast_tac ZF_cs 1);
-val wf_trancl = result();
-
-(** r-``{a} is the set of everything under a in r **)
-
-val underI = standard (vimage_singleton_iff RS iffD2);
-val underD = standard (vimage_singleton_iff RS iffD1);
-
-(** is_recfun **)
-
-val [major] = goalw WF.thy [is_recfun_def]
- "is_recfun(r,a,H,f) ==> f: r-``{a} -> range(f)";
-by (rtac (major RS ssubst) 1);
-by (rtac (lamI RS rangeI RS lam_type) 1);
-by (assume_tac 1);
-val is_recfun_type = result();
-
-val [isrec,rel] = goalw WF.thy [is_recfun_def]
- "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))";
-by (res_inst_tac [("P", "%x.?t(x) = ?u::i")] (isrec RS ssubst) 1);
-by (rtac (rel RS underI RS beta) 1);
-val apply_recfun = result();
-
-(*eresolve_tac transD solves <a,b>:r using transitivity AT MOST ONCE
- spec RS mp instantiates induction hypotheses*)
-fun indhyp_tac hyps =
- resolve_tac (TrueI::refl::hyps) ORELSE'
- (cut_facts_tac hyps THEN'
- DEPTH_SOLVE_1 o (ares_tac [TrueI, ballI] ORELSE'
- eresolve_tac [underD, transD, spec RS mp]));
-
-(*** NOTE! some simplifications need a different solver!! ***)
-val wf_super_ss = ZF_ss setsolver indhyp_tac;
-
-val prems = goalw WF.thy [is_recfun_def]
- "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,b,H,g) |] ==> \
-\ <x,a>:r --> <x,b>:r --> f`x=g`x";
-by (cut_facts_tac prems 1);
-by (wf_ind_tac "x" prems 1);
-by (REPEAT (rtac impI 1 ORELSE etac ssubst 1));
-by (rewtac restrict_def);
-by (asm_simp_tac (wf_super_ss addsimps [vimage_singleton_iff]) 1);
-val is_recfun_equal_lemma = result();
-val is_recfun_equal = standard (is_recfun_equal_lemma RS mp RS mp);
-
-val prems as [wfr,transr,recf,recg,_] = goal WF.thy
- "[| wf(r); trans(r); \
-\ is_recfun(r,a,H,f); is_recfun(r,b,H,g); <b,a>:r |] ==> \
-\ restrict(f, r-``{b}) = g";
-by (cut_facts_tac prems 1);
-by (rtac (consI1 RS restrict_type RS fun_extension) 1);
-by (etac is_recfun_type 1);
-by (ALLGOALS
- (asm_simp_tac (wf_super_ss addsimps
- [ [wfr,transr,recf,recg] MRS is_recfun_equal ])));
-val is_recfun_cut = result();
-
-(*** Main Existence Lemma ***)
-
-val prems = goal WF.thy
- "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |] ==> f=g";
-by (cut_facts_tac prems 1);
-by (rtac fun_extension 1);
-by (REPEAT (ares_tac [is_recfun_equal] 1
- ORELSE eresolve_tac [is_recfun_type,underD] 1));
-val is_recfun_functional = result();
-
-(*If some f satisfies is_recfun(r,a,H,-) then so does the_recfun(r,a,H) *)
-val prems = goalw WF.thy [the_recfun_def]
- "[| is_recfun(r,a,H,f); wf(r); trans(r) |] \
-\ ==> is_recfun(r, a, H, the_recfun(r,a,H))";
-by (rtac (ex1I RS theI) 1);
-by (REPEAT (ares_tac (prems@[is_recfun_functional]) 1));
-val is_the_recfun = result();
-
-val prems = goal WF.thy
- "[| wf(r); trans(r) |] ==> is_recfun(r, a, H, the_recfun(r,a,H))";
-by (cut_facts_tac prems 1);
-by (wf_ind_tac "a" prems 1);
-by (res_inst_tac [("f", "lam y: r-``{a1}. wftrec(r,y,H)")] is_the_recfun 1);
-by (REPEAT (assume_tac 2));
-by (rewrite_goals_tac [is_recfun_def, wftrec_def]);
-(*Applying the substitution: must keep the quantified assumption!!*)
-by (REPEAT (dtac underD 1 ORELSE resolve_tac [refl, lam_cong] 1));
-by (fold_tac [is_recfun_def]);
-by (rtac (consI1 RS restrict_type RSN (2,fun_extension) RS subst_context) 1);
-by (rtac is_recfun_type 1);
-by (ALLGOALS
- (asm_simp_tac
- (wf_super_ss addsimps [underI RS beta, apply_recfun, is_recfun_cut])));
-val unfold_the_recfun = result();
-
-
-(*** Unfolding wftrec ***)
-
-val prems = goal WF.thy
- "[| wf(r); trans(r); <b,a>:r |] ==> \
-\ restrict(the_recfun(r,a,H), r-``{b}) = the_recfun(r,b,H)";
-by (REPEAT (ares_tac (prems @ [is_recfun_cut, unfold_the_recfun]) 1));
-val the_recfun_cut = result();
-
-(*NOT SUITABLE FOR REWRITING since it is recursive!*)
-goalw WF.thy [wftrec_def]
- "!!r. [| wf(r); trans(r) |] ==> \
-\ wftrec(r,a,H) = H(a, lam x: r-``{a}. wftrec(r,x,H))";
-by (rtac (rewrite_rule [is_recfun_def] unfold_the_recfun RS ssubst) 1);
-by (ALLGOALS (asm_simp_tac
- (ZF_ss addsimps [vimage_singleton_iff RS iff_sym, the_recfun_cut])));
-val wftrec = result();
-
-(** Removal of the premise trans(r) **)
-
-(*NOT SUITABLE FOR REWRITING since it is recursive!*)
-val [wfr] = goalw WF.thy [wfrec_def]
- "wf(r) ==> wfrec(r,a,H) = H(a, lam x:r-``{a}. wfrec(r,x,H))";
-by (rtac (wfr RS wf_trancl RS wftrec RS ssubst) 1);
-by (rtac trans_trancl 1);
-by (rtac (vimage_pair_mono RS restrict_lam_eq RS subst_context) 1);
-by (etac r_into_trancl 1);
-by (rtac subset_refl 1);
-val wfrec = result();
-
-(*This form avoids giant explosions in proofs. NOTE USE OF == *)
-val rew::prems = goal WF.thy
- "[| !!x. h(x)==wfrec(r,x,H); wf(r) |] ==> \
-\ h(a) = H(a, lam x: r-``{a}. h(x))";
-by (rewtac rew);
-by (REPEAT (resolve_tac (prems@[wfrec]) 1));
-val def_wfrec = result();
-
-val prems = goal WF.thy
- "[| wf(r); a:A; field(r)<=A; \
-\ !!x u. [| x: A; u: Pi(r-``{x}, B) |] ==> H(x,u) : B(x) \
-\ |] ==> wfrec(r,a,H) : B(a)";
-by (res_inst_tac [("a","a")] wf_induct2 1);
-by (rtac (wfrec RS ssubst) 4);
-by (REPEAT (ares_tac (prems@[lam_type]) 1
- ORELSE eresolve_tac [spec RS mp, underD] 1));
-val wfrec_type = result();
--- a/src/ZF/wf.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,30 +0,0 @@
-(* Title: ZF/wf.thy
- ID: $Id$
- Author: Tobias Nipkow and Lawrence C Paulson
- Copyright 1992 University of Cambridge
-
-Well-founded Recursion
-*)
-
-WF = Trancl + "mono" +
-consts
- wf :: "i=>o"
- wftrec,wfrec :: "[i, i, [i,i]=>i] =>i"
- is_recfun :: "[i, i, [i,i]=>i, i] =>o"
- the_recfun :: "[i, i, [i,i]=>i] =>i"
-
-rules
- (*r is a well-founded relation*)
- wf_def "wf(r) == ALL Z. Z=0 | (EX x:Z. ALL y. <y,x>:r --> ~ y:Z)"
-
- is_recfun_def "is_recfun(r,a,H,f) == \
-\ (f = (lam x: r-``{a}. H(x, restrict(f, r-``{x}))))"
-
- the_recfun_def "the_recfun(r,a,H) == (THE f.is_recfun(r,a,H,f))"
-
- wftrec_def "wftrec(r,a,H) == H(a, the_recfun(r,a,H))"
-
- (*public version. Does not require r to be transitive*)
- wfrec_def "wfrec(r,a,H) == wftrec(r^+, a, %x f. H(x, restrict(f,r-``{x})))"
-
-end
--- a/src/ZF/zf.ML Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,441 +0,0 @@
-(* Title: ZF/zf.ML
- ID: $Id$
- Author: Lawrence C Paulson and Martin D Coen, CU Computer Laboratory
- Copyright 1992 University of Cambridge
-
-Basic introduction and elimination rules for Zermelo-Fraenkel Set Theory
-*)
-
-open ZF;
-
-signature ZF_LEMMAS =
- sig
- val ballE : thm
- val ballI : thm
- val ball_cong : thm
- val ball_simp : thm
- val ball_tac : int -> tactic
- val bexCI : thm
- val bexE : thm
- val bexI : thm
- val bex_cong : thm
- val bspec : thm
- val CollectD1 : thm
- val CollectD2 : thm
- val CollectE : thm
- val CollectI : thm
- val Collect_cong : thm
- val emptyE : thm
- val empty_subsetI : thm
- val equalityCE : thm
- val equalityD1 : thm
- val equalityD2 : thm
- val equalityE : thm
- val equalityI : thm
- val equality_iffI : thm
- val equals0D : thm
- val equals0I : thm
- val ex1_functional : thm
- val InterD : thm
- val InterE : thm
- val InterI : thm
- val INT_E : thm
- val INT_I : thm
- val lemmas_cs : claset
- val PowD : thm
- val PowI : thm
- val RepFunE : thm
- val RepFunI : thm
- val RepFun_eqI : thm
- val RepFun_cong : thm
- val ReplaceE : thm
- val ReplaceI : thm
- val Replace_iff : thm
- val Replace_cong : thm
- val rev_ballE : thm
- val rev_bspec : thm
- val rev_subsetD : thm
- val separation : thm
- val setup_induction : thm
- val set_mp_tac : int -> tactic
- val subsetCE : thm
- val subsetD : thm
- val subsetI : thm
- val subset_refl : thm
- val subset_trans : thm
- val UnionE : thm
- val UnionI : thm
- val UN_E : thm
- val UN_I : thm
- end;
-
-
-structure ZF_Lemmas : ZF_LEMMAS =
-struct
-
-(*** Bounded universal quantifier ***)
-
-val ballI = prove_goalw ZF.thy [Ball_def]
- "[| !!x. x:A ==> P(x) |] ==> ALL x:A. P(x)"
- (fn prems=> [ (REPEAT (ares_tac (prems @ [allI,impI]) 1)) ]);
-
-val bspec = prove_goalw ZF.thy [Ball_def]
- "[| ALL x:A. P(x); x: A |] ==> P(x)"
- (fn major::prems=>
- [ (rtac (major RS spec RS mp) 1),
- (resolve_tac prems 1) ]);
-
-val ballE = prove_goalw ZF.thy [Ball_def]
- "[| ALL x:A. P(x); P(x) ==> Q; x~:A ==> Q |] ==> Q"
- (fn major::prems=>
- [ (rtac (major RS allE) 1),
- (REPEAT (eresolve_tac (prems@[asm_rl,impCE]) 1)) ]);
-
-(*Used in the datatype package*)
-val rev_bspec = prove_goal ZF.thy
- "!!x A P. [| x: A; ALL x:A. P(x) |] ==> P(x)"
- (fn _ =>
- [ REPEAT (ares_tac [bspec] 1) ]);
-
-(*Instantiates x first: better for automatic theorem proving?*)
-val rev_ballE = prove_goal ZF.thy
- "[| ALL x:A. P(x); x~:A ==> Q; P(x) ==> Q |] ==> Q"
- (fn major::prems=>
- [ (rtac (major RS ballE) 1),
- (REPEAT (eresolve_tac prems 1)) ]);
-
-(*Takes assumptions ALL x:A.P(x) and a:A; creates assumption P(a)*)
-val ball_tac = dtac bspec THEN' assume_tac;
-
-(*Trival rewrite rule; (ALL x:A.P)<->P holds only if A is nonempty!*)
-val ball_simp = prove_goal ZF.thy "(ALL x:A. True) <-> True"
- (fn _=> [ (REPEAT (ares_tac [TrueI,ballI,iffI] 1)) ]);
-
-(*Congruence rule for rewriting*)
-val ball_cong = prove_goalw ZF.thy [Ball_def]
- "[| A=A'; !!x. x:A' ==> P(x) <-> P'(x) |] ==> Ball(A,P) <-> Ball(A',P')"
- (fn prems=> [ (simp_tac (FOL_ss addsimps prems) 1) ]);
-
-(*** Bounded existential quantifier ***)
-
-val bexI = prove_goalw ZF.thy [Bex_def]
- "[| P(x); x: A |] ==> EX x:A. P(x)"
- (fn prems=> [ (REPEAT (ares_tac (prems @ [exI,conjI]) 1)) ]);
-
-(*Not of the general form for such rules; ~EX has become ALL~ *)
-val bexCI = prove_goal ZF.thy
- "[| ALL x:A. ~P(x) ==> P(a); a: A |] ==> EX x:A.P(x)"
- (fn prems=>
- [ (rtac classical 1),
- (REPEAT (ares_tac (prems@[bexI,ballI,notI,notE]) 1)) ]);
-
-val bexE = prove_goalw ZF.thy [Bex_def]
- "[| EX x:A. P(x); !!x. [| x:A; P(x) |] ==> Q \
-\ |] ==> Q"
- (fn major::prems=>
- [ (rtac (major RS exE) 1),
- (REPEAT (eresolve_tac (prems @ [asm_rl,conjE]) 1)) ]);
-
-(*We do not even have (EX x:A. True) <-> True unless A is nonempty!!*)
-
-val bex_cong = prove_goalw ZF.thy [Bex_def]
- "[| A=A'; !!x. x:A' ==> P(x) <-> P'(x) \
-\ |] ==> Bex(A,P) <-> Bex(A',P')"
- (fn prems=> [ (simp_tac (FOL_ss addsimps prems addcongs [conj_cong]) 1) ]);
-
-(*** Rules for subsets ***)
-
-val subsetI = prove_goalw ZF.thy [subset_def]
- "(!!x.x:A ==> x:B) ==> A <= B"
- (fn prems=> [ (REPEAT (ares_tac (prems @ [ballI]) 1)) ]);
-
-(*Rule in Modus Ponens style [was called subsetE] *)
-val subsetD = prove_goalw ZF.thy [subset_def] "[| A <= B; c:A |] ==> c:B"
- (fn major::prems=>
- [ (rtac (major RS bspec) 1),
- (resolve_tac prems 1) ]);
-
-(*Classical elimination rule*)
-val subsetCE = prove_goalw ZF.thy [subset_def]
- "[| A <= B; c~:A ==> P; c:B ==> P |] ==> P"
- (fn major::prems=>
- [ (rtac (major RS ballE) 1),
- (REPEAT (eresolve_tac prems 1)) ]);
-
-(*Takes assumptions A<=B; c:A and creates the assumption c:B *)
-val set_mp_tac = dtac subsetD THEN' assume_tac;
-
-(*Sometimes useful with premises in this order*)
-val rev_subsetD = prove_goal ZF.thy "!!A B c. [| c:A; A<=B |] ==> c:B"
- (fn _=> [REPEAT (ares_tac [subsetD] 1)]);
-
-val subset_refl = prove_goal ZF.thy "A <= A"
- (fn _=> [ (rtac subsetI 1), atac 1 ]);
-
-val subset_trans = prove_goal ZF.thy "[| A<=B; B<=C |] ==> A<=C"
- (fn prems=> [ (REPEAT (ares_tac ([subsetI]@(prems RL [subsetD])) 1)) ]);
-
-
-(*** Rules for equality ***)
-
-(*Anti-symmetry of the subset relation*)
-val equalityI = prove_goal ZF.thy "[| A <= B; B <= A |] ==> A = B"
- (fn prems=> [ (REPEAT (resolve_tac (prems@[conjI, extension RS iffD2]) 1)) ]);
-
-val equality_iffI = prove_goal ZF.thy "(!!x. x:A <-> x:B) ==> A = B"
- (fn [prem] =>
- [ (rtac equalityI 1),
- (REPEAT (ares_tac [subsetI, prem RS iffD1, prem RS iffD2] 1)) ]);
-
-val equalityD1 = prove_goal ZF.thy "A = B ==> A<=B"
- (fn prems=>
- [ (rtac (extension RS iffD1 RS conjunct1) 1),
- (resolve_tac prems 1) ]);
-
-val equalityD2 = prove_goal ZF.thy "A = B ==> B<=A"
- (fn prems=>
- [ (rtac (extension RS iffD1 RS conjunct2) 1),
- (resolve_tac prems 1) ]);
-
-val equalityE = prove_goal ZF.thy
- "[| A = B; [| A<=B; B<=A |] ==> P |] ==> P"
- (fn prems=>
- [ (DEPTH_SOLVE (resolve_tac (prems@[equalityD1,equalityD2]) 1)) ]);
-
-val equalityCE = prove_goal ZF.thy
- "[| A = B; [| c:A; c:B |] ==> P; [| c~:A; c~:B |] ==> P |] ==> P"
- (fn major::prems=>
- [ (rtac (major RS equalityE) 1),
- (REPEAT (contr_tac 1 ORELSE eresolve_tac ([asm_rl,subsetCE]@prems) 1)) ]);
-
-(*Lemma for creating induction formulae -- for "pattern matching" on p
- To make the induction hypotheses usable, apply "spec" or "bspec" to
- put universal quantifiers over the free variables in p.
- Would it be better to do subgoal_tac "ALL z. p = f(z) --> R(z)" ??*)
-val setup_induction = prove_goal ZF.thy
- "[| p: A; !!z. z: A ==> p=z --> R |] ==> R"
- (fn prems=>
- [ (rtac mp 1),
- (REPEAT (resolve_tac (refl::prems) 1)) ]);
-
-
-(*** Rules for Replace -- the derived form of replacement ***)
-
-val ex1_functional = prove_goal ZF.thy
- "[| EX! z. P(a,z); P(a,b); P(a,c) |] ==> b = c"
- (fn prems=>
- [ (cut_facts_tac prems 1),
- (best_tac FOL_dup_cs 1) ]);
-
-val Replace_iff = prove_goalw ZF.thy [Replace_def]
- "b : {y. x:A, P(x,y)} <-> (EX x:A. P(x,b) & (ALL y. P(x,y) --> y=b))"
- (fn _=>
- [ (rtac (replacement RS iff_trans) 1),
- (REPEAT (ares_tac [refl,bex_cong,iffI,ballI,allI,conjI,impI,ex1I] 1
- ORELSE eresolve_tac [conjE, spec RS mp, ex1_functional] 1)) ]);
-
-(*Introduction; there must be a unique y such that P(x,y), namely y=b. *)
-val ReplaceI = prove_goal ZF.thy
- "[| x: A; P(x,b); !!y. P(x,y) ==> y=b |] ==> \
-\ b : {y. x:A, P(x,y)}"
- (fn prems=>
- [ (rtac (Replace_iff RS iffD2) 1),
- (REPEAT (ares_tac (prems@[bexI,conjI,allI,impI]) 1)) ]);
-
-(*Elimination; may asssume there is a unique y such that P(x,y), namely y=b. *)
-val ReplaceE = prove_goal ZF.thy
- "[| b : {y. x:A, P(x,y)}; \
-\ !!x. [| x: A; P(x,b); ALL y. P(x,y)-->y=b |] ==> R \
-\ |] ==> R"
- (fn prems=>
- [ (rtac (Replace_iff RS iffD1 RS bexE) 1),
- (etac conjE 2),
- (REPEAT (ares_tac prems 1)) ]);
-
-val Replace_cong = prove_goal ZF.thy
- "[| A=B; !!x y. x:B ==> P(x,y) <-> Q(x,y) |] ==> \
-\ Replace(A,P) = Replace(B,Q)"
- (fn prems=>
- let val substprems = prems RL [subst, ssubst]
- and iffprems = prems RL [iffD1,iffD2]
- in [ (rtac equalityI 1),
- (REPEAT (eresolve_tac (substprems@[asm_rl, ReplaceE, spec RS mp]) 1
- ORELSE resolve_tac [subsetI, ReplaceI] 1
- ORELSE (resolve_tac iffprems 1 THEN assume_tac 2))) ]
- end);
-
-(*** Rules for RepFun ***)
-
-val RepFunI = prove_goalw ZF.thy [RepFun_def]
- "!!a A. a : A ==> f(a) : {f(x). x:A}"
- (fn _ => [ (REPEAT (ares_tac [ReplaceI,refl] 1)) ]);
-
-(*Useful for coinduction proofs*)
-val RepFun_eqI = prove_goal ZF.thy
- "!!b a f. [| b=f(a); a : A |] ==> b : {f(x). x:A}"
- (fn _ => [ etac ssubst 1, etac RepFunI 1 ]);
-
-val RepFunE = prove_goalw ZF.thy [RepFun_def]
- "[| b : {f(x). x:A}; \
-\ !!x.[| x:A; b=f(x) |] ==> P |] ==> \
-\ P"
- (fn major::prems=>
- [ (rtac (major RS ReplaceE) 1),
- (REPEAT (ares_tac prems 1)) ]);
-
-val RepFun_cong = prove_goalw ZF.thy [RepFun_def]
- "[| A=B; !!x. x:B ==> f(x)=g(x) |] ==> RepFun(A,f) = RepFun(B,g)"
- (fn prems=> [ (simp_tac (FOL_ss addcongs [Replace_cong] addsimps prems) 1) ]);
-
-
-(*** Rules for Collect -- forming a subset by separation ***)
-
-(*Separation is derivable from Replacement*)
-val separation = prove_goalw ZF.thy [Collect_def]
- "a : {x:A. P(x)} <-> a:A & P(a)"
- (fn _=> [ (fast_tac (FOL_cs addIs [bexI,ReplaceI]
- addSEs [bexE,ReplaceE]) 1) ]);
-
-val CollectI = prove_goal ZF.thy
- "[| a:A; P(a) |] ==> a : {x:A. P(x)}"
- (fn prems=>
- [ (rtac (separation RS iffD2) 1),
- (REPEAT (resolve_tac (prems@[conjI]) 1)) ]);
-
-val CollectE = prove_goal ZF.thy
- "[| a : {x:A. P(x)}; [| a:A; P(a) |] ==> R |] ==> R"
- (fn prems=>
- [ (rtac (separation RS iffD1 RS conjE) 1),
- (REPEAT (ares_tac prems 1)) ]);
-
-val CollectD1 = prove_goal ZF.thy "a : {x:A. P(x)} ==> a:A"
- (fn [major]=>
- [ (rtac (major RS CollectE) 1),
- (assume_tac 1) ]);
-
-val CollectD2 = prove_goal ZF.thy "a : {x:A. P(x)} ==> P(a)"
- (fn [major]=>
- [ (rtac (major RS CollectE) 1),
- (assume_tac 1) ]);
-
-val Collect_cong = prove_goalw ZF.thy [Collect_def]
- "[| A=B; !!x. x:B ==> P(x) <-> Q(x) |] ==> Collect(A,P) = Collect(B,Q)"
- (fn prems=> [ (simp_tac (FOL_ss addcongs [Replace_cong] addsimps prems) 1) ]);
-
-(*** Rules for Unions ***)
-
-(*The order of the premises presupposes that C is rigid; A may be flexible*)
-val UnionI = prove_goal ZF.thy "[| B: C; A: B |] ==> A: Union(C)"
- (fn prems=>
- [ (resolve_tac [union_iff RS iffD2] 1),
- (REPEAT (resolve_tac (prems @ [bexI]) 1)) ]);
-
-val UnionE = prove_goal ZF.thy
- "[| A : Union(C); !!B.[| A: B; B: C |] ==> R |] ==> R"
- (fn prems=>
- [ (resolve_tac [union_iff RS iffD1 RS bexE] 1),
- (REPEAT (ares_tac prems 1)) ]);
-
-(*** Rules for Inter ***)
-
-(*Not obviously useful towards proving InterI, InterD, InterE*)
-val Inter_iff = prove_goalw ZF.thy [Inter_def,Ball_def]
- "A : Inter(C) <-> (ALL x:C. A: x) & (EX x. x:C)"
- (fn _=> [ (rtac (separation RS iff_trans) 1),
- (fast_tac (FOL_cs addIs [UnionI] addSEs [UnionE]) 1) ]);
-
-(* Intersection is well-behaved only if the family is non-empty! *)
-val InterI = prove_goalw ZF.thy [Inter_def]
- "[| !!x. x: C ==> A: x; c:C |] ==> A : Inter(C)"
- (fn prems=>
- [ (DEPTH_SOLVE (ares_tac ([CollectI,UnionI,ballI] @ prems) 1)) ]);
-
-(*A "destruct" rule -- every B in C contains A as an element, but
- A:B can hold when B:C does not! This rule is analogous to "spec". *)
-val InterD = prove_goalw ZF.thy [Inter_def]
- "[| A : Inter(C); B : C |] ==> A : B"
- (fn [major,minor]=>
- [ (rtac (major RS CollectD2 RS bspec) 1),
- (rtac minor 1) ]);
-
-(*"Classical" elimination rule -- does not require exhibiting B:C *)
-val InterE = prove_goalw ZF.thy [Inter_def]
- "[| A : Inter(C); A:B ==> R; B~:C ==> R |] ==> R"
- (fn major::prems=>
- [ (rtac (major RS CollectD2 RS ballE) 1),
- (REPEAT (eresolve_tac prems 1)) ]);
-
-(*** Rules for Unions of families ***)
-(* UN x:A. B(x) abbreviates Union({B(x). x:A}) *)
-
-(*The order of the premises presupposes that A is rigid; b may be flexible*)
-val UN_I = prove_goal ZF.thy "[| a: A; b: B(a) |] ==> b: (UN x:A. B(x))"
- (fn prems=>
- [ (REPEAT (resolve_tac (prems@[UnionI,RepFunI]) 1)) ]);
-
-val UN_E = prove_goal ZF.thy
- "[| b : (UN x:A. B(x)); !!x.[| x: A; b: B(x) |] ==> R |] ==> R"
- (fn major::prems=>
- [ (rtac (major RS UnionE) 1),
- (REPEAT (eresolve_tac (prems@[asm_rl, RepFunE, subst]) 1)) ]);
-
-
-(*** Rules for Intersections of families ***)
-(* INT x:A. B(x) abbreviates Inter({B(x). x:A}) *)
-
-val INT_I = prove_goal ZF.thy
- "[| !!x. x: A ==> b: B(x); a: A |] ==> b: (INT x:A. B(x))"
- (fn prems=>
- [ (REPEAT (ares_tac (prems@[InterI,RepFunI]) 1
- ORELSE eresolve_tac [RepFunE,ssubst] 1)) ]);
-
-val INT_E = prove_goal ZF.thy
- "[| b : (INT x:A. B(x)); a: A |] ==> b : B(a)"
- (fn [major,minor]=>
- [ (rtac (major RS InterD) 1),
- (rtac (minor RS RepFunI) 1) ]);
-
-
-(*** Rules for Powersets ***)
-
-val PowI = prove_goal ZF.thy "A <= B ==> A : Pow(B)"
- (fn [prem]=> [ (rtac (prem RS (power_set RS iffD2)) 1) ]);
-
-val PowD = prove_goal ZF.thy "A : Pow(B) ==> A<=B"
- (fn [major]=> [ (rtac (major RS (power_set RS iffD1)) 1) ]);
-
-
-(*** Rules for the empty set ***)
-
-(*The set {x:0.False} is empty; by foundation it equals 0
- See Suppes, page 21.*)
-val emptyE = prove_goal ZF.thy "a:0 ==> P"
- (fn [major]=>
- [ (rtac (foundation RS disjE) 1),
- (etac (equalityD2 RS subsetD RS CollectD2 RS FalseE) 1),
- (rtac major 1),
- (etac bexE 1),
- (etac (CollectD2 RS FalseE) 1) ]);
-
-val empty_subsetI = prove_goal ZF.thy "0 <= A"
- (fn _ => [ (REPEAT (ares_tac [equalityI,subsetI,emptyE] 1)) ]);
-
-val equals0I = prove_goal ZF.thy "[| !!y. y:A ==> False |] ==> A=0"
- (fn prems=>
- [ (REPEAT (ares_tac (prems@[empty_subsetI,subsetI,equalityI]) 1
- ORELSE eresolve_tac (prems RL [FalseE]) 1)) ]);
-
-val equals0D = prove_goal ZF.thy "[| A=0; a:A |] ==> P"
- (fn [major,minor]=>
- [ (rtac (minor RS (major RS equalityD1 RS subsetD RS emptyE)) 1) ]);
-
-val lemmas_cs = FOL_cs
- addSIs [ballI, InterI, CollectI, PowI, subsetI]
- addIs [bexI, UnionI, ReplaceI, RepFunI]
- addSEs [bexE, make_elim PowD, UnionE, ReplaceE, RepFunE,
- CollectE, emptyE]
- addEs [rev_ballE, InterD, make_elim InterD, subsetD, subsetCE];
-
-end;
-
-open ZF_Lemmas;
--- a/src/ZF/zf.thy Sat Apr 05 16:18:58 2003 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,220 +0,0 @@
-(* Title: ZF/zf.thy
- ID: $Id$
- Author: Lawrence C Paulson and Martin D Coen, CU Computer Laboratory
- Copyright 1993 University of Cambridge
-
-Zermelo-Fraenkel Set Theory
-*)
-
-ZF = FOL +
-
-types
- i, is 0
-
-arities
- i :: term
-
-
-consts
-
- "0" :: "i" ("0") (*the empty set*)
- Pow :: "i => i" (*power sets*)
- Inf :: "i" (*infinite set*)
-
- (* Bounded Quantifiers *)
-
- "@Ball" :: "[idt, i, o] => o" ("(3ALL _:_./ _)" 10)
- "@Bex" :: "[idt, i, o] => o" ("(3EX _:_./ _)" 10)
- Ball :: "[i, i => o] => o"
- Bex :: "[i, i => o] => o"
-
- (* General Union and Intersection *)
-
- "@INTER" :: "[idt, i, i] => i" ("(3INT _:_./ _)" 10)
- "@UNION" :: "[idt, i, i] => i" ("(3UN _:_./ _)" 10)
- Union, Inter :: "i => i"
-
- (* Variations on Replacement *)
-
- "@Replace" :: "[idt, idt, i, o] => i" ("(1{_ ./ _: _, _})")
- "@RepFun" :: "[i, idt, i] => i" ("(1{_ ./ _: _})")
- "@Collect" :: "[idt, i, o] => i" ("(1{_: _ ./ _})")
- PrimReplace :: "[i, [i, i] => o] => i"
- Replace :: "[i, [i, i] => o] => i"
- RepFun :: "[i, i => i] => i"
- Collect :: "[i, i => o] => i"
-
- (* Descriptions *)
-
- The :: "(i => o) => i" (binder "THE " 10)
- if :: "[o, i, i] => i"
-
- (* Enumerations of type i *)
-
- "" :: "i => is" ("_")
- "@Enum" :: "[i, is] => is" ("_,/ _")
-
- (* Finite Sets *)
-
- "@Finset" :: "is => i" ("{(_)}")
- Upair, cons :: "[i, i] => i"
- succ :: "i => i"
-
- (* Ordered Pairing and n-Tuples *)
-
- "@Tuple" :: "[i, is] => i" ("<(_,/ _)>")
- Pair :: "[i, i] => i"
- fst, snd :: "i => i"
- split :: "[[i, i] => i, i] => i"
- fsplit :: "[[i, i] => o, i] => o"
-
- (* Sigma and Pi Operators *)
-
- "@PROD" :: "[idt, i, i] => i" ("(3PROD _:_./ _)" 10)
- "@SUM" :: "[idt, i, i] => i" ("(3SUM _:_./ _)" 10)
- "@lam" :: "[idt, i, i] => i" ("(3lam _:_./ _)" 10)
- Pi, Sigma :: "[i, i => i] => i"
-
- (* Relations and Functions *)
-
- domain :: "i => i"
- range :: "i => i"
- field :: "i => i"
- converse :: "i => i"
- Lambda :: "[i, i => i] => i"
- restrict :: "[i, i] => i"
-
- (* Infixes in order of decreasing precedence *)
-
- "``" :: "[i, i] => i" (infixl 90) (*image*)
- "-``" :: "[i, i] => i" (infixl 90) (*inverse image*)
- "`" :: "[i, i] => i" (infixl 90) (*function application*)
-
- (*Except for their translations, * and -> are right and ~: left associative infixes*)
- " *" :: "[i, i] => i" ("(_ */ _)" [81, 80] 80) (*Cartesian product*)
- "Int" :: "[i, i] => i" (infixl 70) (*binary intersection*)
- "Un" :: "[i, i] => i" (infixl 65) (*binary union*)
- "-" :: "[i, i] => i" (infixl 65) (*set difference*)
- " ->" :: "[i, i] => i" ("(_ ->/ _)" [61, 60] 60) (*function space*)
- "<=" :: "[i, i] => o" (infixl 50) (*subset relation*)
- ":" :: "[i, i] => o" (infixl 50) (*membership relation*)
- "~:" :: "[i, i] => o" ("(_ ~:/ _)" [50, 51] 50) (*negated membership relation*)
-
-
-translations
- "{x, xs}" == "cons(x, {xs})"
- "{x}" == "cons(x, 0)"
- "<x, y, z>" == "<x, <y, z>>"
- "<x, y>" == "Pair(x, y)"
- "{x:A. P}" == "Collect(A, %x. P)"
- "{y. x:A, Q}" == "Replace(A, %x y. Q)"
- "{f. x:A}" == "RepFun(A, %x. f)"
- "INT x:A. B" == "Inter({B. x:A})"
- "UN x:A. B" == "Union({B. x:A})"
- "PROD x:A. B" => "Pi(A, %x. B)"
- "SUM x:A. B" => "Sigma(A, %x. B)"
- "A -> B" => "Pi(A, _K(B))"
- "A * B" => "Sigma(A, _K(B))"
- "lam x:A. f" == "Lambda(A, %x. f)"
- "ALL x:A. P" == "Ball(A, %x. P)"
- "EX x:A. P" == "Bex(A, %x. P)"
- "x ~: y" == "~ (x : y)"
-
-
-rules
-
- (* Bounded Quantifiers *)
-Ball_def "Ball(A,P) == ALL x. x:A --> P(x)"
-Bex_def "Bex(A,P) == EX x. x:A & P(x)"
-subset_def "A <= B == ALL x:A. x:B"
-
- (* ZF axioms -- see Suppes p.238
- Axioms for Union, Pow and Replace state existence only,
- uniqueness is derivable using extensionality. *)
-
-extension "A = B <-> A <= B & B <= A"
-union_iff "A : Union(C) <-> (EX B:C. A:B)"
-power_set "A : Pow(B) <-> A <= B"
-succ_def "succ(i) == cons(i,i)"
-
- (*We may name this set, though it is not uniquely defined. *)
-infinity "0:Inf & (ALL y:Inf. succ(y): Inf)"
-
- (*This formulation facilitates case analysis on A. *)
-foundation "A=0 | (EX x:A. ALL y:x. y~:A)"
-
- (* Schema axiom since predicate P is a higher-order variable *)
-replacement "(ALL x:A. ALL y z. P(x,y) & P(x,z) --> y=z) ==> \
-\ b : PrimReplace(A,P) <-> (EX x:A. P(x,b))"
-
- (* Derived form of replacement, restricting P to its functional part.
- The resulting set (for functional P) is the same as with
- PrimReplace, but the rules are simpler. *)
-Replace_def "Replace(A,P) == PrimReplace(A, %x y. (EX!z.P(x,z)) & P(x,y))"
-
- (* Functional form of replacement -- analgous to ML's map functional *)
-RepFun_def "RepFun(A,f) == {y . x:A, y=f(x)}"
-
- (* Separation and Pairing can be derived from the Replacement
- and Powerset Axioms using the following definitions. *)
-
-Collect_def "Collect(A,P) == {y . x:A, x=y & P(x)}"
-
- (*Unordered pairs (Upair) express binary union/intersection and cons;
- set enumerations translate as {a,...,z} = cons(a,...,cons(z,0)...) *)
-Upair_def "Upair(a,b) == {y. x:Pow(Pow(0)), (x=0 & y=a) | (x=Pow(0) & y=b)}"
-cons_def "cons(a,A) == Upair(a,a) Un A"
-
- (* Difference, general intersection, binary union and small intersection *)
-
-Diff_def "A - B == { x:A . ~(x:B) }"
-Inter_def "Inter(A) == { x:Union(A) . ALL y:A. x:y}"
-Un_def "A Un B == Union(Upair(A,B))"
-Int_def "A Int B == Inter(Upair(A,B))"
-
- (* Definite descriptions -- via Replace over the set "1" *)
-
-the_def "The(P) == Union({y . x:{0}, P(y)})"
-if_def "if(P,a,b) == THE z. P & z=a | ~P & z=b"
-
- (* Ordered pairs and disjoint union of a family of sets *)
-
- (* this "symmetric" definition works better than {{a}, {a,b}} *)
-Pair_def "<a,b> == {{a,a}, {a,b}}"
-fst_def "fst == split(%x y.x)"
-snd_def "snd == split(%x y.y)"
-split_def "split(c,p) == THE y. EX a b. p=<a,b> & y=c(a,b)"
-fsplit_def "fsplit(R,z) == EX x y. z=<x,y> & R(x,y)"
-Sigma_def "Sigma(A,B) == UN x:A. UN y:B(x). {<x,y>}"
-
- (* Operations on relations *)
-
-(*converse of relation r, inverse of function*)
-converse_def "converse(r) == {z. w:r, EX x y. w=<x,y> & z=<y,x>}"
-
-domain_def "domain(r) == {x. w:r, EX y. w=<x,y>}"
-range_def "range(r) == domain(converse(r))"
-field_def "field(r) == domain(r) Un range(r)"
-image_def "r `` A == {y : range(r) . EX x:A. <x,y> : r}"
-vimage_def "r -`` A == converse(r)``A"
-
- (* Abstraction, application and Cartesian product of a family of sets *)
-
-lam_def "Lambda(A,b) == {<x,b(x)> . x:A}"
-apply_def "f`a == THE y. <a,y> : f"
-Pi_def "Pi(A,B) == {f: Pow(Sigma(A,B)). ALL x:A. EX! y. <x,y>: f}"
-
- (* Restrict the function f to the domain A *)
-restrict_def "restrict(f,A) == lam x:A.f`x"
-
-end
-
-
-ML
-
-(* 'Dependent' type operators *)
-
-val print_translation =
- [("Pi", dependent_tr' ("@PROD", " ->")),
- ("Sigma", dependent_tr' ("@SUM", " *"))];
-