Initial revision
authorclasohm
Thu, 16 Sep 1993 12:20:38 +0200
changeset 0 a5a9c433f639
child 1 c6a6e3db5353
Initial revision
CHANGES-92f.txt
COPYRIGHT
EMAILDIST-README
README
agrep
edits.txt
expandshort
get-rulenames
make-all
make-dist
make-rulenames
prove_goal.el
rm-logfiles
src/CCL/CCL.ML
src/CCL/CCL.thy
src/CCL/Fix.ML
src/CCL/Fix.thy
src/CCL/Gfp.ML
src/CCL/Gfp.thy
src/CCL/Hered.ML
src/CCL/Hered.thy
src/CCL/Lfp.ML
src/CCL/Lfp.thy
src/CCL/Makefile
src/CCL/ROOT.ML
src/CCL/Set.ML
src/CCL/Set.thy
src/CCL/Term.ML
src/CCL/Term.thy
src/CCL/Trancl.ML
src/CCL/Trancl.thy
src/CCL/Type.ML
src/CCL/Type.thy
src/CCL/Wfd.ML
src/CCL/Wfd.thy
src/CCL/ccl.ML
src/CCL/ccl.thy
src/CCL/coinduction.ML
src/CCL/equalities.ML
src/CCL/eval.ML
src/CCL/ex/Flag.ML
src/CCL/ex/Flag.thy
src/CCL/ex/List.ML
src/CCL/ex/List.thy
src/CCL/ex/Nat.ML
src/CCL/ex/Nat.thy
src/CCL/ex/ROOT.ML
src/CCL/ex/Stream.ML
src/CCL/ex/Stream.thy
src/CCL/ex/flag.ML
src/CCL/ex/flag.thy
src/CCL/ex/list.ML
src/CCL/ex/list.thy
src/CCL/ex/nat.ML
src/CCL/ex/nat.thy
src/CCL/ex/stream.ML
src/CCL/ex/stream.thy
src/CCL/fix.ML
src/CCL/fix.thy
src/CCL/genrec.ML
src/CCL/gfp.ML
src/CCL/gfp.thy
src/CCL/hered.ML
src/CCL/hered.thy
src/CCL/lfp.ML
src/CCL/lfp.thy
src/CCL/mono.ML
src/CCL/set.ML
src/CCL/set.thy
src/CCL/subset.ML
src/CCL/term.ML
src/CCL/term.thy
src/CCL/terms.ML
src/CCL/terms.thy
src/CCL/trancl.ML
src/CCL/trancl.thy
src/CCL/type.ML
src/CCL/type.thy
src/CCL/typecheck.ML
src/CCL/wfd.ML
src/CCL/wfd.thy
src/CTT/Arith.ML
src/CTT/Arith.thy
src/CTT/Bool.ML
src/CTT/Bool.thy
src/CTT/CTT.ML
src/CTT/CTT.thy
src/CTT/Makefile
src/CTT/README
src/CTT/ROOT.ML
src/CTT/arith.ML
src/CTT/arith.thy
src/CTT/bool.ML
src/CTT/bool.thy
src/CTT/ctt.ML
src/CTT/ctt.thy
src/CTT/ex/ROOT.ML
src/CTT/ex/elim.ML
src/CTT/ex/equal.ML
src/CTT/ex/synth.ML
src/CTT/ex/typechk.ML
src/CTT/rew.ML
src/Cube/Cube.ML
src/Cube/Cube.thy
src/Cube/Makefile
src/Cube/README
src/Cube/ROOT.ML
src/Cube/cube.ML
src/Cube/cube.thy
src/Cube/ex.ML
src/FOL/.fol.thy.ML
src/FOL/.ifol.thy.ML
src/FOL/FOL.ML
src/FOL/FOL.thy
src/FOL/IFOL.ML
src/FOL/IFOL.thy
src/FOL/Makefile
src/FOL/README
src/FOL/ROOT.ML
src/FOL/ex/.if.thy.ML
src/FOL/ex/.list.thy.ML
src/FOL/ex/.nat.thy.ML
src/FOL/ex/.nat2.thy.ML
src/FOL/ex/.prolog.thy.ML
src/FOL/ex/If.ML
src/FOL/ex/If.thy
src/FOL/ex/List.ML
src/FOL/ex/List.thy
src/FOL/ex/Nat.ML
src/FOL/ex/Nat.thy
src/FOL/ex/Nat2.ML
src/FOL/ex/Nat2.thy
src/FOL/ex/Prolog.ML
src/FOL/ex/Prolog.thy
src/FOL/ex/ROOT.ML
src/FOL/ex/cla.ML
src/FOL/ex/foundn.ML
src/FOL/ex/if.ML
src/FOL/ex/if.thy
src/FOL/ex/int.ML
src/FOL/ex/intro.ML
src/FOL/ex/list.ML
src/FOL/ex/list.thy
src/FOL/ex/nat.ML
src/FOL/ex/nat.thy
src/FOL/ex/nat2.ML
src/FOL/ex/nat2.thy
src/FOL/ex/prolog.ML
src/FOL/ex/prolog.thy
src/FOL/ex/prop.ML
src/FOL/ex/quant.ML
src/FOL/fol.ML
src/FOL/fol.thy
src/FOL/ifol.ML
src/FOL/ifol.thy
src/FOL/int-prover.ML
src/FOL/intprover.ML
src/FOL/simpdata.ML
src/FOLP/FOLP.ML
src/FOLP/FOLP.thy
src/FOLP/IFOLP.ML
src/FOLP/IFOLP.thy
src/FOLP/Makefile
src/FOLP/ROOT.ML
src/FOLP/change
src/FOLP/classical.ML
src/FOLP/ex/If.ML
src/FOLP/ex/If.thy
src/FOLP/ex/Nat.ML
src/FOLP/ex/Nat.thy
src/FOLP/ex/Prolog.ML
src/FOLP/ex/Prolog.thy
src/FOLP/ex/ROOT.ML
src/FOLP/ex/cla.ML
src/FOLP/ex/foundn.ML
src/FOLP/ex/if.ML
src/FOLP/ex/if.thy
src/FOLP/ex/int.ML
src/FOLP/ex/intro.ML
src/FOLP/ex/nat.ML
src/FOLP/ex/nat.thy
src/FOLP/ex/prolog.ML
src/FOLP/ex/prolog.thy
src/FOLP/ex/prop.ML
src/FOLP/ex/quant.ML
src/FOLP/folp.ML
src/FOLP/folp.thy
src/FOLP/ifolp.ML
src/FOLP/ifolp.thy
src/FOLP/int-prover.ML
src/FOLP/intprover.ML
src/FOLP/simp.ML
src/FOLP/simpdata.ML
src/LCF/LCF.ML
src/LCF/LCF.thy
src/LCF/Makefile
src/LCF/README
src/LCF/ROOT.ML
src/LCF/ex.ML
src/LCF/fix.ML
src/LCF/lcf.ML
src/LCF/lcf.thy
src/LCF/pair.ML
src/LCF/simpdata.ML
src/LK/LK.ML
src/LK/LK.thy
src/LK/Makefile
src/LK/README
src/LK/ROOT.ML
src/LK/ex/ROOT.ML
src/LK/ex/hard-quant.ML
src/LK/ex/hardquant.ML
src/LK/ex/prop.ML
src/LK/ex/quant.ML
src/LK/lk.ML
src/LK/lk.thy
src/Modal/Makefile
src/Modal/Modal0.thy
src/Modal/README
src/Modal/ROOT.ML
src/Modal/S4.thy
src/Modal/S43.thy
src/Modal/T.thy
src/Modal/ex/ROOT.ML
src/Modal/ex/S43thms.ML
src/Modal/ex/S4thms.ML
src/Modal/ex/Tthms.ML
src/Modal/modal0.thy
src/Modal/prover.ML
src/Modal/s4.thy
src/Modal/s43.thy
src/Modal/t.thy
src/Provers/README
src/Provers/classical.ML
src/Provers/genelim.ML
src/Provers/hypsubst.ML
src/Provers/ind.ML
src/Provers/simp.ML
src/Provers/simplifier.ML
src/Provers/splitter.ML
src/Provers/typedsimp.ML
src/Pure/Makefile
src/Pure/NJ.ML
src/Pure/POLY.ML
src/Pure/README
src/Pure/ROOT.ML
src/Pure/Syntax/README
src/Pure/Syntax/ROOT.ML
src/Pure/Syntax/ast.ML
src/Pure/Syntax/earley0A.ML
src/Pure/Syntax/extension.ML
src/Pure/Syntax/lexicon.ML
src/Pure/Syntax/parse_tree.ML
src/Pure/Syntax/pretty.ML
src/Pure/Syntax/printer.ML
src/Pure/Syntax/sextension.ML
src/Pure/Syntax/syntax.ML
src/Pure/Syntax/type_ext.ML
src/Pure/Syntax/xgram.ML
src/Pure/Thy/ROOT.ML
src/Pure/Thy/parse.ML
src/Pure/Thy/read.ML
src/Pure/Thy/scan.ML
src/Pure/Thy/syntax.ML
src/Pure/drule.ML
src/Pure/envir.ML
src/Pure/goals.ML
src/Pure/install_pp.ML
src/Pure/library.ML
src/Pure/logic.ML
src/Pure/net.ML
src/Pure/pattern.ML
src/Pure/sequence.ML
src/Pure/sign.ML
src/Pure/symtab.ML
src/Pure/tactic.ML
src/Pure/tctical.ML
src/Pure/term.ML
src/Pure/thm.ML
src/Pure/type.ML
src/Pure/unify.ML
src/Tools/agrep
src/Tools/expandshort
src/Tools/make-all
src/Tools/rm-logfiles
src/Tools/teeinput
src/Tools/xlisten
src/ZF/Arith.ML
src/ZF/Arith.thy
src/ZF/Bool.ML
src/ZF/Bool.thy
src/ZF/Datatype.ML
src/ZF/Epsilon.ML
src/ZF/Epsilon.thy
src/ZF/Fixedpt.ML
src/ZF/Fixedpt.thy
src/ZF/List.ML
src/ZF/ListFn.ML
src/ZF/ListFn.thy
src/ZF/Makefile
src/ZF/Nat.ML
src/ZF/Nat.thy
src/ZF/Ord.ML
src/ZF/Ord.thy
src/ZF/Pair.ML
src/ZF/Perm.ML
src/ZF/Perm.thy
src/ZF/QPair.ML
src/ZF/QPair.thy
src/ZF/QUniv.ML
src/ZF/QUniv.thy
src/ZF/README
src/ZF/ROOT.ML
src/ZF/Sum.ML
src/ZF/Sum.thy
src/ZF/Trancl.ML
src/ZF/Trancl.thy
src/ZF/Univ.ML
src/ZF/Univ.thy
src/ZF/WF.ML
src/ZF/WF.thy
src/ZF/ZF.ML
src/ZF/ZF.thy
src/ZF/arith.ML
src/ZF/arith.thy
src/ZF/bool.ML
src/ZF/bool.thy
src/ZF/co-inductive.ML
src/ZF/coinductive.ML
src/ZF/constructor.ML
src/ZF/datatype.ML
src/ZF/domrange.ML
src/ZF/epsilon.ML
src/ZF/epsilon.thy
src/ZF/equalities.ML
src/ZF/ex/Acc.ML
src/ZF/ex/BT.ML
src/ZF/ex/BT_Fn.ML
src/ZF/ex/BT_Fn.thy
src/ZF/ex/Bin.ML
src/ZF/ex/BinFn.ML
src/ZF/ex/BinFn.thy
src/ZF/ex/Comb.ML
src/ZF/ex/Contract0.ML
src/ZF/ex/Contract0.thy
src/ZF/ex/Enum.ML
src/ZF/ex/Equiv.ML
src/ZF/ex/Equiv.thy
src/ZF/ex/Integ.ML
src/ZF/ex/Integ.thy
src/ZF/ex/LList.ML
src/ZF/ex/LListFn.ML
src/ZF/ex/LListFn.thy
src/ZF/ex/ListN.ML
src/ZF/ex/ParContract.ML
src/ZF/ex/Prop.ML
src/ZF/ex/PropLog.ML
src/ZF/ex/PropLog.thy
src/ZF/ex/ROOT.ML
src/ZF/ex/Ramsey.ML
src/ZF/ex/Ramsey.thy
src/ZF/ex/TF.ML
src/ZF/ex/TF_Fn.ML
src/ZF/ex/TF_Fn.thy
src/ZF/ex/Term.ML
src/ZF/ex/TermFn.ML
src/ZF/ex/TermFn.thy
src/ZF/ex/acc.ML
src/ZF/ex/bin.ML
src/ZF/ex/binfn.ML
src/ZF/ex/binfn.thy
src/ZF/ex/bt.ML
src/ZF/ex/bt_fn.ML
src/ZF/ex/bt_fn.thy
src/ZF/ex/comb.ML
src/ZF/ex/contract0.ML
src/ZF/ex/contract0.thy
src/ZF/ex/enum.ML
src/ZF/ex/equiv.ML
src/ZF/ex/equiv.thy
src/ZF/ex/integ.ML
src/ZF/ex/integ.thy
src/ZF/ex/listn.ML
src/ZF/ex/llist.ML
src/ZF/ex/llistfn.ML
src/ZF/ex/llistfn.thy
src/ZF/ex/misc.ML
src/ZF/ex/parcontract.ML
src/ZF/ex/prop.ML
src/ZF/ex/proplog.ML
src/ZF/ex/proplog.thy
src/ZF/ex/ramsey.ML
src/ZF/ex/ramsey.thy
src/ZF/ex/term.ML
src/ZF/ex/termfn.ML
src/ZF/ex/termfn.thy
src/ZF/ex/tf.ML
src/ZF/ex/tf_fn.ML
src/ZF/ex/tf_fn.thy
src/ZF/ex/twos-compl.ML
src/ZF/ex/twos_compl.ML
src/ZF/fin.ML
src/ZF/fixedpt.ML
src/ZF/fixedpt.thy
src/ZF/func.ML
src/ZF/ind-syntax.ML
src/ZF/ind_syntax.ML
src/ZF/indrule.ML
src/ZF/inductive.ML
src/ZF/intr-elim.ML
src/ZF/intr_elim.ML
src/ZF/list.ML
src/ZF/listfn.ML
src/ZF/listfn.thy
src/ZF/mono.ML
src/ZF/nat.ML
src/ZF/nat.thy
src/ZF/ord.ML
src/ZF/ord.thy
src/ZF/pair.ML
src/ZF/perm.ML
src/ZF/perm.thy
src/ZF/qpair.ML
src/ZF/qpair.thy
src/ZF/quniv.ML
src/ZF/quniv.thy
src/ZF/simpdata.ML
src/ZF/subset.ML
src/ZF/sum.ML
src/ZF/sum.thy
src/ZF/trancl.ML
src/ZF/trancl.thy
src/ZF/univ.ML
src/ZF/univ.thy
src/ZF/upair.ML
src/ZF/wf.ML
src/ZF/wf.thy
src/ZF/zf.ML
src/ZF/zf.thy
teeinput
xlisten
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CHANGES-92f.txt	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,40 @@
+**** Isabelle-92f : a faster version of Isabelle-92 ****
+
+Isabelle now runs faster through a combination of improvements: pattern
+unification, discrimination nets and removal of assumptions during
+simplification.  Classical reasoning (e.g. fast_tac) runs up to 30% faster
+when large numbers of rules are involved.  Rewriting (e.g. SIMP_TAC) runs
+up to 3 times faster for large subgoals.  
+
+The new version will not benefit everybody; unless you require greater
+speed, it may be best to stay with the existing version.  The new changes
+have not been documented properly, and there are a few incompatibilities.
+
+THE SPEEDUPS
+
+Pattern unification is completely invisible to users.  It efficiently
+handles a common case of higher-order unification.
+
+Discrimination nets replace the old stringtrees.  They provide fast lookup
+in a large set of rules for matching or unification.  New "net" tactics
+replace the "compat_..." tactics based on stringtrees.  Tactics
+biresolve_from_nets_tac, bimatch_from_nets_tac, resolve_from_net_tac and
+match_from_net_tac take a net, rather than a list of rules, and perform
+resolution or matching.  Tactics net_biresolve_tac, net_bimatch_tac
+net_resolve_tac and net_match_tac take a list of rules, build a net
+(internally) and perform resolution or matching.
+
+The tactical METAHYPS, which allows a subgoal's hypotheses to be taken as a
+list of theorems, has been extended to handle unknowns (although not type
+unknowns).  The simplification tactics now use METAHYPS to economise on
+storage consumption, and to avoid problems involving "parameters" bound in
+a subgoal.  The modified simplifier now requires the auto_tac to take an
+extra argument: a list of theorems, which represents the assumptions of the
+current subgoal.
+
+OTHER CHANGES
+
+Apart from minor improvements in Pure Isabelle, the main other changes are
+extensions to object-logics.  HOL now contains a treatment of co-induction
+and co-recursion, while ZF contains a formalization of equivalence classes,
+the integers and binary arithmetic.  None of this material is documented.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/COPYRIGHT	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,21 @@
+ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER.
+
+Copyright (C) 1992 by the University of Cambridge, Cambridge, England.
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any non-commercial purpose and without fee is hereby
+granted, provided that the above copyright notice appears in all copies and
+that both the copyright notice and this permission notice and warranty
+disclaimer appear in supporting documentation, and that the name of the
+University of Cambridge not be used in advertising or publicity pertaining
+to distribution of the software without specific, written prior permission.
+
+The University of Cambridge disclaims all warranties with regard to this
+software, including all implied warranties of merchantability and fitness.
+In no event shall the University of Cambridge be liable for any special,
+indirect or consequential damages or any damages whatsoever resulting from
+loss of use, data or profits, whether in an action of contract, negligence
+or other tortious action, arising out of or in connection with the use or
+performance of this software.
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/EMAILDIST-README	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,37 @@
+ISABELLE -- INSTRUCTIONS FOR UNPACKING THE EMAIL DISTRIBUTION 
+
+The Isabelle email distribution consists of about 8 installments, each
+small enough to send by electronic mail.  The files are called Isabelle.aa,
+Isabelle.ab, ....  They have been generated by tar, compress, uuencode, and
+split, and are packed for email using shar.  To unpack the files, perform
+the following steps:
+
+STEP 1.  Create a new directory to hold Isabelle and move to that
+directory (the name of the directory does not matter):
+
+	mkdir Isabelle;  cd Isabelle
+
+STEP 2.  Put each message into a separate file and pipe it through unshar.
+(If you don't have unshar, remove the header lines generated by the mail
+system and submit the file to sh.)
+
+STEP 3.  Concatenate the files into one file using the command
+
+	cat Isabelle.?? > 92.tar.Z.uu
+
+STEP 4.  Undo the uuencode operation using the command
+
+	uudecode 92.tar.Z.uu
+
+STEP 5.  You should now have a file 92.tar.Z; uncompress and unpack it using...
+
+   	uncompress -c 92.tar.Z | tar xf -
+
+STEP 6.  You should now have a complete Isabelle directory, called 92.  You
+may now tidy up by executing
+
+	rm Isabelle.?? *.hdr 92.tar.Z.uu 92.tar.Z
+
+Consult the file 92/README for information on compiling Isabelle.
+
+						Good luck!
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,113 @@
+		     ISABELLE-92 DISTRIBUTION DIRECTORY
+
+------------------------------------------------------------------------------
+ISABELLE-92 IS INCOMPATIBLE WITH EARLIER VERSIONS.  PLEASE CONSULT THE
+DOCUMENTATION.
+------------------------------------------------------------------------------
+
+This directory contains the complete Isabelle system.  To build and test the
+entire system, including all object-logics, use the shell script make-all.
+Pure Isabelle and each of the object-logics can be built separately using the
+Makefiles in the respective directories; read them for more information.
+
+				THE MAKEFILES
+
+The Makefiles can use two different Standard ML compilers: Poly/ML version
+1.88MSX or later (from Abstract Hardware Ltd) and Standard ML of New Jersey
+(Version 75 or later).  Poly/ML is a commercial product and costs money,
+but it is reliable and its database system is convenient for interactive
+work.  SML of New Jersey requires lots of memory and disc space, but it is
+free and its code sometimes runs faster.  Both compilers are perfectly
+satisfactory for running Isabelle.
+
+The Makefiles and make-all use enviroment variables that you should set
+according to your site configuration.
+
+ISABELLEBIN is the directory to hold Poly/ML databases or New Jersey ML
+images.  When using Poly/ML, ISABELLEBIN must be an absolute pathname (one
+starting with "/").
+
+ML_DBASE is an absolute pathname to the initial Poly/ML database (not
+required for New Jersey ML).
+
+ISABELLECOMP is the ML compiler, typically "poly -noDisplay" or "sml".  If
+ISABELLECOMP begins with the letters "poly" then the Makefiles assume that
+it is Poly/ML; if it begins with the letters "sml" then they assume
+Standard ML of New Jersey.
+
+
+			 STRUCTURE OF THIS DIRECTORY
+
+The directory Pure containes pure Isabelle, which has no object-logic.
+
+Other important files include...
+    COPYRIGHT   	Copyright notice and Disclaimer of Warranty
+    make-rulenames	shell script used during Make
+    make-all		shell script for building entire system
+    expandshort		shell script to expand "shortcuts" in files
+    prove_goal.el       Emacs command to change proof format
+    xlisten		shell script for running Isabelle under X
+    teeinput		shell script to run Isabelle, logging inputs to a file
+    theory-template.ML	template file for defining new theories
+    Pure		directory of source files for Pure Isabelle
+    Provers		directory of generic theorem provers
+
+xlisten sets up a window running Isabelle, with a separate small "listener"
+window, which keeps a log of all input lines.  This log is a useful record
+of a session.  If you are not running X windows, teeinput can still be used at
+least to record (if not to display) the log.
+
+The following subdirectories contain object-logics:
+    FOL 	Natural deduction logic (intuitionistic and classical)
+    ZF		Zermelo-Fraenkel Set theory
+    CTT		Constructive Type Theory
+    HOL		Classical Higher-Order Logic
+    LK		Classical sequent calculus
+    Modal	The modal logics T, S4, S43
+    LCF         Logic for Computable Functions (domain theory)
+    Cube	Barendregt's Lambda Cube
+
+Object-logics include examples files in subdirectory ex or file ex.ML.
+These files can be loaded in batch mode.  The commands can also be
+executed interactively, using the windows on your workstation.  This is a
+good way to get started.
+
+Each object-logic is built on top of Pure Isabelle, and possibly on top of
+another object logic (like FOL or LK).  A database or binary called Pure is
+first created, then the object-logic is loaded on top.  Poly/ML extends
+Pure using its "make_database" operation.  Standard ML of New Jersey starts
+with the Pure core image and loads the object-logic's ROOT.ML.
+
+		HOW TO GET A STANDARD ML COMPILER
+
+To obtain Poly/ML, contact Mike Crawley <mjc@ahl.co.uk> at Abstract
+Hardware Ltd, The Howell Building, Brunel University, Uxbridge UB8 3PH,
+England.
+
+To obtain Standard ML of New Jersey, contact David MacQueen
+<dbm@com.att.research> at AT&T Bell Laboratories, 600 Mountain Avenue,
+Murray Hill, NJ 07974, USA.  This compiler is available by FTP.  Connect to
+research.att.com; login as anonymous with your userid as password; set
+binary mode; transfer files from the directory dist/ml.
+
+------------------------------------------------------------------------------
+
+Please report any problems you encounter.  While we will try to be helpful,
+we can accept no responsibility for the deficiences of Isabelle amd their
+consequences.
+
+Lawrence C Paulson		E-mail: lcp@cl.cam.ac.uk
+Computer Laboratory 		Phone: +44-223-334600
+University of Cambridge 	Fax:   +44-223-334748 
+Pembroke Street 
+Cambridge CB2 3QG 
+England
+
+Tobias Nipkow			E-mail: nipkow@informatik.tu-muenchen.de
+Institut fuer Informatik	Phone: +49-89-2105-2690
+T. U. Muenchen			Fax:   +49-89-2105-8183
+Postfach 20 24 20
+D-8000 Muenchen 2
+Germany
+
+Last updated 25 August 1992
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/agrep	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,2 @@
+#! /bin/csh
+grep "$*" {Pure/Syntax,Pure/Thy}/*ML */*ML */ex/*ML 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/edits.txt	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,1372 @@
+EDITS TO THE ISABELLE SYSTEM FOR 1993
+
+11 January 
+
+*/README: Eliminated references to Makefile.NJ, which no longer exists.
+
+**** New tar file placed on /homes/lcp (464K) **** 
+
+14 January
+
+Provers/simp/pr_goal_lhs: now distinct from pr_goal_concl so that tracing
+prints conditions correctly.
+
+{CTT/arith,HOL/ex/arith/ZF/arith}/add_mult_distrib: renamed from
+add_mult_dist, to agree with the other _distrib rules
+
+20 January
+
+Pure/Syntax/type_ext.ML: "I have fixed a few anomalies in the pretty
+printing annotations for types.  Only the layout has changed." -- Toby
+
+21 January
+
+{CTT/arith,HOL/ex/arith/ZF/arith}/add_inverse_diff: renamed to add_diff_inverse
+
+22 January
+
+ZF/ex/equiv: new theory of equivalence classes
+ZF/ex/integ: new theory of integers
+HOL/set.thy: added indentation of 3 to all binding operators
+
+ZF/bool/boolI0,boolI1: renamed as bool_0I, bool_1I
+
+25 January
+
+MAKE-ALL (NJ 0.75) ran perfectly.  It took 3:19 hours!?
+
+ZF/bool/not,and,or,xor: new
+
+27 January
+
+ZF/ex/bin: new theory of binary integer arithmetic
+
+27 January
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 6:33 hours???
+(ZF took almost 5 hours!)
+
+**** New tar file placed on /homes/lcp (472K) **** 
+
+HOL/set/UN_cong,INT_cong: new
+HOL/subset/mem_rews,set_congs,set_ss: new
+HOL/simpdata/o_apply: new; added to HOL_ss
+
+29 January
+
+Pure/Thy/syntax/mk_structure: the dummy theory created by type infixes is
+now called name^"(type infix)" instead of "", avoid triggering a spurious
+error "Attempt to merge different versions of theory: " in
+Pure/sign/merge_stamps
+
+2 February
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:48 hours.  Runs in 1992 took
+under 2:20 hours, but the new files in ZF/ex take time: nearly 23 minutes
+according to make10836.log.
+
+Pure/Thy/scan/comment: renamed from komt
+Pure/Thy/scan/numeric: renamed from zahl
+
+Pure/Syntax/syntax,lexicon,type_ext,extension,sextension: modified by
+Tobias to change ID, TVAR, ... to lower case.
+
+Cube/cube.thy,HOL/hol.thy,HOL/set.thy,CTT/ctt.thy,LK/lk.thy,ZF/zf.thy: now
+with ID, ... in lower case and other tidying
+
+3 February
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:50 hours.
+
+4 February
+
+HOL/nat/nat_ss: now includes the rule Suc_less_eq: (Suc(m) < Suc(n)) = (m<n)
+and the nat_case rules and congruence rules
+
+HOL/sum/sumE: now has the "strong" form with equality assumptions.  WAS
+    val prems = goalw Sum.thy [Inl_def,Inr_def]
+	"[| !!x::'a. P(Inl(x));  !!y::'b. P(Inr(y)) \
+    \    |] ==> P(s)";
+    by (res_inst_tac [("t","s")] (Rep_Sum_inverse RS subst) 1);
+    by (rtac (rewrite_rule [Sum_def] Rep_Sum RS CollectE) 1);
+    by (REPEAT (eresolve_tac [disjE,exE,ssubst] 1 ORELSE resolve_tac prems 1));
+    val sumE = result();
+
+8 February
+
+Changes from Tobias:
+Pure/Thy/parse: now list_of admits the empty phrase, while listof_1 does not
+Pure/Thy/syntax: uses new list_of, list_of1
+
+9 February
+
+HOL/ex/arith: moved to main HOL directory
+HOL/prod: now define the type "unit" and constant "(): unit"
+
+11 February
+
+HOL/arith: eliminated redefinitions of nat_ss and arith_ss
+
+12 February
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:50 hours.
+
+Pure/Thy/scan/string: now correctly recognizes ML-style strings.
+
+15 February
+
+MAKE-ALL (NJ 0.75) ran perfectly.  It took 1:37 hours (on albatross)
+MAKE-ALL (NJ 0.75) ran perfectly.  It took 2:42 hours (on dunlin)
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:53 hours (on dunlin)
+
+**** New tar file placed on /homes/lcp (480K) **** 
+
+18 February
+
+Pure/Syntax/earley0A/compile_xgram: Tobias deleted the third argument, as
+it was unused.
+
+Pure/Syntax/earley0A: modified accordingly.
+
+19 February
+
+MAKE-ALL (NJ 0.75) ran perfectly.  It took 3:37 hours 
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:52 hours
+
+**** New tar file placed on /homes/lcp (480K) **** 
+
+20 February
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:30 hours 
+
+10 March
+
+HOL/fun/image_eqI: fixed bad pattern
+
+11 March
+
+MAKE-ALL (Poly/ML) failed in HOL!
+
+HOL/fun: moved "mono" proofs to HOL/subset, since they rely on subset laws
+of Int and Un.
+
+12 March
+
+ZF/ex/misc: new example from Bledsoe
+
+15 March
+
+ZF/perm: two new theorems inspired by Pastre
+
+16 March
+
+Weakened congruence rules for HOL: speeds simplification considerably by
+NOT simplifying the body of a conditional or eliminator.
+
+HOL/simpdata/mk_weak_congs: new, to make weakened congruence rules
+
+HOL/simpdata/congs: renamed HOL_congs and weakened the "if" rule
+
+HOL/simpdata/HOL_congs: now contains polymorphic rules for the overloaded
+operators < and <=
+
+HOL/prod: weakened the congruence rule for split
+HOL/sum: weakened the congruence rule for case
+HOL/nat: weakened the congruence rule for nat_case and nat_rec
+HOL/list: weakened the congruence rule for List_rec and list_rec
+
+HOL & test rebuilt perfectly
+
+Pure/goals/prepare_proof/mkresult: fixed bug in signature check.  Now
+compares the FINAL signature with that from the original theory.
+
+Pure/goals/prepare_proof: ensures that [prove_]goalw checks that the
+definitions do not update the proof state.
+
+17 March
+
+MAKE-ALL (Poly/ML) ran perfectly.
+
+18 March
+
+MAKE-ALL (Poly/ML) failed in HOL/ex/Substitutions
+
+HOL/ex/Subst/setplus: changed Set.thy to Setplus.thy where
+necessary
+
+ZF/perm: proved some rules about inj and surj
+
+ZF/ex/misc: did some of Pastre's examples
+
+Pure/library/gen_ins,gen_union: new
+
+HOL/ex/Subst/subst: renamed rangeE to srangeE
+
+18 March
+
+MAKE-ALL (Poly/ML) failed in HOL/ex/term due to renaming of list_ss in
+ex/Subst/alist
+
+HOL/list/list_congs: new; re-organized simpsets a bit
+
+Pure/goals/sign_error: new
+
+Pure/goals/prepare_proof,by_com: now print the list of new theories when
+the signature of the proof state changes 
+
+HOL/prod,sexp: renamed fst, snd to fst_conv, snd_conv to avoid over-writing
+the library functions fst, snd
+
+HOL/fun/image_compose: new
+
+21 March
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:50 hours 
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:21 hours
+Much slower now (about 30 minutes!) because of HOL/ex/Subst
+
+**** New tar file placed on /homes/lcp (504K) **** 
+
+ZF/pair,simpdata: renamed fst, snd to fst_conv, snd_conv to avoid over-writing
+the library functions fst, snd
+
+HOL/prod/prod_fun_imageI,E: new
+
+HOL/ex/Subst/Unify: renamed to Unifier to avoid clobbering structure Unify
+of Pure
+
+24 March
+
+HOL/trancl/comp_subset_Sigma: new
+HOL/wf/wfI: new
+
+HOL/Subst: moved from HOL/ex/Subst to shorten pathnames
+HOL/Makefile: target 'test' now loads Subst/ROOT separately
+
+*** Installation of gfp, coinduction, ... to HOL ***
+
+HOL/gfp,llist: new
+HOL/univ,sexp,list: replaced with new version
+
+Sexp is now the set of all well-founded trees, each of type 'a node set.
+There is no longer a type 'sexp'.  Initial algebras require more explicit
+type checking than before.  Defining a type 'sexp' would eliminate this,
+but would also require a whole new set of primitives, similar to those
+defined in univ.thy but restricted to well-founded trees.
+
+25 March
+
+Pure/thm: renamed 'bires' to 'eres' in many places (not exported) --
+biresolution now refers to resolution with (flag,rule) pairs.
+
+Pure/thm/bicompose_aux: SOUNDNESS BUG concerning variable renaming.  A Var in
+a premise was getting renamed when its occurrence in the flexflex pairs was
+not.  Martin Coen supplied the following proof of True=False in HOL:
+
+    val [prem] = goal Set.thy "EX a:{c}.p=a ==> p=c";
+    br (prem RS bexE) 1; be ssubst 1; be singletonD 1;
+    val l1 = result();
+
+    val rls = [refl] RL [bexI] RL [l1];
+
+    goal Set.thy "True = False";
+    brs rls 1; br singletonI 1;
+    result();
+
+Marcus Moore noted that the error only occurred with
+Logic.auto_rename:=false.  Elements of the fix:
+
+1.  rename_bvs, rename_bvars and bicompose_aux/newAs take tpairs (the
+existing flex-flex pairs) as an extra argument.  rename_bvs preserves all
+Vars in tpairs.
+
+2.  bicompose_aux/tryasms and res now unpack the "cell" and supply its tpairs
+to newAs.
+
+HOL/lfp,gfp,ex/set: renamed Tarski to lfp_Tarski
+
+HOL/lfp,list,llist,nat,sexp,trancl,Subst/uterm,ex/simult,ex/term: renamed
+def_Tarski to def_lfp_Tarski 
+
+26 March
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:25 hours!
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:54 hours! (jobs overlapped)
+
+Pure/Thy/scan/is_digit,is_letter: deleted.  They are already in
+Pure/library, and these versions used non-Standard string comparisons!
+
+Repairing a fault reported by David Aspinall:
+  show_types := true;  read "a";  (* followed by  'prin it' for NJ *)
+Raises exception  LIST "hd".   Also has the side effect of leaving
+show_types set at false. 
+
+Pure/goals/read: no longer creates a null TVar
+Pure/Syntax/lexicon/string_of_vname: now handles null names
+Pure/Syntax/printer/string_of_typ: tidied
+
+/usr/groups/theory/isabelle/92/Pure/thm: replaced by new version to fix bug
+MAKE-ALL on this directory ran perfectly
+/usr/groups/theory/ml-aftp/Isabelle92.tar.Z: replaced by new version
+
+29 March
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:14 hours!
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:43 hours!
+
+**** New tar file placed on /homes/lcp (518K) **** 
+
+30 March
+
+ZF/univ/cons_in_Vfrom: deleted "[| a: Vfrom(A,i);  b<=Vfrom(A,i) |] ==>
+cons(a,b) : Vfrom(A,succ(i))" since it was useless.
+
+8 April
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:49 hours!
+
+**** New tar file placed on /homes/lcp (520K) **** 
+
+**** Updates for pattern unification (Tobias Nipkow) ****
+
+Pure/pattern.ML: new, pattern unification
+
+Pure/Makefile and ROOT.ML: included pattern.ML
+
+Pure/library.ML: added predicate downto0
+
+Pure/unify.ML: call pattern unification first. Removed call to could_unify.
+
+FOL/Makefile/FILES: now mentions ifol.ML (previously repeated fol.ML instead)
+
+**** Installation of Martin Coen's FOLP (FOL + proof objects) ****
+
+renamed PFOL, PIFOL to FOLP, IFOLP, etc.
+
+9 April
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:05 hours!
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:31 hours!
+
+**** New tar file placed on /homes/lcp (576K) **** 
+
+**** Installation of Discrimination Nets ****
+
+*Affected files (those mentioning Stringtree, compat_thms or rtr_resolve_tac)
+Pure/ROOT.ML,goals.ML,stringtree.ML,tactic.ML
+Provers/simp.ML
+HOL/ex/meson.ML
+
+*Affected files (those mentioning compat_resolve_tac)
+Pure/tactic.ML
+Provers/typedsimp.ML
+CTT/ctt.ML
+
+Pure/stringtree: saved on Isabelle/old
+Pure/net: new
+Pure/Makefile/FILES: now mentions net.ML, not stringtree.ML
+Pure/ROOT: now mentions net.ML, not stringtree.ML
+
+Pure/goals/compat_goal: DELETED
+
+Pure/tactic/compat_thms,rtr_resolve_tac,compat_resolve_tac,insert_thm,
+delete_thm,head_string: DELETED
+
+Pure/tactic/biresolve_from_nets_tac, bimatch_from_nets_tac,
+net_biresolve_tac, net_bimatch_tac, resolve_from_net_tac, match_from_net_tac,
+net_resolve_tac, net_match_tac: NEW
+
+Pure/tactic/filt_resolve_tac: new implementation using nets!
+
+Provers/simp: replaced by new version
+
+Provers/typedsimp: changed compat_resolve_tac to filt_resolve_tac and
+updated comments
+
+CTT/ctt.ML: changed compat_resolve_tac to filt_resolve_tac 
+ZF/simpdata/typechk_step_tac: changed compat_resolve_tac to filt_resolve_tac
+
+CTT tested
+
+HOL/ex/meson/ins_term,has_reps: replaced Stringtree by Net
+
+FOL tested
+
+Provers/simp/cong_const: new, replaces head_string call in cong_consts
+Provers/simp: renamed variables: atomic to at and cong_consts to ccs
+
+ZF/ex/bin/integ_of_bin_type: proof required reordering of rules --
+typechk_tac now respects this ordering!
+
+ZF tested
+
+DOCUMENTATION
+
+Logics/CTT: Removed mention of compat_resolve_tac 
+Ref/goals: deleted compat_goal's entry
+
+Provers/hypsubst/lasthyp_subst_tac: deleted
+
+FOLP/ROOT/dest_eq: corrected; now hyp_subst_tac works!
+
+12 April
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:03 hours!
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:28 hours!
+
+FOLP/{int-prover,classical}/safe_step_tac: uses eq_assume_tac, not assume_tac
+FOLP/{int-prover,classical}/inst_step_tac: restored, calls assume and mp_tac
+FOLP/{int-prover,classical}/step_tac: calls inst_step_tac 
+
+{FOL,FOLP}/int-prover/safe_brls: removed (asm_rl,true) since assume_tac is
+used explicitly!!
+
+FOLP/ifolp/uniq_assume_tac: new, since eq_assume_tac is almost useless
+
+FOLP/{int-prover,classical}/uniq_mp_tac: replace eq_mp_tac and call
+uniq_assume_tac
+
+Provers/classical: REPLACED BY 'NET' VERSION!
+
+13 April
+
+MAKE-ALL (Poly/ML) failed in ZF and ran out of quota for Cube.
+
+Unification bug (nothing to do with pattern unification)
+Cleaning of flex-flex pairs attempts to remove all occurrences of bound
+variables not common to both sides.  Arguments containing "banned" bound
+variables are deleted -- but this should ONLY be done if the occurrence is
+rigid!
+
+unify/CHANGE_FAIL: new, for flexible occurrence of bound variable
+unify/change_bnos: now takes "flex" as argument, indicating path status
+
+14 April
+
+MAKE-ALL (Poly/ML) failed in HOL (ASM_SIMP_TAC redefined!) and LK
+
+LK/ex/hard-quant/37: added "by flexflex_tac" to compensate for flexflex
+changes
+
+Pure/goals/gethyps: now calls METAHYPS directly
+
+rm-logfiles: no longer mentions directories.  WAS
+    rm log {Pure,FOL,ZF,LCF,CTT,LK,Modal,HOL,Cube}/make*.log
+    rm {FOL,ZF,LCF,CTT,LK,Modal,HOL,Cube}/test
+    rm {FOL,ZF,LCF,CTT,LK,Modal,HOL,Cube}/.*.thy.ML
+    rm {FOL,ZF,HOL}/ex/.*.thy.ML
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:39 hours! (albatross)
+
+New version of simp on Isabelle/new -- instantiates unknowns provided only
+one rule may do so [SINCE REJECTED DUE TO UNPREDICTABLE BEHAVIOR]
+
+works with FOLP/ex/nat, but in general could fail in the event of
+overlapping rewrite rules, since FOLP always instantiates unknowns during
+rewriting.
+
+ZF: tested with new version
+
+HOL: tested with new version, appeared to loop in llist/Lmap_ident
+
+**** NEW VERSION OF ASM_SIMP_TAC, WITH METAHYPS ****
+
+ZF: failed in perm/comp_mem_injD1: the rule anti_refl_rew is too ambiguous!
+ZF/wfrec: all uses of wf_ss' require
+by (METAHYPS (fn hyps => cut_facts_tac hyps 1 THEN
+                         SIMP_TAC (wf_ss' addrews (hyps)) 1) 1);
+
+ZF/epsilon/eclose_least: changed ASM_SIMP_TAC to SIMP_TAC; this makes
+METAHYPS version work
+
+ZF/arith/add_not_less_self: adds anti_refl_rew
+
+ZF/ex/prop-log/hyps_finite: the use of UN_I is very bad -- too undirected.
+Swapping the premises of UN_I would probably allow instantiation.
+
+ZF otherwise seems to work!
+
+HOL/llist/llistE: loops! due to rewriting by Rep_LList_LCons of Vars
+
+HOL/ex/prop-log/comp_lemma: failed due to uninstantiated Var in 
+(CCONTR_rule RS allI)
+
+*** REJECTED
+
+15 April
+
+These overnight runs involve Provers/simp.ML with old treatment of rules
+(match_tac) and no METAHYPS; they test the new flexflex pairs and
+discrimination nets, to see whether it runs faster.
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:39 hours (4 mins faster)
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:23 hours (5 mins faster)
+
+ZF/simpdata/ZF_ss: deleted anti_refl_rew; non-linear patterns slow down
+discrimination nets (and this rewrite used only ONCE)
+
+ZF/mem_not_refl: new; replaces obsolete anti_refl_rew
+
+**Timing experiments**
+
+fun HYP_SIMP_TAC ss = METAHYPS (fn hyps => HOL_SIMP_TAC (ss addrews hyps) 1);
+
+On large examples such as ...
+HOL/arith/mod_quo_equality 
+HOL/llist/LListD_implies_ntrunc_equality
+ZF/ex/bin/integ_of_bin_succ
+... it is 1.5 to 3 times faster than ASM_SIMP_TAC.  But cannot replace
+ASM_SIMP_TAC since the auto_tac sometimes fails due to lack of assumptions.
+If there are few assumptions then HYP_SIMP_TAC is no better.
+
+Pure/Makefile: now copies $(ML_DBASE) to $(BIN)/Pure instead of calling
+make_database, so that users can call make_database for their object-logics.
+
+Pure/tctical/SELECT_GOAL: now does nothing if i=1 and there is
+only one subgoal.
+
+19 April
+
+MAKE-ALL (NJ 0.93) failed in HOL due to lack of disc space.
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:23 hours 
+
+**** Installation of new simplifier ****
+
+Provers/simp/EXEC: now calls METAHYPS and passes the hyps as an extra arg
+to the auto_tac.
+
+FOL,HOL/simpdata: auto_tac now handles the hyps argument
+
+ZF/simpdata/standard_auto_tac: deleted
+ZF/simpdata/auto_tac: added hyps argument
+ZF/epsilon/eclose_least_lemma: no special auto_tac 
+
+*/ex/ROOT: no longer use 'cd' commands; instead pathnames contain "ex/..."
+
+20 April
+
+MAKE-ALL failed in HOL/Subst
+
+HOL/Subst/setplus/cla_case: renamed imp_excluded_middle and simplified.
+Old version caused ambiguity in rewriting:
+     "[| P ==> P-->Q;  ~P ==> ~P-->Q |] ==> Q";
+
+**** New tar file placed on /homes/lcp (????) **** 
+
+Pure/Syntax: improvements to the printing of syntaxes
+Pure/Syntax/lexicon.ML: added name_of_token
+Pure/Syntax/earley0A.ML: updated print_gram
+
+21 April
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:44 hours
+MAKE-ALL (Poly/ML) failed in HOL due to lack of disc space
+
+HOL/list,llist: now share NIL, CONS, List_Fun and List_case
+
+make-all: now compresses the log files, which were taking up 4M; this
+reduces their space by more than 1/3
+
+rm-logfiles: now deletes compressed log files.
+
+** Patrick Meche has noted that if the goal is stated with a leading !!
+quantifier, then the list of premises is always empty -- this gives the
+effect of an initial (cut_facts_tac prems 1).  The final theorem is the
+same as it would be without the quantifier.
+
+ZF: used the point above to simplify many proofs
+ZF/domrange/cfast_tac: deleted, it simply called cut_facts_tac
+
+22 April
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:52 hours??
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:16 hours
+
+30 April
+
+HOL: installation of finite set notation: {x1,...,xn} (by Tobias Nipkow)
+
+HOL/set.thy,set.ML,fun.ML,equalities.ML: addition of rules for "insert",
+new derivations for "singleton"
+
+HOL/llist.thy,llist.ML: changed {x.False} to {}
+
+**** New tar file placed on /homes/lcp (584K) **** 
+
+4 May
+
+MAKE-ALL (NJ 0.93) ran out of space in LK.
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:14 hours
+
+Pure/Makefile: inserted "chmod u+w $(BIN)/Pure;" in case $(ML_DBASE) is
+write-protected
+
+5 May
+
+HOL/list/not_Cons_self: renamed from l_not_Cons_l
+HOL/list/not_CONS_self: new
+
+HOL/llist.thy/Lconst: changed type and def to remove Leaf
+HOL/llist.ML: changed Lconst theorems
+
+6 May
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:18 hours
+
+** Installation of new HOL from Tobias **
+
+HOL/ex/{finite,prop-log} made like the ZF versions
+HOL/hol.thy: type classes plus, minus, times; overloaded operators + - *
+HOL/set: set enumeration via "insert"
+         additions to set_cs and set_ss
+HOL/set,subset,equalities: various lemmas to do with {}, insert and -
+HOL/llist: One of the proofs needs one fewer commands
+HOL/arith: many proofs require type constraints due to overloading
+
+** end Installation **
+
+ZF/ex/misc: added new lemmas from Abrial's paper
+
+7 May 
+
+HOL/llist.ML/LList_corec_subset1: deleted a fast_tac call; the previous
+simplification now proves the subgoal.
+
+**** New tar file placed on /homes/lcp (584K) **** 
+
+** Installation of new simplifier from Tobias **
+
+The "case_splits" parameter of SimpFun is moved from the signature to the
+simpset.  SIMP_CASE_TAC and ASM_SIMP_CASE_TAC are removed.  The ordinary
+simplification tactics perform case splits if present in the simpset.
+
+The simplifier finds out for itself what constant is affected.  Instead of
+supplying the pair (expand_if,"if"), supply just the rule expand_if.
+
+This change affects all calls to SIMP_CASE_TAC and all applications of SimpFun.
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:18 hours
+
+Cube/ex: UNTIL1, UNTIL_THM: replaced by standard tactics DEPTH_SOLVE_1 and
+DEPTH_SOLVE
+
+HOL: installation of NORM tag for simplication.  How was it forgotten??
+
+HOL/hol.thy: declaration of NORM
+HOL/simpdata: NORM_def supplied to SimpFun
+
+10 May
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:33 hours??
+
+11 May
+
+HOL/prod/Prod_eq: renamed Pair_eq
+HOL/ex/lex-prod: wf_lex_prod: simplified proof
+
+HOL/fun/inj_eq: new
+
+HOL/llist/sumPairE: deleted, thanks to new simplifier's case splits!
+
+12 May
+
+MAKE-ALL (NJ 0.93) ran out of space in HOL.
+MAKE-ALL (Poly/ML) failed in HOL.
+HOL/Subst/utermlemmas/utlemmas_ss: deleted Prod_eq from the congruence rules
+
+13 May
+
+Pure/logic/flexpair: moved to term, with "equals" etc.  Now pervasive
+Pure/logic/mk_flexpair: now exported
+Pure/logic/dest_flexpair: new
+Pure/goals/print_exn: now prints the error message for TERM and TYPE
+
+Pure/Syntax/sextension: now =?= has type ['a::{}, 'a] => prop because
+flexflex pairs can have any type at all.  Thus == must have the same type.
+
+Pure/thm/flexpair_def: now =?= and == are equated for all 'a::{}.
+
+Pure/tctical/equal_abs_elim,equal_abs_elim_list: new (for METAHYPS fix)
+Pure/tctical/METAHYPS: now works if new proof state has flexflex pairs
+
+Pure/Syntax/earley0A,syntax,lexicon: Tokens are represented by strings now,
+not by integers.  (Changed by Tobias)
+
+*** Installation of more printing functions ***
+
+Pure/sign/sg: changed from a type abbrev to a datatype
+Pure/type/type_sig: changed from a type abbrev to a datatype
+These changes needed for abstract type printing in NJ
+
+Pure/tctical/print_sg,print_theory: new
+
+Pure/drule: new file containing derived rules and printing functions.
+Mostly from tctical.ML, but includes rewriting rules from tactic.ML.
+
+Pure/ROOT: loads drule before tctical; TacticalFun,TacticFun,GoalsFun now
+depend on Drule and have sharing constraints.
+
+14 May
+
+Installing new print functions for New Jersey: incompatible with Poly/ML!
+
+Pure/NJ/install_pp_nj: new (requires datatypes as above)
+Pure/POLY/install_pp_nj: a dummy version
+
+Pure/ROOT: calls install_pp_nj to install printing for NJ
+
+*/ROOT: added extra install_pp calls (sg, theory, cterm, typ, ctyp) for
+Poly/ML [ZF,LCF,Modal do not need them since they inherit them from another
+logic -- make_database is not used]
+
+17 May
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:57 hours??
+
+Pure/Syntax/lexicon: Yet another leaner and faster version ... (from Tobias)
+
+18 May
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:36 hours
+
+19 May
+
+ZF/equalities/Union_singleton,Inter_singleton: now refer to {b} instead of
+complex assumptions
+
+20 May
+
+HOL/list: Tobias added the [x1,...,xn] notation and the functions hd, tl,
+null and list_case.
+
+1 June
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 3:39 hours
+
+**** New tar file 92.tar.z placed on /homes/lcp (376K) **** 
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 1:49 hours on albatross.
+
+Pure/tactic/dres_inst_tac,forw_inst_tac: now call the new
+make_elim_preserve to preserve Var indexes when creating the elimination
+rule.
+
+ZF/ex/ramsey: modified calls to dres_inst_tac
+
+2 June
+
+Pure/Thy/read/read_thy,use_thy: the .thy.ML file is now written to the
+current directory, since the pathname may lead to a non-writeable area.
+
+HOL/arith: renamed / and // to div and mod
+ZF/arith: renamed #/ and #// to div and mod
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 1:48 hours on albatross.
+
+**** New tar file 92.tar.z placed on /homes/lcp (376K) **** 
+
+Pure/NJ/commit: new dummy function
+FOLP/ex/ROOT: inserted commit call to avoid Poly/ML problems
+
+make-all: now builds FOLP also!
+
+3 June
+
+ZF/zf.thy,HOL/list.thy,HOL/set.thy: now constructions involving {_}, [_],
+<_,_> are formatted as {(_)}, [(_)], 
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 4:37 hours on muscovy (with FOLP).
+
+ZF/Makefile: removed obsolete target for .rules.ML
+
+All object-logic Makefiles: EXAMPLES ARE NO LONGER SAVED.  This saves disc
+and avoids problems (in New Jersey ML) of writing to the currently
+executing image.
+
+4 June
+
+Pure/logic/rewritec: now uses nets for greater speed.  Functor LogicFun now
+takes Net as argument.
+
+Pure/ROOT: now loads net before logic.
+
+MAKE-ALL (Poly/ML) failed in ZF and HOL.
+
+LK/lk.thy: changed constant "not" to "Not" (for consistency with FOL)
+
+7 June
+
+Pure/tactic/is_letdig: moved to library
+Pure/Syntax/lexicon/is_qld: deleted, was same as is_letdig
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:07 hours on albatross.
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:41 hours on dunlin.
+
+HOL/set/UN1,INT1: new union/intersection operators.  Binders UN x.B(x),
+INT x.B(x).
+
+HOL/univ,llist: now use UN x.B(x) instead of Union(range(B))
+
+HOL/subset: added lattice properties for INT, UN (both forms)
+
+8 June
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:45 hours on dunlin.
+
+**** New tar file 92.tar.z placed on /homes/lcp (384K) **** 
+
+14 June
+
+HOL/list.thy/List_rec_def: changed pred_sexp (a variable!) to pred_Sexp.
+Using def_wfrec hides such errors!!
+
+**** New tar file 92.tar.gz placed on /homes/lcp (384K) **** 
+
+** NEW VERSION FROM MUNICH WITH ==-REWRITING **
+
+** The following changes are Toby's **
+
+type.ML:
+
+Renamed mark_free to freeze_vars and thaw_tvars to thaw_vars.
+Added both functions to the signature.
+
+sign.ML:
+
+Added val subsig: sg * sg -> bool to signature.
+Added trueprop :: prop and mark_prop : prop => prop to pure_sg.
+
+Added
+
+val freeze_vars: term -> term
+val thaw_vars: term -> term
+val strip_all_imp: term * int -> term list * term * int
+
+Moved rewritec_bottom and rewritec_top to thm.ML.
+Only bottom-up rewriting supported any longer.
+
+thm.ML:
+
+Added
+
+(* internal form of conditional ==-rewrite rules *)
+type meta_simpset
+val add_mss: meta_simpset * thm list -> meta_simpset
+val empty_mss: meta_simpset
+val mk_mss: thm list -> meta_simpset
+
+val mark_prop_def: thm
+val truepropI: thm
+val trueprop_def: thm
+
+(* bottom-up conditional ==-rewriting with local ==>-assumptions *)
+val rewrite_cterm: meta_simpset -> (thm -> thm list)
+                   -> (meta_simpset -> thm list -> Sign.cterm -> thm)
+                   -> Sign.cterm -> thm
+val trace_simp: bool ref
+
+Simplified concl_of: call to Logic.skip_flexpairs redundant.
+
+drule.ML:
+
+Added
+
+(* rewriting *)
+val asm_rewrite_rule: (thm -> thm list) -> thm list -> thm -> thm
+val rewrite_goal_rule: (thm -> thm list) -> thm list -> int -> thm -> thm
+val rewrite_goals_rule: (thm -> thm list) -> thm list -> thm -> thm
+
+(* derived concepts *)
+val forall_trueprop_eq: thm
+val implies_trueprop_eq: thm
+val mk_trueprop_eq: thm -> thm
+val reflexive_eq: thm
+val reflexive_thm: thm
+val trueprop_implies_eq: thm
+val thm_implies: thm -> thm -> thm
+val thm_equals: thm -> thm -> thm
+
+(*Moved here from tactic.ML:*)
+val asm_rl: thm
+val cut_rl: thm
+val revcut_rl: thm
+
+tactic.ML:
+
+Added
+
+val asm_rewrite_goal_tac: (thm -> thm list) -> thm list -> int -> tactic
+val asm_rewrite_goals_tac: (thm -> thm list) -> thm list -> tactic
+val asm_rewrite_tac: (thm -> thm list) -> thm list -> tactic
+val fold_goal_tac: thm list -> int -> tactic
+val rewrite_goal_tac: thm list -> int -> tactic
+
+Moved to drule.ML:
+val asm_rl: thm
+val cut_rl: thm
+val revcut_rl: thm
+
+goals.ML:
+
+Changed prepare_proof to make sure that rewriting with empty list of
+meta-thms is identity.
+
+** End of Toby's changes **
+
+16 June
+
+Pure/sign/typ_of,read_ctyp: new
+Pure/logic/dest_flexpair: now exported
+
+Pure/drule/flexpair_intr,flexpair_elim: new; fixes a bug in
+flexpair_abs_elim_list
+
+HOL/equalities/image_empty,image_insert: new
+HOL/ex/finite/Fin_imageI: new
+
+Installed Martin Coen's CCL as new object-logic
+
+17 June
+
+** More changes from Munich (Markus Wenzel) **
+
+Pure/library: added the, is_some, is_none, separate and improved space_implode
+Pure/sign: Sign.extend now calls Syntax.extend with list of constants
+Pure/symtab: added is_null
+Pure/Syntax/sextension: added empty_sext
+Pure/Syntax/syntax: changed Syntax.extend for compatibility with future version
+
+HOL now exceeds poly's default heap size. Hence HOL/Makefile needs to
+specify -h 8000.
+
+HOL/univ/ntrunc_subsetD, etc: deleted the useless j<k assumption
+
+18 June
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 4:59 hours on dunlin (with CCL).
+
+Pure/sign/read_def_cterm: now prints the offending terms, as well as the
+types, when exception TYPE is raised.
+
+HOL/llist: some tidying
+
+23 June
+
+HOL/llist/Lconst_type: generalized from Lconst(M): LList({M})
+
+24 June
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:23 hours on albatross (with CCL)
+
+MAKE-ALL (NJ 0.93) failed in CCL due to use of "abstraction" as an
+identifier in CCL.ML
+
+**** New tar file 92.tar.gz placed on /homes/lcp (384K) **** (with CCL)
+
+CCL/ROOT: added ".ML" extension to use commands for NJ compatibility
+
+25 June
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:23 hours on albatross.
+MAKE-ALL (NJ 0.93) failed in HOL due to lack of ".ML" extension
+
+HOL/fun/rangeE,imageE: eta-expanded f to get variable name preservation
+
+HOL/llist/iterates_equality,lmap_lappend_distrib: tidied
+
+28 June
+
+HOL/set/UN1_I: made the Var and Bound variables agree ("x") to get variable
+name preservation 
+
+HOL/llist: co-induction rules applied with res_inst_tac to state the
+bisimulation directly
+
+2 July
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 2:10 hours on albatross.
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:23 hours on albatross.
+
+92/Makefile/$(BIN)/Pure: changed echo makefile= to echo database=
+
+**** New tar file 92.tar.gz placed on /homes/lcp (424K) **** (with CCL)
+
+
+** NEW VERSION FROM MUNICH WITH ABSTRACT SYNTAX TREES & NEW PARSER **
+
+I have merged in the changes shown above since 24 June
+
+CHANGES LOG OF Markus Wenzel (MMW)
+=======
+
+29-Jun-1993 MMW
+  *** Beta release of new syntax module ***
+  (should be 99% backwards compatible)
+
+  Pure/Thy/ROOT.ML
+    added keywords for "translations" section
+
+  Pure/Thy/syntax.ML
+    minor cleanup
+    added syntax for "translations" section
+    .*.thy.ML files now human readable
+    .*.thy.ML used to be generated incorrectly if no mixfix but "ML" section
+    "ML" section no longer demands any definitions (parse_translation, ...)
+
+  Pure/Thy/read.ML
+    read_thy: added close_in
+    added file_exists (not perfect)
+    use_thy: now uses file_exists
+
+  Pure/thm.ML
+    added syn_of: theory -> syntax
+
+  Pure/Makefile
+    SYNTAX_FILES: added Syntax/ast.ML
+
+  Pure/Syntax/pretty.ML
+    added str_of: T -> string
+
+  Pure/Syntax/ast.ML
+    added this file
+
+  Pure/Syntax/extension.ML
+  Pure/Syntax/parse_tree.ML
+  Pure/Syntax/printer.ML
+  Pure/Syntax/ROOT.ML
+  Pure/Syntax/sextension.ML
+  Pure/Syntax/syntax.ML
+  Pure/Syntax/type_ext.ML
+  Pure/Syntax/xgram.ML
+    These files have been completely rewritten, though the global structure
+    is similar to the old one.
+
+
+30-Jun-1993 MMW
+  New versions of HOL and Cube: use translation rules wherever possible;
+
+  HOL/hol.thy
+    cleaned up
+    removed alt_tr', mk_bindopt_tr'
+    alternative binders now implemented via translation rules and mk_alt_ast_tr'
+
+  HOL/set.thy
+    cleaned up
+    removed type "finset"
+    now uses category "args" for finite sets
+    junked "ML" section
+    added "translations" section
+
+  HOL/list.thy
+    cleaned up
+    removed type "listenum"
+    now uses category "args" for lists
+    junked "ML" section
+    added "translations" section
+
+  Cube/cube.thy
+    cleaned up
+    changed indentation of Lam and Pi from 2 to 3
+    removed qnt_tr, qnt_tr', no_asms_tr, no_asms_tr'
+    fixed fun_tr': all but one newly introduced frees will have type dummyT
+    added "translations" section
+
+
+30-Jun-1993, 05-Jul-1993 MMW
+  Improved toplevel pretty printers:
+    - unified interface for POLY and NJ;
+    - print functions now insert atomic string into the toplevel's pp stream,
+      rather than writing it to std_out (advantage: output appears at the
+      correct position, disadvantage: output cannot be broken);
+  (Is there anybody in this universe who exactly knows how Poly's install_pp
+  is supposed to work?);
+
+  Pure/NJ.ML
+    removed dummy install_pp
+    added make_pp, install_pp
+
+  Pure/POLY.ML
+    removed dummy install_pp_nj
+    added make_pp
+
+  Pure/ROOT.ML
+    removed install_pp_nj stuff
+
+  Pure/drule.ML
+    added str_of_sg, str_of_theory, str_of_thm
+
+  Pure/install_pp.ML
+    added this file
+
+  Pure/sign.ML
+    added str_of_term, str_of_typ, str_of_cterm, str_of_ctyp
+
+  Pure/goals.ML
+    added str_of_term, str_of_typ
+
+  CTT/ROOT.ML
+  Cube/ROOT.ML
+  FOL/ROOT.ML
+  FOLP/ROOT.ML
+  HOL/ROOT.ML
+  LK/ROOT.ML
+    replaced install_pp stuff by 'use "../Pure/install_pp.ML"'
+
+
+01-Jul-1993 MMW
+  Misc small fixes
+
+  CCL/ROOT.ML
+  HOL/ROOT.ML
+    added ".ML" suffix to some filenames
+
+  HOL/ex/unsolved.ML
+    replaced HOL_Rule.thy by HOL.thy
+
+  Pure/NJ.ML
+    quit was incorrectly int -> unit
+
+END MMW CHANGES
+
+Pure/Syntax/sextension/eta_contract: now initially false 
+
+Pure/library/cat_lines: no longer calls "distinct"
+Pure/sign: replaced to calls of implode (map (apr(op^,"\n") o ... by cat_lines
+NB This could cause duplicate error messages from Pure/sign and Pure/type
+
+Pure/goals/prove_goalw: now prints some of the information from print_exn
+
+9 July
+
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:26 hours on albatross.
+
+**** New tar file 93.tar.gz placed on /homes/lcp (480K) **** 
+
+12 July
+
+MAKE-ALL (NJ 0.93) ran perfectly.  It took 2:13 hours on albatross.
+MAKE-ALL (Poly/ML) ran perfectly.  It took 2:25 hours on albatross.
+
+22 July
+
+ZF/zf.thy: new version from Marcus Wenzel
+
+ZF: ** installation of inductive definitions **
+
+changing the argument order of "split"; affects fst/snd too
+sum.thy zf.thy ex/bin.thy ex/integ.thy ex/simult.thy ex/term.thy
+pair.ML  ex/integ.ML
+
+changing the argument order of "case" and adding "Part": sum.thy sum.ML
+
+ZF/zf.ML/rev_subsetD,rev_bspec: new
+
+ZF/mono: new rules for implication
+ZF/mono/Collect_mono: now for use with implication rules
+
+ZF/zf.ML/ballE': renamed rev_ballE
+
+ZF/list.thy,list.ML: files renamed list-fn.thy, list-fn.ML
+ZF/list.ML: new version simply holds the datatype definition
+NB THE LIST CONSTRUCTORS ARE NOW Nil/Cons, not 0/Pair.
+
+ZF/extend_ind.ML, datatype.ML: new files
+ZF/fin.ML: moved from ex/finite.ML
+
+23 July
+
+ZF/ex/sexp: deleted this example -- it seems hardly worth the trouble of
+porting.
+
+ZF/ex/bt.thy,bt.ML: files renamed bt-fn.thy, bt-fn.ML
+ZF/ex/bt.ML: new version simply holds the datatype definition
+
+ZF/ex/term.thy,term.ML: files renamed term-fn.thy, term-fn.ML
+ZF/ex/term.ML: new version simply holds the datatype definition
+
+ZF/sum/InlI,InrI: renamed from sum_InlI, sum_InlI
+
+26 July
+
+ZF/univ/rank_ss: new, for proving recursion equations
+
+ZF/domrange/image_iff,image_singleton_iff,vimage_iff,vimage_singleton_iff,
+field_of_prod:new
+
+ZF/domrange/field_subset: modified
+
+ZF/list/list_cases: no longer proved by induction!
+ZF/wf/wf_trancl: simplified proof
+
+ZF/equalities: new laws for field
+
+29 July
+
+ZF/trancl/trancl_induct: new
+ZF/trancl/rtrancl_induct,trancl_induct: now with more type information
+
+** More changes from Munich (Markus Wenzel) **
+
+Update of new syntax module (aka macro system): mostly internal cleanup and
+polishing;
+
+  Pure/Syntax/*
+    added Ast.stat_norm
+    added Syntax.print_gram, Syntax.print_trans, Syntax.print_syntax
+    cleaned type and Pure syntax: "_CLASSES" -> "classes", "_SORTS" -> "sorts",
+     "_==>" -> "==>", "_fun" -> "fun", added some space for printing
+    Printer: partial fix of the "PROP <aprop>" problem: print "PROP " before
+      any Var or Free of type propT
+    Syntax: added ndependent_tr, dependent_tr'
+
+  Pure/sign.ML: removed declaration of "==>" (now in Syntax.pure_sext)
+
+Changes to object logics: minor cleanups and replacement of most remaining ML
+translations by rewrite rules (see also file "Translations");
+
+  ZF/zf.thy
+    added "translations" section
+    removed all parse/print translations except ndependent_tr, dependent_tr'
+    fixed dependent_tr': all but one newly introduced frees have type dummyT
+    replaced id by idt in order to make terms rereadable if !show_types
+
+  Cube/cube.thy
+    removed necontext
+    replaced fun_tr/tr' by ndependent_tr/dependent_tr'
+
+  CTT/ctt.thy
+    added translations rules for PROD and SUM
+    removed dependent_tr
+    removed definitions of ndependent_tr, dependent_tr'
+
+  HOL/set.thy: replaced id by idt
+
+  CCL/ROOT.ML: Logtic -> Logic
+
+  CCL/set.thy
+    added "translations" section
+    removed "ML" section
+    replaced id by idt
+
+  CCL/types.thy
+    added "translations" section
+    removed definitions of ndependent_tr, dependent_tr'
+    replaced id by idt
+
+Yet another improvement of toplevel pretty printers: output now breakable;
+
+  Pure/NJ.ML Pure/POLY.ML improved make_pp
+
+  Pure/install_pp.ML: replaced str_of_* by pprint_*
+
+  Pure/drule.ML: replaced str_of_{sg,theory,thm} by pprint_*
+
+  Pure/sign.ML: replaced str_of_{term,typ,cterm,ctyp} by pprint_*
+
+  Pure/goals.ML: fixed and replaced str_of_{term,typ} by pprint_*
+
+  Pure/Syntax/pretty.ML: added pprint, quote
+
+Minor changes and additions;
+
+  Pure/sign.ML: renamed stamp "PURE" to "Pure"
+
+  Pure/library.ML
+    added quote: string -> string
+    added to_lower: string -> bool
+
+  Pure/NJ.ML,POLY.ML: added file_info of Carsten Clasohm
+
+30 July
+
+MAKE-ALL (Poly/ML) ran perfectly.
+
+Pure/goals/print_sign_exn: new, takes most code from print_exn
+Pure/goals/prove_goalw: displays exceptions using print_sign_exn
+
+Pure/drule/print_sg: now calls pretty_sg to agree with pprint_sg
+
+Pure/library,...: replaced front/nth_tail by take/drop.
+
+Pure/term/typ_tfrees,typ_tvars,term_tfrees,term_tvars: new
+thm/mk_rew_triple, drule/types_sorts, sign/zero_tvar_indices: now use the above
+
+Pure/logic/add_term_vars,add_term_frees,insert_aterm,atless:
+moved to term, joining similar functions for type variables;
+Logic.vars and Logic.frees are now term_vars and term_frees
+
+Pure/term/subst_free: new
+
+Pure/tactic/is_fact: newly exported
+
+Provers/simp/mk_congs: uses filter_out is_fact to delete trivial cong rules
+
+Pure/tactic/rename_last_tac: now uses Syntax.is_identifier instead of
+forall is_letdig
+
+**** New tar file 93.tar.gz placed on /homes/lcp (448K) **** 
+
+2 August
+
+MAKE-ALL (NJ 0.93) failed in ZF due to Compiler bug: elabDecl:open:FctBodyStr
+MAKE-ALL (Poly/ML) failed in ZF/enum.  It took 2:33 hours on albatross.
+
+Pure/drule/triv_forall_equality: new
+Pure/tactic/prune_params_tac: new
+
+Provers/hypsubst/bound_hyp_subst_tac: new, safer than hyp_subst_tac
+
+3 August
+
+Pure/tactic/rule_by_tactic: new
+
+ZF/perm/compEpair: now proved via rule_by_tactic
+
+ZF/extend_ind/cases,mk_cases: new
+ZF/datatype/mk_free: new
+ZF/list: now calls List.mk_cases
+
+4 August
+
+Provers/slow_tac,slow_best_tac: new
+
+5 August
+
+MAKE-ALL (Poly/ML) failed in ZF
+
+ZF/sum/sumE2: deleted since unused
+ZF/sum/sum_iff,sum_subset_iff,sum_equal_iff: new
+ZF/univ/Transset_Vfrom: new; used in proof of Transset_Vset
+
+6 August
+
+Pure/goals/prepare_proof: after "Additional hypotheses", now actually
+prints them!
+
+ZF/ordinal/Transset_Union_family, Transset_Inter_family: renamed from
+Transset_Union, Transset_Inter
+
+ZF/ordinal/Transset_Union: new 
+ZF/univ/pair_in_univ: renamed Pair_in_univ
+
+ZF/mono/product_mono: generalized to Sigma_mono; changed uses in trancl, univ
+
+ZF/lfp/lfp_Tarski,def_lfp_Tarski: renamed from Tarski,def_Tarski; changed
+uses in extend_ind.ML, nat.ML, trancl.ML.
+
+ZF/ex/misc: Schroeder-Bernstein Theorem moved here from lfp.ML
+
+ZF/fixedpt.thy,.ML: renamed from lfp.thy,.ML, and gfp added
+
+9 August
+
+ZF/zf.thy/ndependent_tr,dependent_tr': deleted, since they are now on
+Syntax/sextension. 
+
+11 August
+
+Pure/library.ML: added functions
+assocs: (''a * 'b list) list -> ''a -> 'b list
+transitive_closure: (''a * ''a list) list -> (''a * ''a list) list
+
+Pure/type.ML: deleted (inefficient) transitive_closure
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/expandshort	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,31 @@
+#! /bin/sh
+#
+#expandshort - shell script to expand shorthand goal commands
+#  ALSO contracts uses of resolve_tac, dresolve_tac, eresolve_tac,
+#     rewrite_goals_tac on 1-element lists
+#
+# Usage:
+#    expandshort FILE1 ... FILEn
+#
+#  leaves previous versions as XXX~~
+#
+for f in $*
+do
+echo Expanding shorthands in $f. \ Backup file is $f~~
+mv $f $f~~; sed -e '
+s/^ba \([0-9]*\); *$/by (assume_tac \1);/
+s/^br \(.*\) \([0-9]*\); *$/by (rtac \1 \2);/
+s/^brs \(.*\) \([0-9]*\); *$/by (resolve_tac \1 \2);/
+s/^bd \(.*\) \([0-9]*\); *$/by (dtac \1 \2);/
+s/^bds \(.*\) \([0-9]*\); *$/by (dresolve_tac \1 \2);/
+s/^be \(.*\) \([0-9]*\); *$/by (etac \1 \2);/
+s/^bes \(.*\) \([0-9]*\); *$/by (eresolve_tac \1 \2);/
+s/^bw \(.*\); *$/by (rewtac \1);/
+s/^bws \(.*\); *$/by (rewrite_goals_tac \1);/
+s/dresolve_tac *\[\([a-zA-Z0-9_]*\)\] */dtac \1 /g
+s/eresolve_tac *\[\([a-zA-Z0-9_]*\)\] */etac \1 /g
+s/resolve_tac *\[\([a-zA-Z0-9_]*\)\] */rtac \1 /g
+s/rewrite_goals_tac *\[\([a-zA-Z0-9_]*\)\]\( *\)/rewtac \1\2/g
+' $f~~ > $f
+done
+echo Finished.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/get-rulenames	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,20 @@
+#!/bin/sh
+#   Title: 	get-rulenames  (see also make-rulenames)
+#   Author: 	Larry Paulson, Cambridge University Computer Laboratory
+#   Copyright   1990  University of Cambridge
+#
+#shell script to generate "val" declarations for a theory's axioms 
+#  also generates a comma-separated list of axiom names
+#
+#  usage:  make-rulenames  <file>
+#
+#Rule lines begin with a line containing the word "extend_theory"
+#       and end   with a line containing the word "get_axiom"
+#Each rule name xyz must appear on a line that begins
+#        <spaces> ("xyz"
+#Output lines have the form
+#        val Eq_comp = ax"Eq_comp";
+#
+sed -n -e '/ext[end]*_theory/,/get_axiom/ s/^[ []*("\([^"]*\)".*$/val \1	= ax"\1";/p' $1
+echo
+echo `sed -n -e '/ext[end]*_theory/,/get_axiom/ s/^[ []*("\([^"]*\)".*$/\1/p' $1 | tr '\012' ','`
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/make-all	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,169 @@
+#! /bin/sh
+#
+#make-all: make all systems afresh
+
+# Creates gzipped log files called makeNNNN.log.gz on each subdirectory and
+# displays the last few lines of these files -- this indicates whether
+# the "make" failed (whether it terminated due to an error)
+
+# switches are
+#     -noforce	don't delete old databases/images first
+#     -clean	delete databases/images after use (leaving Pure)
+#     -notest	make databases/images w/o running the examples
+#     -noexec	don't execute, just check settings and Makefiles
+
+#Environment variables required:
+# ISABELLEBIN: the directory to hold Poly/ML databases or New Jersey ML images
+# ISABELLECOMP: the ML compiler
+
+# A typical shell script for /bin/sh is...
+# ML_DBASE=/usr/groups/theory/poly2.04/`arch`/ML_dbase
+# ISABELLEBIN=/homes/`whoami`/bin
+# ISABELLECOMP="poly -noDisplay"
+# export ML_DBASE ISABELLEBIN ISABELLECOMP 
+# nohup make-all $*
+
+set -e			#fail immediately upon errors
+
+# process command line switches
+CLEAN="off";
+FORCE="on";
+TEST="test";
+EXEC="on";
+NO="";
+for A in $*
+do
+	case $A in
+	-clean) CLEAN="on" ;;
+	-noforce) FORCE="off" ;;
+	-notest) TEST="" ;;
+	-noexec) EXEC="off"
+                 NO="-n" ;;
+	*)	echo "Bad flag for make-all: $A"
+		echo "Usage: make-all [-noforce] [-clean] [-notest] [-noexec]"
+		exit ;;
+	esac
+done
+
+echo Started at `date`
+echo Source=`pwd`
+echo Destination=${ISABELLEBIN?'No destination directory specified'}
+echo force=$FORCE '    ' clean=$CLEAN '    '
+echo Compiler=${ISABELLECOMP?'No compiler specified'} 
+echo Running on `hostname`
+echo Log files will be called make$$.log.gz
+
+case $FORCE.$EXEC in
+    on.on) (cd $ISABELLEBIN; rm -f Pure FOL ZF CCL LCF CTT LK Modal HOL Cube FOLP)
+esac
+
+echo
+echo
+echo '*****Pure Isabelle*****'
+(cd Pure; make $NO > make$$.log)
+tail Pure/make$$.log
+gzip Pure/make$$.log
+
+echo
+echo
+echo '*****First-Order Logic (FOL)*****'
+(cd FOL;  make $NO $TEST > make$$.log)
+tail FOL/make$$.log
+gzip FOL/make$$.log
+#cannot delete FOL yet... it is needed for ZF, CCL and LCF!
+
+echo
+echo
+echo '*****Set theory (ZF)*****'
+(cd ZF;  make $NO $TEST > make$$.log)
+tail ZF/make$$.log
+gzip ZF/make$$.log
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/ZF
+esac
+
+echo
+echo
+echo '*****Classical Computational Logic (CCL)*****'
+(cd CCL;  make $NO $TEST > make$$.log)
+tail CCL/make$$.log
+gzip CCL/make$$.log
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/CCL
+esac
+
+echo
+echo
+echo '*****Domain Theory (LCF)*****'
+(cd LCF;  make $NO $TEST > make$$.log)
+tail LCF/make$$.log
+gzip LCF/make$$.log
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/FOL $ISABELLEBIN/LCF
+esac
+
+echo
+echo
+echo '*****Constructive Type Theory (CTT)*****'
+(cd CTT;  make $NO $TEST > make$$.log)
+tail CTT/make$$.log
+gzip CTT/make$$.log
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/CTT
+esac
+
+echo
+echo
+echo '*****Classical Sequent Calculus (LK)*****'
+(cd LK;  make $NO $TEST > make$$.log)
+tail LK/make$$.log
+gzip LK/make$$.log
+#cannot delete LK yet... it is needed for Modal!
+
+echo
+echo
+echo '*****Modal logic (Modal)*****'
+(cd Modal;  make $NO $TEST > make$$.log)
+tail Modal/make$$.log
+gzip Modal/make$$.log
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/LK $ISABELLEBIN/Modal
+esac
+
+echo
+echo
+echo '*****Higher-Order Logic (HOL)*****'
+(cd HOL;  make $NO $TEST > make$$.log)
+tail HOL/make$$.log
+gzip HOL/make$$.log
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/HOL
+esac
+
+echo
+echo
+echo '*****The Lambda-Cube (Cube)*****'
+(cd Cube;  make $NO $TEST > make$$.log)
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/Cube
+esac
+tail Cube/make$$.log 
+gzip Cube/make$$.log 
+
+echo
+echo
+echo '*****First-Order Logic with Proof Terms (FOLP)*****'
+(cd FOLP;  make $NO $TEST > make$$.log)
+case $CLEAN.$EXEC in
+    on.on)	rm $ISABELLEBIN/FOLP
+esac
+tail FOLP/make$$.log 
+gzip FOLP/make$$.log 
+
+case $TEST.$EXEC in
+    test.on)	echo
+	        echo '***** Now check the dates on the "test" files *****'
+        	ls -lrt FOL/test ZF/test CCL/test LCF/test CTT/test\
+              	        LK/test Modal/test HOL/test Cube/test FOLP/test
+esac
+echo Finished at `date`
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/make-dist	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,21 @@
+#!/bin/sh
+#make-dist <DIR> 
+#make a distribution directory of Isabelle sources. Example:    
+#    rm -r /usr/groups/theory/isabelle/91
+#    make-dist /usr/groups/theory/isabelle/91
+
+#BEFORE MAKING A NEW DISTRIBUTION VERSION, CHECK...
+#   * that make-all works perfectly
+#   * that README files are up-to-date
+#   * that the version number has been updated
+
+#This version copies EVERYTHING!!!!!!!!!!!!!!!!
+
+set -e		#terminate if error
+
+#Pure Isabelle
+mkdir ${1?'No destination directory specified'}
+cp -ipr . $1
+
+#TO WRITE POLY/ML AND ISABELLE TAPES, USE SHELL SCRIPT write-dist
+#TO PACK FOR EMAIL, USE SHELL SCRIPTS make-emaildist, send-emaildist
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/make-rulenames	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,36 @@
+#!/bin/sh
+#   Title: 	make-rulenames
+#   Author: 	Larry Paulson, Cambridge University Computer Laboratory
+#   Copyright   1990  University of Cambridge
+#
+#shell script for adding signature and val declarations to a rules file
+#  usage:  make-rulenames <directory>
+#
+#Input is the file ruleshell.ML, which defines a theory.
+#Output is .rules.ML
+#
+#
+#Rule lines begin with a line containing the word "extend_theory"
+#       and end   with a line containing the word "get_axiom"
+#
+#Each rule name xyz must appear on a line that begins
+#           <spaces> ("xyz"
+# ENSURE THAT THE FIRST RULE LINE DOES NOT CONTAIN A "[" CHARACTER!
+#The file RULESIG gets lines like	val Eq_comp: thm
+#    These are inserted after the line containing the string INSERT-RULESIG
+#
+#The file RULENAMES gets lines like	val Eq_comp = ax"Eq_comp";
+#    These are inserted after the line containing the string INSERT-RULENAMES
+#The input file should define the function "ax" above this point.
+#
+set -eu		#terminate if error or unset variable
+if [ ! '(' -d $1 -a -f $1/ruleshell.ML ')' ]; \
+           then echo $1 is not a suitable directory; exit 1; \
+           fi
+sed -n -e '/extend_theory/,/get_axiom/ s/^ *("\([^"]*\)".*$/  val \1: thm/p' $1/ruleshell.ML > RULESIG
+sed -n -e '/extend_theory/,/get_axiom/ s/^ *("\([^"]*\)".*$/val \1 = ax"\1";/p' $1/ruleshell.ML > RULENAMES
+sed -e '/INSERT-RULESIG/ r RULESIG
+/INSERT-RULENAMES/ r RULENAMES' $1/ruleshell.ML > $1/.rules.ML
+#WARNING: there must be no spaces after the filename in the "r" command!!
+rm RULESIG RULENAMES
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/prove_goal.el	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,125 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; special function for Isabelle
+;;
+;;
+; goalify.el
+;
+; Emacs command to change "goal" proofs to "prove_goal" proofs 
+; and reverse IN A REGION.
+;    [would be difficult in "sed" since replacements involve multiple lines]
+;
+;; origin is prove_goalify.el
+;; enhanced by Franz Regensburger
+;;    corrected some errors in regular expressions
+;;    changed name prove_goalify --> goalify
+;;    added inverse functions        ungoalify
+;
+; function goalify:
+; 
+; val PAT = goalARGS;$
+; COMMANDS;$
+; val ID = result();
+; 
+; to
+; 
+; val ID = prove_goalARGS
+;  (fn PAT=>
+;  [
+;  COMMANDS
+;  ]);
+;;
+;; Note: PAT must be an identifier. _ as pattern is not supported.
+;;
+; function ungoalify:
+; 
+; val ID = prove_goalARGS
+;  (fn PAT=>
+;  [
+;  COMMANDS
+;  ]);
+;
+;
+; to 
+; val PAT = goalARGS;$
+; COMMANDS;$
+; val ID = result();
+; 
+
+
+(defun ungoalify (alpha omega)
+ "Change well-formed prove_goal proofs to goal...result"
+  (interactive "r"
+	       "*") 
+  ; 0: restrict editing to region
+  (narrow-to-region alpha omega)
+
+  ; 1: insert delimiter ID 
+  (goto-char (point-min))
+  (replace-regexp  
+  "[ \t]*val[ \t]+\\([^ \t\n=]+\\)[ \t\n=]+prove_goal" "\\1")
+
+  ; 2: insertt delimiter ARGS  PAT  and  before first command   
+  (goto-char (point-min))
+  (replace-regexp  
+  "[ \n\t]*(fn[ \t]+\\([^=]+\\)=>[^(]*" "\\1\n")
+
+  ; 3: shift  over all commands
+  ; Note: only one line per command
+  (goto-char (point-max))
+  (while (not (equal (point) (point-min)))
+    (goto-char (point-min))
+    (replace-regexp  
+    "[ \t]*\\(.*\\),[ \t]*\n" "by \\1;\n"))
+    
+  ; 4: fix last 
+  (goto-char (point-min))
+  (replace-regexp  
+    "[ \t]*\\(.*\\)[ \t\n]*\][ \t\n]*)[ \t\n]*;" "by \\1;")
+
+  ; 5: arange new val Pat = goal .. 
+  (goto-char (point-min))
+  (replace-regexp  
+  "\\([^]*\\)\\([^]*\\)\\([^]*\\)\n\\([^]*\\)"
+  "val \\3= goal\\2;\n\\4\nval \\1 = result();")
+
+  ; widen again
+  (widen)
+)
+
+
+(defun goalify (alpha omega)
+ "Change well-formed goal...result proofs to use prove_goal"
+  (interactive "r"
+               "*") 
+
+  ; 0: restrict editing to region
+  (narrow-to-region alpha omega)
+
+  ; 1: delimit the identifier in "val ID = result()" using ^Q
+  (goto-char (point-min))
+  (replace-regexp  "val[ \t\n]+\\([^ \t\n=]+\\)[ \t\n=]+result();[ \t]*$"
+   "\\1")
+
+  ; 2: replace terminal \";  by  
+  (goto-char (point-min))
+  (replace-regexp  "\";[ \t]*$" "")
+
+  ; 3: replace lines "by ...;" with "...,"
+  (goto-char (point-min))
+  (replace-regexp  "by[ \n\t]*\\([^;]*\\)[ \t\n]*;"  "\t\\1,")
+
+  ; 4: removing the extra commas, those followed by ^Q
+  (goto-char (point-min))
+  (replace-regexp  ",[ \n\t]*"  "")
+
+  ; 5: transforming goal... to prove_goal...
+  (goto-char (point-min))
+  (replace-regexp
+  "val[ \t\n]+\\([^ \n\t=]+\\)[ \t\n=]+goal\\([^]*\\)
+\\([^]*\\)\\([^]*\\)"  
+  "val \\4 = prove_goal\\2\"\n (fn \\1 =>\n\t[\n\\3\n\t]);")
+
+  ; 6: widen again
+  (widen)
+)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/rm-logfiles	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,7 @@
+#! /bin/sh
+#rm-logfiles: remove useless files from subdirectories
+rm log */make*.log */make*.log.gz */make*.log.z
+rm */test
+rm */.*.thy.ML
+rm */ex/.*.thy.ML
+rm HOL/Subst/.*.thy.ML
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/CCL.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,362 @@
+(*  Title: 	CCL/ccl
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For ccl.thy.
+*)
+
+open CCL;
+
+val ccl_data_defs = [apply_def,fix_def];
+
+(*** Simplifier for pre-order and equality ***)
+
+structure CCL_SimpData : SIMP_DATA =
+  struct
+  val refl_thms		= [refl, po_refl, iff_refl]
+  val trans_thms	= [trans, iff_trans, po_trans]
+  val red1		= iffD1
+  val red2		= iffD2
+  val mk_rew_rules	= mk_rew_rules
+  val case_splits	= []         (*NO IF'S!*)
+  val norm_thms		= norm_thms
+  val subst_thms	= [subst];
+  val dest_red		= dest_red
+  end;
+
+structure CCL_Simp = SimpFun(CCL_SimpData);
+open CCL_Simp;
+
+val auto_ss = empty_ss setauto (fn hyps => ares_tac (TrueI::hyps));
+
+val po_refl_iff_T = make_iff_T po_refl;
+
+val CCL_ss = auto_ss addcongs (FOL_congs @ set_congs)
+                     addrews  ([po_refl_iff_T] @ FOL_rews @ mem_rews);
+
+(*** Congruence Rules ***)
+
+(*similar to AP_THM in Gordon's HOL*)
+val fun_cong = prove_goal CCL.thy "(f::'a=>'b) = g ==> f(x)=g(x)"
+  (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
+
+(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
+val arg_cong = prove_goal CCL.thy "x=y ==> f(x)=f(y)"
+ (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
+
+goal CCL.thy  "(ALL x. f(x) = g(x)) --> (%x.f(x)) = (%x.g(x))";
+by (SIMP_TAC (CCL_ss addrews [eq_iff]) 1);
+by (fast_tac (set_cs addIs [po_abstractn]) 1);
+val abstractn = standard (allI RS (result() RS mp));
+
+fun type_of_terms (Const("Trueprop",_) $ 
+                   (Const("op =",(Type ("fun", [t,_]))) $ _ $ _)) = t;
+
+fun abs_prems thm = 
+   let fun do_abs n thm (Type ("fun", [_,t])) = do_abs n (abstractn RSN (n,thm)) t
+         | do_abs n thm _                     = thm
+       fun do_prems n      [] thm = thm
+         | do_prems n (x::xs) thm = do_prems (n+1) xs (do_abs n thm (type_of_terms x));
+   in do_prems 1 (prems_of thm) thm
+   end;
+
+fun ccl_mk_congs thy cs = map abs_prems (mk_congs thy cs); 
+
+val ccl_congs = ccl_mk_congs CCL.thy 
+ ["op [=","SIM","POgen","EQgen","pair","lambda","case","op `","fix"];
+
+val caseBs = [caseBtrue,caseBfalse,caseBpair,caseBlam,caseBbot];
+
+(*** Termination and Divergence ***)
+
+goalw CCL.thy [Trm_def,Dvg_def] "Trm(t) <-> ~ t = bot";
+br iff_refl 1;
+val Trm_iff = result();
+
+goalw CCL.thy [Trm_def,Dvg_def] "Dvg(t) <-> t = bot";
+br iff_refl 1;
+val Dvg_iff = result();
+
+(*** Constructors are injective ***)
+
+val prems = goal CCL.thy
+    "[| x=a;  y=b;  x=y |] ==> a=b";
+by  (REPEAT (SOMEGOAL (ares_tac (prems@[box_equals]))));
+val eq_lemma = result();
+
+fun mk_inj_rl thy rews congs s = 
+      let fun mk_inj_lemmas r = ([arg_cong] RL [(r RS (r RS eq_lemma))]);
+          val inj_lemmas = flat (map mk_inj_lemmas rews);
+          val tac = REPEAT (ares_tac [iffI,allI,conjI] 1 ORELSE
+                            eresolve_tac inj_lemmas 1 ORELSE
+                            ASM_SIMP_TAC (CCL_ss addrews rews 
+                                                 addcongs congs) 1)
+      in prove_goal thy s (fn _ => [tac])
+      end;
+
+val ccl_injs = map (mk_inj_rl CCL.thy caseBs ccl_congs)
+               ["<a,b> = <a',b'> <-> (a=a' & b=b')",
+                "(lam x.b(x) = lam x.b'(x)) <-> ((ALL z.b(z)=b'(z)))"];
+
+val pair_inject = ((hd ccl_injs) RS iffD1) RS conjE;
+
+(*** Constructors are distinct ***)
+
+local
+  fun pairs_of f x [] = []
+    | pairs_of f x (y::ys) = (f x y) :: (f y x) :: (pairs_of f x ys);
+
+  fun mk_combs ff [] = []
+    | mk_combs ff (x::xs) = (pairs_of ff x xs) @ mk_combs ff xs;
+
+(* Doesn't handle binder types correctly *)
+  fun saturate thy sy name = 
+       let fun arg_str 0 a s = s
+         | arg_str 1 a s = "(" ^ a ^ "a" ^ s ^ ")"
+         | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s);
+           val sg = sign_of thy;
+           val T = case Sign.Symtab.lookup(#const_tab(Sign.rep_sg sg),sy) of
+  		            None => error(sy^" not declared") | Some(T) => T;
+           val arity = length (fst (strip_type T));
+       in sy ^ (arg_str arity name "") end;
+
+  fun mk_thm_str thy a b = "~ " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b");
+
+  val lemma = prove_goal CCL.thy "t=t' --> case(t,b,c,d,e) = case(t',b,c,d,e)"
+                   (fn _ => [SIMP_TAC (CCL_ss addcongs ccl_congs) 1]) RS mp;
+  fun mk_lemma (ra,rb) = [lemma] RL [ra RS (rb RS eq_lemma)] RL 
+                           [distinctness RS notE,sym RS (distinctness RS notE)];
+in
+  fun mk_lemmas rls = flat (map mk_lemma (mk_combs pair rls));
+  fun mk_dstnct_rls thy xs = mk_combs (mk_thm_str thy) xs;
+end;
+
+
+val caseB_lemmas = mk_lemmas caseBs;
+
+val ccl_dstncts = 
+        let fun mk_raw_dstnct_thm rls s = 
+                  prove_goal CCL.thy s (fn _=> [rtac notI 1,eresolve_tac rls 1])
+        in map (mk_raw_dstnct_thm caseB_lemmas) 
+                (mk_dstnct_rls CCL.thy ["bot","true","false","pair","lambda"]) end;
+
+fun mk_dstnct_thms thy defs inj_rls xs = 
+          let fun mk_dstnct_thm rls s = prove_goalw thy defs s 
+                               (fn _ => [SIMP_TAC (CCL_ss addrews (rls@inj_rls)) 1])
+          in map (mk_dstnct_thm ccl_dstncts) (mk_dstnct_rls thy xs) end;
+
+fun mkall_dstnct_thms thy defs i_rls xss = flat (map (mk_dstnct_thms thy defs i_rls) xss);
+
+(*** Rewriting and Proving ***)
+
+fun XH_to_I rl = rl RS iffD2;
+fun XH_to_D rl = rl RS iffD1;
+val XH_to_E = make_elim o XH_to_D;
+val XH_to_Is = map XH_to_I;
+val XH_to_Ds = map XH_to_D;
+val XH_to_Es = map XH_to_E;
+
+val ccl_rews = caseBs @ ccl_injs @ ccl_dstncts;
+val ccl_ss = CCL_ss addrews ccl_rews addcongs ccl_congs;
+
+val ccl_cs = set_cs addSEs (pair_inject::(ccl_dstncts RL [notE])) 
+                    addSDs (XH_to_Ds ccl_injs);
+
+(****** Facts from gfp Definition of [= and = ******)
+
+val major::prems = goal Set.thy "[| A=B;  a:B <-> P |] ==> a:A <-> P";
+brs (prems RL [major RS ssubst]) 1;
+val XHlemma1 = result();
+
+goal CCL.thy "(P(t,t') <-> Q) --> (<t,t'> : {p.EX t t'.p=<t,t'> &  P(t,t')} <-> Q)";
+by (fast_tac ccl_cs 1);
+val XHlemma2 = result() RS mp;
+
+(*** Pre-Order ***)
+
+goalw CCL.thy [POgen_def,SIM_def]  "mono(%X.POgen(X))";
+br monoI 1;
+by (safe_tac ccl_cs);
+by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
+by (ALLGOALS (SIMP_TAC ccl_ss));
+by (ALLGOALS (fast_tac set_cs));
+val POgen_mono = result();
+
+goalw CCL.thy [POgen_def,SIM_def]
+  "<t,t'> : POgen(R) <-> t= bot | (t=true & t'=true)  | (t=false & t'=false) | \
+\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
+\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
+br (iff_refl RS XHlemma2) 1;
+val POgenXH = result();
+
+goal CCL.thy
+  "t [= t' <-> t=bot | (t=true & t'=true) | (t=false & t'=false) | \
+\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a [= a' & b [= b') | \
+\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x) [= f'(x)))";
+by (SIMP_TAC (ccl_ss addrews [PO_iff]) 1);
+br (rewrite_rule [POgen_def,SIM_def] 
+                 (POgen_mono RS (PO_def RS def_gfp_Tarski) RS XHlemma1)) 1;
+br (iff_refl RS XHlemma2) 1;
+val poXH = result();
+
+goal CCL.thy "bot [= b";
+br (poXH RS iffD2) 1;
+by (SIMP_TAC ccl_ss 1);
+val po_bot = result();
+
+goal CCL.thy "a [= bot --> a=bot";
+br impI 1;
+bd (poXH RS iffD1) 1;
+be rev_mp 1;
+by (SIMP_TAC ccl_ss 1);
+val bot_poleast = result() RS mp;
+
+goal CCL.thy "<a,b> [= <a',b'> <->  a [= a' & b [= b'";
+br (poXH RS iff_trans) 1;
+by (SIMP_TAC ccl_ss 1);
+by (fast_tac ccl_cs 1);
+val po_pair = result();
+
+goal CCL.thy "lam x.f(x) [= lam x.f'(x) <-> (ALL x. f(x) [= f'(x))";
+br (poXH RS iff_trans) 1;
+by (SIMP_TAC ccl_ss 1);
+by (REPEAT (ares_tac [iffI,allI] 1 ORELSE eresolve_tac [exE,conjE] 1));
+by (ASM_SIMP_TAC ccl_ss 1);
+by (fast_tac ccl_cs 1);
+val po_lam = result();
+
+val ccl_porews = [po_bot,po_pair,po_lam];
+
+val [p1,p2,p3,p4,p5] = goal CCL.thy
+    "[| t [= t';  a [= a';  b [= b';  !!x y.c(x,y) [= c'(x,y); \
+\       !!u.d(u) [= d'(u) |] ==> case(t,a,b,c,d) [= case(t',a',b',c',d')";
+br (p1 RS po_cong RS po_trans) 1;
+br (p2 RS po_cong RS po_trans) 1;
+br (p3 RS po_cong RS po_trans) 1;
+br (p4 RS po_abstractn RS po_abstractn RS po_cong RS po_trans) 1;
+by (res_inst_tac [("f1","%d.case(t',a',b',c',d)")] 
+               (p5 RS po_abstractn RS po_cong RS po_trans) 1);
+br po_refl 1;
+val case_pocong = result();
+
+val [p1,p2] = goalw CCL.thy ccl_data_defs
+    "[| f [= f';  a [= a' |] ==> f ` a [= f' ` a'";
+by (REPEAT (ares_tac [po_refl,case_pocong,p1,p2 RS po_cong] 1));
+val apply_pocong = result();
+
+
+val prems = goal CCL.thy "~ lam x.b(x) [= bot";
+br notI 1;
+bd bot_poleast 1;
+be (distinctness RS notE) 1;
+val npo_lam_bot = result();
+
+val eq1::eq2::prems = goal CCL.thy
+    "[| x=a;  y=b;  x[=y |] ==> a[=b";
+br (eq1 RS subst) 1;
+br (eq2 RS subst) 1;
+brs prems 1;
+val po_lemma = result();
+
+goal CCL.thy "~ <a,b> [= lam x.f(x)";
+br notI 1;
+br (npo_lam_bot RS notE) 1;
+be (case_pocong RS (caseBlam RS (caseBpair RS po_lemma))) 1;
+by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
+val npo_pair_lam = result();
+
+goal CCL.thy "~ lam x.f(x) [= <a,b>";
+br notI 1;
+br (npo_lam_bot RS notE) 1;
+be (case_pocong RS (caseBpair RS (caseBlam RS po_lemma))) 1;
+by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
+val npo_lam_pair = result();
+
+fun mk_thm s = prove_goal CCL.thy s (fn _ => 
+                          [rtac notI 1,dtac case_pocong 1,etac rev_mp 5,
+                           ALLGOALS (SIMP_TAC ccl_ss),
+                           REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)]);
+
+val npo_rls = [npo_pair_lam,npo_lam_pair] @ map mk_thm
+            ["~ true [= false",          "~ false [= true",
+             "~ true [= <a,b>",          "~ <a,b> [= true",
+             "~ true [= lam x.f(x)","~ lam x.f(x) [= true",
+            "~ false [= <a,b>",          "~ <a,b> [= false",
+            "~ false [= lam x.f(x)","~ lam x.f(x) [= false"];
+
+(* Coinduction for [= *)
+
+val prems = goal CCL.thy "[|  <t,u> : R;  R <= POgen(R) |] ==> t [= u";
+br (PO_def RS def_coinduct RS (PO_iff RS iffD2)) 1;
+by (REPEAT (ares_tac prems 1));
+val po_coinduct = result();
+
+fun po_coinduct_tac s i = res_inst_tac [("R",s)] po_coinduct i;
+
+(*************** EQUALITY *******************)
+
+goalw CCL.thy [EQgen_def,SIM_def]  "mono(%X.EQgen(X))";
+br monoI 1;
+by (safe_tac set_cs);
+by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
+by (ALLGOALS (SIMP_TAC ccl_ss));
+by (ALLGOALS (fast_tac set_cs));
+val EQgen_mono = result();
+
+goalw CCL.thy [EQgen_def,SIM_def]
+  "<t,t'> : EQgen(R) <-> (t=bot & t'=bot)  | (t=true & t'=true)  | \
+\                                            (t=false & t'=false) | \
+\                (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
+\                (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
+br (iff_refl RS XHlemma2) 1;
+val EQgenXH = result();
+
+goal CCL.thy
+  "t=t' <-> (t=bot & t'=bot)  | (t=true & t'=true)  | (t=false & t'=false) | \
+\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a=a' & b=b') | \
+\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x)=f'(x)))";
+by (subgoal_tac
+  "<t,t'> : EQ <-> (t=bot & t'=bot)  | (t=true & t'=true) | (t=false & t'=false) | \
+\             (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : EQ & <b,b'> : EQ) | \
+\             (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : EQ))" 1);
+be rev_mp 1;
+by (SIMP_TAC (CCL_ss addrews [EQ_iff RS iff_sym]) 1);
+br (rewrite_rule [EQgen_def,SIM_def]
+                 (EQgen_mono RS (EQ_def RS def_gfp_Tarski) RS XHlemma1)) 1;
+br (iff_refl RS XHlemma2) 1;
+val eqXH = result();
+
+val prems = goal CCL.thy "[|  <t,u> : R;  R <= EQgen(R) |] ==> t = u";
+br (EQ_def RS def_coinduct RS (EQ_iff RS iffD2)) 1;
+by (REPEAT (ares_tac prems 1));
+val eq_coinduct = result();
+
+val prems = goal CCL.thy 
+    "[|  <t,u> : R;  R <= EQgen(lfp(%x.EQgen(x) Un R Un EQ)) |] ==> t = u";
+br (EQ_def RS def_coinduct3 RS (EQ_iff RS iffD2)) 1;
+by (REPEAT (ares_tac (EQgen_mono::prems) 1));
+val eq_coinduct3 = result();
+
+fun eq_coinduct_tac s i = res_inst_tac [("R",s)] eq_coinduct i;
+fun eq_coinduct3_tac s i = res_inst_tac [("R",s)] eq_coinduct3 i;
+
+(*** Untyped Case Analysis and Other Facts ***)
+
+goalw CCL.thy [apply_def]  "(EX f.t=lam x.f(x)) --> t = lam x.(t ` x)";
+by (safe_tac ccl_cs);
+by (SIMP_TAC ccl_ss 1);
+val cond_eta = result() RS mp;
+
+goal CCL.thy "(t=bot) | (t=true) | (t=false) | (EX a b.t=<a,b>) | (EX f.t=lam x.f(x))";
+by (cut_facts_tac [refl RS (eqXH RS iffD1)] 1);
+by (fast_tac set_cs 1);
+val exhaustion = result();
+
+val prems = goal CCL.thy 
+    "[| P(bot);  P(true);  P(false);  !!x y.P(<x,y>);  !!b.P(lam x.b(x)) |] ==> P(t)";
+by (cut_facts_tac [exhaustion] 1);
+by (REPEAT_SOME (ares_tac prems ORELSE' eresolve_tac [disjE,exE,ssubst]));
+val term_case = result();
+
+fun term_case_tac a i = res_inst_tac [("t",a)] term_case i;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/CCL.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,148 @@
+(*  Title: 	CCL/ccl.thy
+    ID:         $Id$
+    Author: 	Martin Coen
+    Copyright   1993  University of Cambridge
+
+Classical Computational Logic for Untyped Lambda Calculus with reduction to 
+weak head-normal form.
+
+Based on FOL extended with set collection, a primitive higher-order logic.
+HOL is too strong - descriptions prevent a type of programs being defined
+which contains only executable terms.
+*)
+
+CCL = Gfp +
+
+classes prog < term
+
+default prog
+
+types i 0
+
+arities 
+      i          :: prog
+      fun        :: (prog,prog)prog
+
+consts
+  (*** Evaluation Judgement ***)
+  "--->"      ::       "[i,i]=>prop"          (infixl 20)
+
+  (*** Bisimulations for pre-order and equality ***)
+  "[="        ::       "['a,'a]=>o"           (infixl 50)
+  SIM         ::       "[i,i,i set]=>o"
+  POgen,EQgen ::       "i set => i set"
+  PO,EQ       ::       "i set"
+
+  (*** Term Formers ***)
+  true,false  ::       "i"
+  pair        ::       "[i,i]=>i"             ("(1<_,/_>)")
+  lambda      ::       "(i=>i)=>i"            (binder "lam " 55)
+  case        ::       "[i,i,i,[i,i]=>i,(i=>i)=>i]=>i"
+  "`"         ::       "[i,i]=>i"             (infixl 56)
+  bot         ::       "i"
+  fix         ::       "(i=>i)=>i"
+
+  (*** Defined Predicates ***)
+  Trm,Dvg     ::       "i => o"
+
+rules
+
+  (******* EVALUATION SEMANTICS *******)
+
+  (**  This is the evaluation semantics from which the axioms below were derived.  **)
+  (**  It is included here just as an evaluator for FUN and has no influence on    **)
+  (**  inference in the theory CCL.                                                **)
+
+  trueV       "true ---> true"
+  falseV      "false ---> false"
+  pairV       "<a,b> ---> <a,b>"
+  lamV        "lam x.b(x) ---> lam x.b(x)"
+  caseVtrue   "[| t ---> true;  d ---> c |] ==> case(t,d,e,f,g) ---> c"
+  caseVfalse  "[| t ---> false;  e ---> c |] ==> case(t,d,e,f,g) ---> c"
+  caseVpair   "[| t ---> <a,b>;  f(a,b) ---> c |] ==> case(t,d,e,f,g) ---> c"
+  caseVlam    "[| t ---> lam x.b(x);  g(b) ---> c |] ==> case(t,d,e,f,g) ---> c"
+
+  (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***)
+
+  canonical  "[| t ---> c; c==true ==> u--->v; \
+\                          c==false ==> u--->v; \
+\                    !!a b.c==<a,b> ==> u--->v; \
+\                      !!f.c==lam x.f(x) ==> u--->v |] ==> \
+\             u--->v"
+
+  (* Should be derivable - but probably a bitch! *)
+  substitute "[| a==a'; t(a)--->c(a) |] ==> t(a')--->c(a')"
+
+  (************** LOGIC ***************)
+
+  (*** Definitions used in the following rules ***)
+
+  apply_def     "f ` t == case(f,bot,bot,%x y.bot,%u.u(t))"
+  bot_def         "bot == (lam x.x`x)`(lam x.x`x)"
+  fix_def      "fix(f) == (lam x.f(x`x))`(lam x.f(x`x))"
+
+  (*  The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *)
+  (*  as a bisimulation.  They can both be expressed as (bi)simulations up to        *)
+  (*  behavioural equivalence (ie the relations PO and EQ defined below).            *)
+
+  SIM_def
+  "SIM(t,t',R) ==  (t=true & t'=true) | (t=false & t'=false) | \
+\                  (EX a a' b b'.t=<a,b> & t'=<a',b'> & <a,a'> : R & <b,b'> : R) | \
+\                  (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))"
+
+  POgen_def  "POgen(R) == {p. EX t t'. p=<t,t'> & (t = bot | SIM(t,t',R))}"
+  EQgen_def  "EQgen(R) == {p. EX t t'. p=<t,t'> & (t = bot & t' = bot | SIM(t,t',R))}"
+
+  PO_def    "PO == gfp(POgen)"
+  EQ_def    "EQ == gfp(EQgen)"
+
+  (*** Rules ***)
+
+  (** Partial Order **)
+
+  po_refl        "a [= a"
+  po_trans       "[| a [= b;  b [= c |] ==> a [= c"
+  po_cong        "a [= b ==> f(a) [= f(b)"
+
+  (* Extend definition of [= to program fragments of higher type *)
+  po_abstractn   "(!!x. f(x) [= g(x)) ==> (%x.f(x)) [= (%x.g(x))"
+
+  (** Equality - equivalence axioms inherited from FOL.thy   **)
+  (**          - congruence of "=" is axiomatised implicitly **)
+
+  eq_iff         "t = t' <-> t [= t' & t' [= t"
+
+  (** Properties of canonical values given by greatest fixed point definitions **)
+ 
+  PO_iff         "t [= t' <-> <t,t'> : PO"
+  EQ_iff         "t =  t' <-> <t,t'> : EQ"
+
+  (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **)
+
+  caseBtrue            "case(true,d,e,f,g) = d"
+  caseBfalse          "case(false,d,e,f,g) = e"
+  caseBpair           "case(<a,b>,d,e,f,g) = f(a,b)"
+  caseBlam       "case(lam x.b(x),d,e,f,g) = g(b)"
+  caseBbot              "case(bot,d,e,f,g) = bot"            (* strictness *)
+
+  (** The theory is non-trivial **)
+  distinctness   "~ lam x.b(x) = bot"
+
+  (*** Definitions of Termination and Divergence ***)
+
+  Dvg_def  "Dvg(t) == t = bot"
+  Trm_def  "Trm(t) == ~ Dvg(t)"
+
+end
+
+
+(*
+Would be interesting to build a similar theory for a typed programming language:
+    ie.     true :: bool,      fix :: ('a=>'a)=>'a  etc......
+
+This is starting to look like LCF.
+What are the advantages of this approach?   
+        - less axiomatic                                            
+        - wfd induction / coinduction and fixed point induction available
+           
+*)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Fix.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,202 @@
+(*  Title: 	CCL/fix
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For fix.thy.
+*)
+
+open Fix;
+
+val prems = goalw Fix.thy [INCL_def]
+     "[| !!x.P(x) <-> Q(x) |] ==> INCL(%x.P(x)) <-> INCL(%x.Q(x))";
+by (REPEAT (ares_tac ([refl] @ FOL_congs @ set_congs @ prems) 1));
+val INCL_cong = result();
+
+val fix_congs = [INCL_cong] @ ccl_mk_congs Fix.thy ["napply"];
+
+(*** Fixed Point Induction ***)
+
+val [base,step,incl] = goalw Fix.thy [INCL_def]
+    "[| P(bot);  !!x.P(x) ==> P(f(x));  INCL(P) |] ==> P(fix(f))";
+br (incl RS spec RS mp) 1;
+by (rtac (Nat_ind RS ballI) 1 THEN atac 1);
+by (ALLGOALS (SIMP_TAC term_ss));
+by (REPEAT (ares_tac [base,step] 1));
+val fix_ind = result();
+
+(*** Inclusive Predicates ***)
+
+val prems = goalw Fix.thy [INCL_def]
+     "INCL(P) <-> (ALL f. (ALL n:Nat. P(f ^ n ` bot)) --> P(fix(f)))";
+br iff_refl 1;
+val inclXH = result();
+
+val prems = goal Fix.thy
+     "[| !!f.ALL n:Nat.P(f^n`bot) ==> P(fix(f)) |] ==> INCL(%x.P(x))";
+by (fast_tac (term_cs addIs (prems @ [XH_to_I inclXH])) 1);
+val inclI = result();
+
+val incl::prems = goal Fix.thy
+     "[| INCL(P);  !!n.n:Nat ==> P(f^n`bot) |] ==> P(fix(f))";
+by (fast_tac (term_cs addIs ([ballI RS (incl RS (XH_to_D inclXH) RS spec RS mp)] 
+                       @ prems)) 1);
+val inclD = result();
+
+val incl::prems = goal Fix.thy
+     "[| INCL(P);  (ALL n:Nat.P(f^n`bot))-->P(fix(f)) ==> R |] ==> R";
+by (fast_tac (term_cs addIs ([incl RS inclD] @ prems)) 1);
+val inclE = result();
+
+val fix_ss = term_ss addcongs fix_congs;
+
+(*** Lemmas for Inclusive Predicates ***)
+
+goal Fix.thy "INCL(%x.~ a(x) [= t)";
+br inclI 1;
+bd bspec 1;
+br zeroT 1;
+be contrapos 1;
+br po_trans 1;
+ba 2;
+br (napplyBzero RS ssubst) 1;
+by (rtac po_cong 1 THEN rtac po_bot 1);
+val npo_INCL = result();
+
+val prems = goal Fix.thy "[| INCL(P);  INCL(Q) |] ==> INCL(%x.P(x) & Q(x))";
+by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
+val conj_INCL = result();
+
+val prems = goal Fix.thy "[| !!a.INCL(P(a)) |] ==> INCL(%x.ALL a.P(a,x))";
+by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
+val all_INCL = result();
+
+val prems = goal Fix.thy "[| !!a.a:A ==> INCL(P(a)) |] ==> INCL(%x.ALL a:A.P(a,x))";
+by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
+val ball_INCL = result();
+
+goal Fix.thy "INCL(%x.a(x) = b(x)::'a::prog)";
+by (SIMP_TAC (fix_ss addrews [eq_iff]) 1);
+by (REPEAT (resolve_tac [conj_INCL,po_INCL] 1));
+val eq_INCL = result();
+
+(*** Derivation of Reachability Condition ***)
+
+(* Fixed points of idgen *)
+
+goal Fix.thy "idgen(fix(idgen)) = fix(idgen)";
+br (fixB RS sym) 1;
+val fix_idgenfp = result();
+
+goalw Fix.thy [idgen_def] "idgen(lam x.x) = lam x.x";
+by (SIMP_TAC term_ss 1);
+br (term_case RS allI) 1;
+by (ALLGOALS (SIMP_TAC term_ss));
+val id_idgenfp = result();
+
+(* All fixed points are lam-expressions *)
+
+val [prem] = goal Fix.thy "idgen(d) = d ==> d = lam x.?f(x)";
+br (prem RS subst) 1;
+bw idgen_def;
+br refl 1;
+val idgenfp_lam = result();
+
+(* Lemmas for rewriting fixed points of idgen *)
+
+val prems = goalw Fix.thy [idgen_def] 
+    "[| a = b;  a ` t = u |] ==> b ` t = u";
+by (SIMP_TAC (term_ss addrews (prems RL [sym])) 1);
+val l_lemma= result();
+
+val idgen_lemmas =
+    let fun mk_thm s = prove_goalw Fix.thy [idgen_def] s
+           (fn [prem] => [rtac (prem RS l_lemma) 1,SIMP_TAC term_ss 1])
+    in map mk_thm
+          [    "idgen(d) = d ==> d ` bot = bot",
+               "idgen(d) = d ==> d ` true = true",
+               "idgen(d) = d ==> d ` false = false",
+               "idgen(d) = d ==> d ` <a,b> = <d ` a,d ` b>",
+               "idgen(d) = d ==> d ` (lam x.f(x)) = lam x.d ` f(x)"]
+    end;
+
+(* Proof of Reachability law - show that fix and lam x.x both give LEAST fixed points 
+                               of idgen and hence are they same *)
+
+val [p1,p2,p3] = goal CCL.thy
+    "[| ALL x.t ` x [= u ` x;  EX f.t=lam x.f(x);  EX f.u=lam x.f(x) |] ==> t [= u";
+br (p2 RS cond_eta RS ssubst) 1;
+br (p3 RS cond_eta RS ssubst) 1;
+br (p1 RS (po_lam RS iffD2)) 1;
+val po_eta = result();
+
+val [prem] = goalw Fix.thy [idgen_def] "idgen(d) = d ==> d = lam x.?f(x)";
+br (prem RS subst) 1;
+br refl 1;
+val po_eta_lemma = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> \
+\      {p.EX a b.p=<a,b> & (EX t.a=fix(idgen) ` t & b = d ` t)} <=   \
+\      POgen({p.EX a b.p=<a,b> & (EX t.a=fix(idgen) ` t  & b = d ` t)})";
+by (REPEAT (step_tac term_cs 1));
+by (term_case_tac "t" 1);
+by (ALLGOALS (SIMP_TAC (term_ss addrews (POgenXH::([prem,fix_idgenfp] RL idgen_lemmas)))));
+by (ALLGOALS (fast_tac set_cs));
+val lemma1 = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> fix(idgen) [= d";
+br (allI RS po_eta) 1;
+br (lemma1 RSN(2,po_coinduct)) 1;
+by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp])));
+val fix_least_idgen = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> \
+\      {p.EX a b.p=<a,b> & b = d ` a} <= POgen({p.EX a b.p=<a,b> & b = d ` a})";
+by (REPEAT (step_tac term_cs 1));
+by (term_case_tac "a" 1);
+by (ALLGOALS (SIMP_TAC (term_ss addrews (POgenXH::([prem] RL idgen_lemmas)))));
+by (ALLGOALS (fast_tac set_cs));
+val lemma2 = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> lam x.x [= d";
+br (allI RS po_eta) 1;
+br (lemma2 RSN(2,po_coinduct)) 1;
+by (SIMP_TAC term_ss 1);
+by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp])));
+val id_least_idgen = result();
+
+goal Fix.thy  "fix(idgen) = lam x.x";
+by (fast_tac (term_cs addIs [eq_iff RS iffD2,
+                             id_idgenfp RS fix_least_idgen,
+                             fix_idgenfp RS id_least_idgen]) 1);
+val reachability = result();
+
+(********)
+
+val [prem] = goal Fix.thy "f = lam x.x ==> f`t = t";
+br (prem RS sym RS subst) 1;
+br applyB 1;
+val id_apply = result();
+
+val prems = goal Fix.thy
+     "[| P(bot);  P(true);  P(false);  \
+\        !!x y.[| P(x);  P(y) |] ==> P(<x,y>);  \
+\        !!u.(!!x.P(u(x))) ==> P(lam x.u(x));  INCL(P) |] ==> \
+\     P(t)";
+br (reachability RS id_apply RS subst) 1;
+by (res_inst_tac [("x","t")] spec 1);
+br fix_ind 1;
+bw idgen_def;
+by (REPEAT_SOME (ares_tac [allI]));
+br (applyBbot RS ssubst) 1;
+brs prems 1;
+br (applyB RS ssubst )1;
+by (res_inst_tac [("t","xa")] term_case 1);
+by (ALLGOALS (SIMP_TAC term_ss));
+by (ALLGOALS (fast_tac (term_cs addIs ([all_INCL,INCL_subst] @ prems))));
+val term_ind = result();
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Fix.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,26 @@
+(*  Title: 	CCL/Lazy/fix.thy
+    ID:         $Id$
+    Author: 	Martin Coen
+    Copyright   1993  University of Cambridge
+
+Tentative attempt at including fixed point induction.
+Justified by Smith.
+*)
+
+Fix = Type + 
+
+consts
+
+  idgen      ::	      "[i]=>i"
+  INCL      :: "[i=>o]=>o"
+
+rules
+
+  idgen_def
+  "idgen(f) == lam t.case(t,true,false,%x y.<f`x, f`y>,%u.lam x.f ` u(x))"
+
+  INCL_def   "INCL(%x.P(x)) == (ALL f.(ALL n:Nat.P(f^n`bot)) --> P(fix(f)))"
+  po_INCL    "INCL(%x.a(x) [= b(x))"
+  INCL_subst "INCL(P) ==> INCL(%x.P((g::i=>i)(x)))"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Gfp.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,133 @@
+(*  Title: 	CCL/gfp
+    ID:         $Id$
+
+Modified version of
+    Title: 	HOL/gfp
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For gfp.thy.  The Knaster-Tarski Theorem for greatest fixed points.
+*)
+
+open Gfp;
+
+(*** Proof of Knaster-Tarski Theorem using gfp ***)
+
+(* gfp(f) is the least upper bound of {u. u <= f(u)} *)
+
+val prems = goalw Gfp.thy [gfp_def] "[| A <= f(A) |] ==> A <= gfp(f)";
+by (rtac (CollectI RS Union_upper) 1);
+by (resolve_tac prems 1);
+val gfp_upperbound = result();
+
+val prems = goalw Gfp.thy [gfp_def]
+    "[| !!u. u <= f(u) ==> u<=A |] ==> gfp(f) <= A";
+by (REPEAT (ares_tac ([Union_least]@prems) 1));
+by (etac CollectD 1);
+val gfp_least = result();
+
+val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) <= f(gfp(f))";
+by (EVERY1 [rtac gfp_least, rtac subset_trans, atac,
+	    rtac (mono RS monoD), rtac gfp_upperbound, atac]);
+val gfp_lemma2 = result();
+
+val [mono] = goal Gfp.thy "mono(f) ==> f(gfp(f)) <= gfp(f)";
+by (EVERY1 [rtac gfp_upperbound, rtac (mono RS monoD), 
+	    rtac gfp_lemma2, rtac mono]);
+val gfp_lemma3 = result();
+
+val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) = f(gfp(f))";
+by (REPEAT (resolve_tac [equalityI,gfp_lemma2,gfp_lemma3,mono] 1));
+val gfp_Tarski = result();
+
+(*** Coinduction rules for greatest fixed points ***)
+
+(*weak version*)
+val prems = goal Gfp.thy
+    "[| a: A;  A <= f(A) |] ==> a : gfp(f)";
+by (rtac (gfp_upperbound RS subsetD) 1);
+by (REPEAT (ares_tac prems 1));
+val coinduct = result();
+
+val [prem,mono] = goal Gfp.thy
+    "[| A <= f(A) Un gfp(f);  mono(f) |] ==>  \
+\    A Un gfp(f) <= f(A Un gfp(f))";
+by (rtac subset_trans 1);
+by (rtac (mono RS mono_Un) 2);
+by (rtac (mono RS gfp_Tarski RS subst) 1);
+by (rtac (prem RS Un_least) 1);
+by (rtac Un_upper2 1);
+val coinduct2_lemma = result();
+
+(*strong version, thanks to Martin Coen*)
+val prems = goal Gfp.thy
+    "[| a: A;  A <= f(A) Un gfp(f);  mono(f) |] ==> a : gfp(f)";
+by (rtac (coinduct2_lemma RSN (2,coinduct)) 1);
+by (REPEAT (resolve_tac (prems@[UnI1]) 1));
+val coinduct2 = result();
+
+(***  Even Stronger version of coinduct  [by Martin Coen]
+         - instead of the condition  A <= f(A)
+                           consider  A <= (f(A) Un f(f(A)) ...) Un gfp(A) ***)
+
+val [prem] = goal Gfp.thy "mono(f) ==> mono(%x.f(x) Un A Un B)";
+by (REPEAT (ares_tac [subset_refl, monoI, Un_mono, prem RS monoD] 1));
+val coinduct3_mono_lemma= result();
+
+val [prem,mono] = goal Gfp.thy
+    "[| A <= f(lfp(%x.f(x) Un A Un gfp(f)));  mono(f) |] ==> \
+\    lfp(%x.f(x) Un A Un gfp(f)) <= f(lfp(%x.f(x) Un A Un gfp(f)))";
+by (rtac subset_trans 1);
+br (mono RS coinduct3_mono_lemma RS lfp_lemma3) 1;
+by (rtac (Un_least RS Un_least) 1);
+br subset_refl 1;
+br prem 1;
+br (mono RS gfp_Tarski RS equalityD1 RS subset_trans) 1;
+by (rtac (mono RS monoD) 1);
+by (rtac (mono RS coinduct3_mono_lemma RS lfp_Tarski RS ssubst) 1);
+by (rtac Un_upper2 1);
+val coinduct3_lemma = result();
+
+val prems = goal Gfp.thy
+    "[| a:A;  A <= f(lfp(%x.f(x) Un A Un gfp(f))); mono(f) |] ==> a : gfp(f)";
+by (rtac (coinduct3_lemma RSN (2,coinduct)) 1);
+brs (prems RL [coinduct3_mono_lemma RS lfp_Tarski RS ssubst]) 1;
+br (UnI2 RS UnI1) 1;
+by (REPEAT (resolve_tac prems 1));
+val coinduct3 = result();
+
+
+(** Definition forms of gfp_Tarski, to control unfolding **)
+
+val [rew,mono] = goal Gfp.thy "[| h==gfp(f);  mono(f) |] ==> h = f(h)";
+by (rewtac rew);
+by (rtac (mono RS gfp_Tarski) 1);
+val def_gfp_Tarski = result();
+
+val rew::prems = goal Gfp.thy
+    "[| h==gfp(f);  a:A;  A <= f(A) |] ==> a: h";
+by (rewtac rew);
+by (REPEAT (ares_tac (prems @ [coinduct]) 1));
+val def_coinduct = result();
+
+val rew::prems = goal Gfp.thy
+    "[| h==gfp(f);  a:A;  A <= f(A) Un h; mono(f) |] ==> a: h";
+by (rewtac rew);
+by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct2]) 1));
+val def_coinduct2 = result();
+
+val rew::prems = goal Gfp.thy
+    "[| h==gfp(f);  a:A;  A <= f(lfp(%x.f(x) Un A Un h)); mono(f) |] ==> a: h";
+by (rewtac rew);
+by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct3]) 1));
+val def_coinduct3 = result();
+
+(*Monotonicity of gfp!*)
+val prems = goal Gfp.thy
+    "[| mono(f);  !!Z. f(Z)<=g(Z) |] ==> gfp(f) <= gfp(g)";
+by (rtac gfp_upperbound 1);
+by (rtac subset_trans 1);
+by (rtac gfp_lemma2 1);
+by (resolve_tac prems 1);
+by (resolve_tac prems 1);
+val gfp_mono = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Gfp.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,14 @@
+(*  Title: 	HOL/gfp.thy
+    ID:         $Id$
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+Greatest fixed points
+*)
+
+Gfp = Lfp +
+consts gfp :: "['a set=>'a set] => 'a set"
+rules
+ (*greatest fixed point*)
+ gfp_def "gfp(f) == Union({u. u <= f(u)})"
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Hered.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,196 @@
+(*  Title: 	CCL/hered
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For hered.thy.
+*)
+
+open Hered;
+
+fun type_of_terms (Const("Trueprop",_) $ (Const("op =",(Type ("fun", [t,_])))$_$_)) = t;
+
+val cong_rls = ccl_mk_congs Hered.thy  ["HTTgen"];
+
+(*** Hereditary Termination ***)
+
+goalw Hered.thy [HTTgen_def]  "mono(%X.HTTgen(X))";
+br monoI 1;
+by (fast_tac set_cs 1);
+val HTTgen_mono = result();
+
+goalw Hered.thy [HTTgen_def]
+  "t : HTTgen(A) <-> t=true | t=false | (EX a b.t=<a,b> & a : A & b : A) | \
+\                                       (EX f.t=lam x.f(x) & (ALL x.f(x) : A))";
+by (fast_tac set_cs 1);
+val HTTgenXH = result();
+
+goal Hered.thy
+  "t : HTT <-> t=true | t=false | (EX a b.t=<a,b> & a : HTT & b : HTT) | \
+\                                  (EX f.t=lam x.f(x) & (ALL x.f(x) : HTT))";
+br (rewrite_rule [HTTgen_def] 
+                 (HTTgen_mono RS (HTT_def RS def_gfp_Tarski) RS XHlemma1)) 1;
+by (fast_tac set_cs 1);
+val HTTXH = result();
+
+(*** Introduction Rules for HTT ***)
+
+goal Hered.thy "~ bot : HTT";
+by (fast_tac (term_cs addDs [XH_to_D HTTXH]) 1);
+val HTT_bot = result();
+
+goal Hered.thy "true : HTT";
+by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1);
+val HTT_true = result();
+
+goal Hered.thy "false : HTT";
+by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1);
+val HTT_false = result();
+
+goal Hered.thy "<a,b> : HTT <->  a : HTT  & b : HTT";
+br (HTTXH RS iff_trans) 1;
+by (fast_tac term_cs 1);
+val HTT_pair = result();
+
+goal Hered.thy "lam x.f(x) : HTT <-> (ALL x. f(x) : HTT)";
+br (HTTXH RS iff_trans) 1;
+by (SIMP_TAC term_ss 1);
+by (safe_tac term_cs);
+by (ASM_SIMP_TAC term_ss 1);
+by (fast_tac term_cs 1);
+val HTT_lam = result();
+
+local
+  val raw_HTTrews = [HTT_bot,HTT_true,HTT_false,HTT_pair,HTT_lam];
+  fun mk_thm s = prove_goalw Hered.thy data_defs s (fn _ => 
+                  [SIMP_TAC (term_ss addrews raw_HTTrews) 1]);
+in
+  val HTT_rews = raw_HTTrews @
+               map mk_thm ["one : HTT",
+                           "inl(a) : HTT <-> a : HTT",
+                           "inr(b) : HTT <-> b : HTT",
+                           "zero : HTT",
+                           "succ(n) : HTT <-> n : HTT",
+                           "[] : HTT",
+                           "x.xs : HTT <-> x : HTT & xs : HTT"];
+end;
+
+val HTT_Is = HTT_rews @ (HTT_rews RL [iffD2]);
+
+(*** Coinduction for HTT ***)
+
+val prems = goal Hered.thy "[|  t : R;  R <= HTTgen(R) |] ==> t : HTT";
+br (HTT_def RS def_coinduct) 1;
+by (REPEAT (ares_tac prems 1));
+val HTT_coinduct = result();
+
+fun HTT_coinduct_tac s i = res_inst_tac [("R",s)] HTT_coinduct i;
+
+val prems = goal Hered.thy 
+    "[|  t : R;   R <= HTTgen(lfp(%x. HTTgen(x) Un R Un HTT)) |] ==> t : HTT";
+br (HTTgen_mono RSN(3,HTT_def RS def_coinduct3)) 1;
+by (REPEAT (ares_tac prems 1));
+val HTT_coinduct3 = result();
+val HTT_coinduct3_raw = rewrite_rule [HTTgen_def] HTT_coinduct3;
+
+fun HTT_coinduct3_tac s i = res_inst_tac [("R",s)] HTT_coinduct3 i;
+
+val HTTgenIs = map (mk_genIs Hered.thy data_defs HTTgenXH HTTgen_mono)
+       ["true : HTTgen(R)",
+        "false : HTTgen(R)",
+        "[| a : R;  b : R |] ==> <a,b> : HTTgen(R)",
+        "[| !!x. b(x) : R |] ==> lam x.b(x) : HTTgen(R)",
+        "one : HTTgen(R)",
+        "a : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
+\                         inl(a) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "b : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
+\                         inr(b) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "zero : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "n : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
+\                         succ(n) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "[] : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "[| h : lfp(%x. HTTgen(x) Un R Un HTT); t : lfp(%x. HTTgen(x) Un R Un HTT) |] ==>\
+\                         h.t : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))"];
+
+(*** Formation Rules for Types ***)
+
+goal Hered.thy "Unit <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,UnitXH] @ HTT_rews)) 1);
+val UnitF = result();
+
+goal Hered.thy "Bool <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,BoolXH] @ HTT_rews)) 1);
+by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
+val BoolF = result();
+
+val prems = goal Hered.thy "[| A <= HTT;  B <= HTT |] ==> A + B  <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,PlusXH] @ HTT_rews)) 1);
+by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
+val PlusF = result();
+
+val prems = goal Hered.thy 
+     "[| A <= HTT;  !!x.x:A ==> B(x) <= HTT |] ==> SUM x:A.B(x) <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,SgXH] @ HTT_rews)) 1);
+by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
+val SigmaF = result();
+
+(*** Formation Rules for Recursive types - using coinduction these only need ***)
+(***                                          exhaution rule for type-former ***)
+
+(*Proof by induction - needs induction rule for type*)
+goal Hered.thy "Nat <= HTT";
+by (SIMP_TAC (term_ss addrews [subsetXH]) 1);
+by (safe_tac set_cs);
+be Nat_ind 1;
+by (ALLGOALS (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD]))));
+val NatF = result();
+
+goal Hered.thy "Nat <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI] addEs [XH_to_E NatXH]) 1);
+val NatF = result();
+
+val [prem] = goal Hered.thy "A <= HTT ==> List(A) <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addSIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
+                 addEs [XH_to_E ListXH]) 1);
+val ListF = result();
+
+val [prem] = goal Hered.thy "A <= HTT ==> Lists(A) <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addSIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
+                 addEs [XH_to_E ListsXH]) 1);
+val ListsF = result();
+
+val [prem] = goal Hered.thy "A <= HTT ==> ILists(A) <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addSIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
+                 addEs [XH_to_E IListsXH]) 1);
+val IListsF = result();
+
+(*** A possible use for this predicate is proving equality from pre-order       ***)
+(*** but it seems as easy (and more general) to do this directly by coinduction ***)
+(*
+val prems = goal Hered.thy "[| t : HTT;  t [= u |] ==> u [= t";
+by (po_coinduct_tac "{p. EX a b.p=<a,b> & b : HTT & b [= a}" 1);
+by (fast_tac (ccl_cs addIs prems) 1);
+by (safe_tac ccl_cs);
+bd (poXH RS iffD1) 1;
+by (safe_tac (set_cs addSEs [HTT_bot RS notE]));
+by (REPEAT_SOME (rtac (POgenXH RS iffD2) ORELSE' etac rev_mp));
+by (ALLGOALS (SIMP_TAC (term_ss addrews HTT_rews)));
+by (ALLGOALS (fast_tac ccl_cs));
+val HTT_po_op = result();
+
+val prems = goal Hered.thy "[| t : HTT;  t [= u |] ==> t = u";
+by (REPEAT (ares_tac (prems @ [conjI RS (eq_iff RS iffD2),HTT_po_op]) 1));
+val HTT_po_eq = result();
+*)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Hered.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,30 @@
+(*  Title: 	CCL/hered.thy
+    ID:         $Id$
+    Author: 	Martin Coen
+    Copyright   1993  University of Cambridge
+
+Hereditary Termination - cf. Martin Lo\"f
+
+Note that this is based on an untyped equality and so lam x.b(x) is only 
+hereditarily terminating if ALL x.b(x) is.  Not so useful for functions!
+
+*)
+
+Hered = Type +
+
+consts
+      (*** Predicates ***)
+  HTTgen     ::       "i set => i set"
+  HTT        ::       "i set"
+
+
+rules
+
+  (*** Definitions of Hereditary Termination ***)
+
+  HTTgen_def 
+  "HTTgen(R) == {t. t=true | t=false | (EX a b.t=<a,b>      & a : R & b : R) | \
+\                                      (EX f.  t=lam x.f(x) & (ALL x.f(x) : R))}"
+  HTT_def       "HTT == gfp(HTTgen)"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Lfp.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,82 @@
+(*  Title: 	CCL/lfp
+    ID:         $Id$
+
+Modified version of
+    Title: 	HOL/lfp.ML
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+For lfp.thy.  The Knaster-Tarski Theorem
+*)
+
+open Lfp;
+
+(*** Proof of Knaster-Tarski Theorem ***)
+
+(* lfp(f) is the greatest lower bound of {u. f(u) <= u} *)
+
+val prems = goalw Lfp.thy [lfp_def] "[| f(A) <= A |] ==> lfp(f) <= A";
+by (rtac (CollectI RS Inter_lower) 1);
+by (resolve_tac prems 1);
+val lfp_lowerbound = result();
+
+val prems = goalw Lfp.thy [lfp_def]
+    "[| !!u. f(u) <= u ==> A<=u |] ==> A <= lfp(f)";
+by (REPEAT (ares_tac ([Inter_greatest]@prems) 1));
+by (etac CollectD 1);
+val lfp_greatest = result();
+
+val [mono] = goal Lfp.thy "mono(f) ==> f(lfp(f)) <= lfp(f)";
+by (EVERY1 [rtac lfp_greatest, rtac subset_trans,
+	    rtac (mono RS monoD), rtac lfp_lowerbound, atac, atac]);
+val lfp_lemma2 = result();
+
+val [mono] = goal Lfp.thy "mono(f) ==> lfp(f) <= f(lfp(f))";
+by (EVERY1 [rtac lfp_lowerbound, rtac (mono RS monoD), 
+	    rtac lfp_lemma2, rtac mono]);
+val lfp_lemma3 = result();
+
+val [mono] = goal Lfp.thy "mono(f) ==> lfp(f) = f(lfp(f))";
+by (REPEAT (resolve_tac [equalityI,lfp_lemma2,lfp_lemma3,mono] 1));
+val lfp_Tarski = result();
+
+
+(*** General induction rule for least fixed points ***)
+
+val [lfp,mono,indhyp] = goal Lfp.thy
+    "[| a: lfp(f);  mono(f);  				\
+\       !!x. [| x: f(lfp(f) Int {x.P(x)}) |] ==> P(x) 	\
+\    |] ==> P(a)";
+by (res_inst_tac [("a","a")] (Int_lower2 RS subsetD RS CollectD) 1);
+by (rtac (lfp RSN (2, lfp_lowerbound RS subsetD)) 1);
+by (EVERY1 [rtac Int_greatest, rtac subset_trans, 
+	    rtac (Int_lower1 RS (mono RS monoD)),
+	    rtac (mono RS lfp_lemma2),
+	    rtac (CollectI RS subsetI), rtac indhyp, atac]);
+val induct = result();
+
+(** Definition forms of lfp_Tarski and induct, to control unfolding **)
+
+val [rew,mono] = goal Lfp.thy "[| h==lfp(f);  mono(f) |] ==> h = f(h)";
+by (rewtac rew);
+by (rtac (mono RS lfp_Tarski) 1);
+val def_lfp_Tarski = result();
+
+val rew::prems = goal Lfp.thy
+    "[| A == lfp(f);  a:A;  mono(f);   			\
+\       !!x. [| x: f(A Int {x.P(x)}) |] ==> P(x) 	\
+\    |] ==> P(a)";
+by (EVERY1 [rtac induct,	(*backtracking to force correct induction*)
+	    REPEAT1 o (ares_tac (map (rewrite_rule [rew]) prems))]);
+val def_induct = result();
+
+(*Monotonicity of lfp!*)
+val prems = goal Lfp.thy
+    "[| mono(g);  !!Z. f(Z)<=g(Z) |] ==> lfp(f) <= lfp(g)";
+by (rtac lfp_lowerbound 1);
+by (rtac subset_trans 1);
+by (resolve_tac prems 1);
+by (rtac lfp_lemma2 1);
+by (resolve_tac prems 1);
+val lfp_mono = result();
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Lfp.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,14 @@
+(*  Title: 	HOL/lfp.thy
+    ID:         $Id$
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+The Knaster-Tarski Theorem
+*)
+
+Lfp = Set +
+consts lfp :: "['a set=>'a set] => 'a set"
+rules
+ (*least fixed point*)
+ lfp_def "lfp(f) == Inter({u. f(u) <= u})"
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Makefile	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,48 @@
+#########################################################################
+#									#
+# 			Makefile for Isabelle (CCL)			#
+#									#
+#########################################################################
+
+#To make the system, cd to this directory and type
+#	make -f Makefile 
+#To make the system and test it on standard examples, type 
+#	make -f Makefile test
+
+#Environment variable ISABELLECOMP specifies the compiler.
+#Environment variable ISABELLEBIN specifies the destination directory.
+#For Poly/ML, ISABELLEBIN must begin with a /
+
+#Makes FOL if this file is ABSENT -- but not 
+#if it is out of date, since this Makefile does not know its dependencies!
+
+BIN = $(ISABELLEBIN)
+COMP = $(ISABELLECOMP)
+
+SET_FILES = ROOT.ML set.thy set.ML subset.ML equalities.ML mono.ML \
+	    gfp.thy gfp.ML lfp.thy lfp.ML
+
+CCL_FILES = ccl.thy ccl.ML terms.thy terms.ML types.thy types.ML \
+            coinduction.ML hered.thy hered.ML trancl.thy trancl.ML\
+            wf.thy wf.ML genrec.ML typecheck.ML eval.ML fix.thy fix.ML
+
+#Uses cp rather than make_database because Poly/ML allows only 3 levels
+$(BIN)/CCL:   $(BIN)/FOL  $(SET_FILES)  $(CCL_FILES) 
+	case "$(COMP)" in \
+	poly*)	cp $(BIN)/FOL $(BIN)/CCL;\
+		echo 'open PolyML; use"ROOT";' | $(COMP) $(BIN)/CCL ;;\
+	sml*)	echo 'use"ROOT.ML"; xML"$(BIN)/CCL" banner;' | $(BIN)/FOL;;\
+	*)	echo Bad value for ISABELLECOMP;;\
+	esac
+
+$(BIN)/FOL:
+	cd ../FOL;  $(MAKE)
+
+test:   ex/ROOT.ML  $(BIN)/CCL
+	case "$(COMP)" in \
+	poly*)	echo 'use"ex/ROOT.ML"; quit();' | $(COMP) $(BIN)/CCL ;;\
+	sml*)	echo 'use"ex/ROOT.ML";' | $(BIN)/CCL;;\
+	*)	echo Bad value for ISABELLECOMP;;\
+	esac
+
+.PRECIOUS:  $(BIN)/FOL $(BIN)/CCL 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ROOT.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,37 @@
+(*  Title:      CCL/ROOT
+    ID:         $Id$
+    Author:     Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Adds Classical Computational Logic to a database containing First-Order Logic.
+*)
+
+val banner = "Classical Computational Logic (in FOL)";
+
+(* Higher-Order Set Theory Extension to FOL *)
+(*      used as basis for CCL               *)
+
+use_thy "set";
+use     "subset.ML";
+use     "equalities.ML";
+use     "mono.ML";
+use_thy "lfp";
+use_thy "gfp";
+
+(* CCL - a computational logic for an untyped functional language *)
+(*                       with evaluation to weak head-normal form *)
+
+use_thy "ccl";
+use_thy "terms";
+use_thy "types";
+use     "coinduction.ML";
+use_thy "hered";
+
+use_thy "trancl";
+use_thy "wf";
+use     "genrec.ML";
+use     "typecheck.ML";
+use     "eval.ML";
+use_thy "fix";
+
+val CCL_build_completed = ();   (*indicate successful build*)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Set.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,355 @@
+(*  Title: 	set/set
+    ID:         $Id$
+
+For set.thy.
+
+Modified version of
+    Title: 	HOL/set
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1991  University of Cambridge
+
+For set.thy.  Set theory for higher-order logic.  A set is simply a predicate.
+*)
+
+open Set;
+
+val [prem] = goal Set.thy "[| P(a) |] ==> a : {x.P(x)}";
+by (rtac (mem_Collect_iff RS iffD2) 1);
+by (rtac prem 1);
+val CollectI = result();
+
+val prems = goal Set.thy "[| a : {x.P(x)} |] ==> P(a)";
+by (resolve_tac (prems RL [mem_Collect_iff  RS iffD1]) 1);
+val CollectD = result();
+
+val [prem] = goal Set.thy "[| !!x. x:A <-> x:B |] ==> A = B";
+by (rtac (set_extension RS iffD2) 1);
+by (rtac (prem RS allI) 1);
+val set_ext = result();
+
+val prems = goal Set.thy "[| !!x. P(x) <-> Q(x) |] ==> {x. P(x)} = {x. Q(x)}";
+by (REPEAT (ares_tac [set_ext,iffI,CollectI] 1 ORELSE
+            eresolve_tac ([CollectD] RL (prems RL [iffD1,iffD2])) 1));
+val Collect_cong = result();
+
+val CollectE = make_elim CollectD;
+
+(*** Bounded quantifiers ***)
+
+val prems = goalw Set.thy [Ball_def]
+    "[| !!x. x:A ==> P(x) |] ==> ALL x:A. P(x)";
+by (REPEAT (ares_tac (prems @ [allI,impI]) 1));
+val ballI = result();
+
+val [major,minor] = goalw Set.thy [Ball_def]
+    "[| ALL x:A. P(x);  x:A |] ==> P(x)";
+by (rtac (minor RS (major RS spec RS mp)) 1);
+val bspec = result();
+
+val major::prems = goalw Set.thy [Ball_def]
+    "[| ALL x:A. P(x);  P(x) ==> Q;  ~ x:A ==> Q |] ==> Q";
+by (rtac (major RS spec RS impCE) 1);
+by (REPEAT (eresolve_tac prems 1));
+val ballE = result();
+
+(*Takes assumptions ALL x:A.P(x) and a:A; creates assumption P(a)*)
+fun ball_tac i = etac ballE i THEN contr_tac (i+1);
+
+val prems = goalw Set.thy [Bex_def]
+    "[| P(x);  x:A |] ==> EX x:A. P(x)";
+by (REPEAT (ares_tac (prems @ [exI,conjI]) 1));
+val bexI = result();
+
+val bexCI = prove_goal Set.thy 
+   "[| EX 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 major::prems = goalw Set.thy [Bex_def]
+    "[| EX x:A. P(x);  !!x. [| x:A; P(x) |] ==> Q  |] ==> Q";
+by (rtac (major RS exE) 1);
+by (REPEAT (eresolve_tac (prems @ [asm_rl,conjE]) 1));
+val bexE = result();
+
+(*Trival rewrite rule;   (! x:A.P)=P holds only if A is nonempty!*)
+val prems = goal Set.thy
+    "(ALL x:A. True) <-> True";
+by (REPEAT (ares_tac [TrueI,ballI,iffI] 1));
+val ball_rew = result();
+
+(** Congruence rules **)
+
+val prems = goal Set.thy
+    "[| A=A';  !!x. x:A' ==> P(x) <-> P'(x) |] ==> \
+\    (ALL x:A. P(x)) <-> (ALL x:A'. P'(x))";
+by (resolve_tac (prems RL [ssubst,iffD2]) 1);
+by (REPEAT (ares_tac [ballI,iffI] 1
+     ORELSE eresolve_tac ([make_elim bspec, mp] @ (prems RL [iffE])) 1));
+val ball_cong = result();
+
+val prems = goal Set.thy
+    "[| A=A';  !!x. x:A' ==> P(x) <-> P'(x) |] ==> \
+\    (EX x:A. P(x)) <-> (EX x:A'. P'(x))";
+by (resolve_tac (prems RL [ssubst,iffD2]) 1);
+by (REPEAT (etac bexE 1
+     ORELSE ares_tac ([bexI,iffI] @ (prems RL [iffD1,iffD2])) 1));
+val bex_cong = result();
+
+(*** Rules for subsets ***)
+
+val prems = goalw Set.thy [subset_def] "(!!x.x:A ==> x:B) ==> A <= B";
+by (REPEAT (ares_tac (prems @ [ballI]) 1));
+val subsetI = result();
+
+(*Rule in Modus Ponens style*)
+val major::prems = goalw Set.thy [subset_def] "[| A <= B;  c:A |] ==> c:B";
+by (rtac (major RS bspec) 1);
+by (resolve_tac prems 1);
+val subsetD = result();
+
+(*Classical elimination rule*)
+val major::prems = goalw Set.thy [subset_def] 
+    "[| A <= B;  ~(c:A) ==> P;  c:B ==> P |] ==> P";
+by (rtac (major RS ballE) 1);
+by (REPEAT (eresolve_tac prems 1));
+val subsetCE = result();
+
+(*Takes assumptions A<=B; c:A and creates the assumption c:B *)
+fun set_mp_tac i = etac subsetCE i  THEN  mp_tac i;
+
+val subset_refl = prove_goal Set.thy "A <= A"
+ (fn _=> [ (REPEAT (ares_tac [subsetI] 1)) ]);
+
+goal Set.thy "!!A B C. [| A<=B;  B<=C |] ==> A<=C";
+br subsetI 1;
+by (REPEAT (eresolve_tac [asm_rl, subsetD] 1));
+val subset_trans = result();
+
+
+(*** Rules for equality ***)
+
+(*Anti-symmetry of the subset relation*)
+val prems = goal Set.thy "[| A <= B;  B <= A |] ==> A = B";
+by (rtac (iffI RS set_ext) 1);
+by (REPEAT (ares_tac (prems RL [subsetD]) 1));
+val subset_antisym = result();
+val equalityI = subset_antisym;
+
+(* Equality rules from ZF set theory -- are they appropriate here? *)
+val prems = goal Set.thy "A = B ==> A<=B";
+by (resolve_tac (prems RL [subst]) 1);
+by (rtac subset_refl 1);
+val equalityD1 = result();
+
+val prems = goal Set.thy "A = B ==> B<=A";
+by (resolve_tac (prems RL [subst]) 1);
+by (rtac subset_refl 1);
+val equalityD2 = result();
+
+val prems = goal Set.thy
+    "[| A = B;  [| A<=B; B<=A |] ==> P |]  ==>  P";
+by (resolve_tac prems 1);
+by (REPEAT (resolve_tac (prems RL [equalityD1,equalityD2]) 1));
+val equalityE = result();
+
+val major::prems = goal Set.thy
+    "[| A = B;  [| c:A; c:B |] ==> P;  [| ~ c:A; ~ c:B |] ==> P |]  ==>  P";
+by (rtac (major RS equalityE) 1);
+by (REPEAT (contr_tac 1 ORELSE eresolve_tac ([asm_rl,subsetCE]@prems) 1));
+val equalityCE = result();
+
+(*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. *)
+val prems = goal Set.thy 
+    "[| p:A;  !!z. z:A ==> p=z --> R |] ==> R";
+by (rtac mp 1);
+by (REPEAT (resolve_tac (refl::prems) 1));
+val setup_induction = result();
+
+goal Set.thy "{x.x:A} = A";
+by (REPEAT (ares_tac [equalityI,subsetI,CollectI] 1  ORELSE eresolve_tac [CollectD] 1));
+val trivial_set = result();
+
+(*** Rules for binary union -- Un ***)
+
+val prems = goalw Set.thy [Un_def] "c:A ==> c : A Un B";
+by (REPEAT (resolve_tac (prems @ [CollectI,disjI1]) 1));
+val UnI1 = result();
+
+val prems = goalw Set.thy [Un_def] "c:B ==> c : A Un B";
+by (REPEAT (resolve_tac (prems @ [CollectI,disjI2]) 1));
+val UnI2 = result();
+
+(*Classical introduction rule: no commitment to A vs B*)
+val UnCI = prove_goal Set.thy "(~c:B ==> c:A) ==> c : A Un B"
+ (fn prems=>
+  [ (rtac classical 1),
+    (REPEAT (ares_tac (prems@[UnI1,notI]) 1)),
+    (REPEAT (ares_tac (prems@[UnI2,notE]) 1)) ]);
+
+val major::prems = goalw Set.thy [Un_def]
+    "[| c : A Un B;  c:A ==> P;  c:B ==> P |] ==> P";
+by (rtac (major RS CollectD RS disjE) 1);
+by (REPEAT (eresolve_tac prems 1));
+val UnE = result();
+
+
+(*** Rules for small intersection -- Int ***)
+
+val prems = goalw Set.thy [Int_def]
+    "[| c:A;  c:B |] ==> c : A Int B";
+by (REPEAT (resolve_tac (prems @ [CollectI,conjI]) 1));
+val IntI = result();
+
+val [major] = goalw Set.thy [Int_def] "c : A Int B ==> c:A";
+by (rtac (major RS CollectD RS conjunct1) 1);
+val IntD1 = result();
+
+val [major] = goalw Set.thy [Int_def] "c : A Int B ==> c:B";
+by (rtac (major RS CollectD RS conjunct2) 1);
+val IntD2 = result();
+
+val [major,minor] = goal Set.thy
+    "[| c : A Int B;  [| c:A; c:B |] ==> P |] ==> P";
+by (rtac minor 1);
+by (rtac (major RS IntD1) 1);
+by (rtac (major RS IntD2) 1);
+val IntE = result();
+
+
+(*** Rules for set complement -- Compl ***)
+
+val prems = goalw Set.thy [Compl_def]
+    "[| c:A ==> False |] ==> c : Compl(A)";
+by (REPEAT (ares_tac (prems @ [CollectI,notI]) 1));
+val ComplI = result();
+
+(*This form, with negated conclusion, works well with the Classical prover.
+  Negated assumptions behave like formulae on the right side of the notional
+  turnstile...*)
+val major::prems = goalw Set.thy [Compl_def]
+    "[| c : Compl(A) |] ==> ~c:A";
+by (rtac (major RS CollectD) 1);
+val ComplD = result();
+
+val ComplE = make_elim ComplD;
+
+
+(*** Empty sets ***)
+
+goalw Set.thy [empty_def] "{x.False} = {}";
+br refl 1;
+val empty_eq = result();
+
+val [prem] = goalw Set.thy [empty_def] "a : {} ==> P";
+by (rtac (prem RS CollectD RS FalseE) 1);
+val emptyD = result();
+
+val emptyE = make_elim emptyD;
+
+val [prem] = goal Set.thy "~ A={} ==> (EX x.x:A)";
+br (prem RS swap) 1;
+br equalityI 1;
+by (ALLGOALS (fast_tac (FOL_cs addSIs [subsetI] addSEs [emptyD])));
+val not_emptyD = result();
+
+(*** Singleton sets ***)
+
+goalw Set.thy [singleton_def] "a : {a}";
+by (rtac CollectI 1);
+by (rtac refl 1);
+val singletonI = result();
+
+val [major] = goalw Set.thy [singleton_def] "b : {a} ==> b=a"; 
+by (rtac (major RS CollectD) 1);
+val singletonD = result();
+
+val singletonE = make_elim singletonD;
+
+(*** Unions of families ***)
+
+(*The order of the premises presupposes that A is rigid; b may be flexible*)
+val prems = goalw Set.thy [UNION_def]
+    "[| a:A;  b: B(a) |] ==> b: (UN x:A. B(x))";
+by (REPEAT (resolve_tac (prems @ [bexI,CollectI]) 1));
+val UN_I = result();
+
+val major::prems = goalw Set.thy [UNION_def]
+    "[| b : (UN x:A. B(x));  !!x.[| x:A;  b: B(x) |] ==> R |] ==> R";
+by (rtac (major RS CollectD RS bexE) 1);
+by (REPEAT (ares_tac prems 1));
+val UN_E = result();
+
+val prems = goal Set.thy
+    "[| A=B;  !!x. x:B ==> C(x) = D(x) |] ==> \
+\    (UN x:A. C(x)) = (UN x:B. D(x))";
+by (REPEAT (etac UN_E 1
+     ORELSE ares_tac ([UN_I,equalityI,subsetI] @ 
+		      (prems RL [equalityD1,equalityD2] RL [subsetD])) 1));
+val UN_cong = result();
+
+(*** Intersections of families -- INTER x:A. B(x) is Inter(B)``A ) *)
+
+val prems = goalw Set.thy [INTER_def]
+    "(!!x. x:A ==> b: B(x)) ==> b : (INT x:A. B(x))";
+by (REPEAT (ares_tac ([CollectI,ballI] @ prems) 1));
+val INT_I = result();
+
+val major::prems = goalw Set.thy [INTER_def]
+    "[| b : (INT x:A. B(x));  a:A |] ==> b: B(a)";
+by (rtac (major RS CollectD RS bspec) 1);
+by (resolve_tac prems 1);
+val INT_D = result();
+
+(*"Classical" elimination rule -- does not require proving X:C *)
+val major::prems = goalw Set.thy [INTER_def]
+    "[| b : (INT x:A. B(x));  b: B(a) ==> R;  ~ a:A ==> R |] ==> R";
+by (rtac (major RS CollectD RS ballE) 1);
+by (REPEAT (eresolve_tac prems 1));
+val INT_E = result();
+
+val prems = goal Set.thy
+    "[| A=B;  !!x. x:B ==> C(x) = D(x) |] ==> \
+\    (INT x:A. C(x)) = (INT x:B. D(x))";
+by (REPEAT_FIRST (resolve_tac [INT_I,equalityI,subsetI]));
+by (REPEAT (dtac INT_D 1
+     ORELSE ares_tac (prems RL [equalityD1,equalityD2] RL [subsetD]) 1));
+val INT_cong = result();
+
+(*** Rules for Unions ***)
+
+(*The order of the premises presupposes that C is rigid; A may be flexible*)
+val prems = goalw Set.thy [Union_def]
+    "[| X:C;  A:X |] ==> A : Union(C)";
+by (REPEAT (resolve_tac (prems @ [UN_I]) 1));
+val UnionI = result();
+
+val major::prems = goalw Set.thy [Union_def]
+    "[| A : Union(C);  !!X.[| A:X;  X:C |] ==> R |] ==> R";
+by (rtac (major RS UN_E) 1);
+by (REPEAT (ares_tac prems 1));
+val UnionE = result();
+
+(*** Rules for Inter ***)
+
+val prems = goalw Set.thy [Inter_def]
+    "[| !!X. X:C ==> A:X |] ==> A : Inter(C)";
+by (REPEAT (ares_tac ([INT_I] @ prems) 1));
+val InterI = result();
+
+(*A "destruct" rule -- every X in C contains A as an element, but
+  A:X can hold when X:C does not!  This rule is analogous to "spec". *)
+val major::prems = goalw Set.thy [Inter_def]
+    "[| A : Inter(C);  X:C |] ==> A:X";
+by (rtac (major RS INT_D) 1);
+by (resolve_tac prems 1);
+val InterD = result();
+
+(*"Classical" elimination rule -- does not require proving X:C *)
+val major::prems = goalw Set.thy [Inter_def]
+    "[| A : Inter(C);  A:X ==> R;  ~ X:C ==> R |] ==> R";
+by (rtac (major RS INT_E) 1);
+by (REPEAT (eresolve_tac prems 1));
+val InterE = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Set.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,71 @@
+(*  Title:      CCL/set.thy
+    ID:         $Id$
+
+Modified version of HOL/set.thy that extends FOL
+
+*)
+
+Set = FOL +
+
+types
+  set 1
+
+arities
+  set :: (term) term
+
+consts
+  Collect       :: "['a => o] => 'a set"                    (*comprehension*)
+  Compl         :: "('a set) => 'a set"                     (*complement*)
+  Int           :: "['a set, 'a set] => 'a set"         (infixl 70)
+  Un            :: "['a set, 'a set] => 'a set"         (infixl 65)
+  Union, Inter  :: "(('a set)set) => 'a set"                (*...of a set*)
+  UNION, INTER  :: "['a set, 'a => 'b set] => 'b set"       (*general*)
+  Ball, Bex     :: "['a set, 'a => o] => o"                 (*bounded quants*)
+  mono          :: "['a set => 'b set] => o"                (*monotonicity*)
+  ":"           :: "['a, 'a set] => o"                  (infixl 50) (*membership*)
+  "<="          :: "['a set, 'a set] => o"              (infixl 50)
+  singleton     :: "'a => 'a set"                       ("{_}")
+  empty         :: "'a set"                             ("{}")
+  "oo"          :: "['b => 'c, 'a => 'b, 'a] => 'c"     (infixr 50) (*composition*)
+
+  "@Coll"       :: "[idt, o] => 'a set"                 ("(1{_./ _})") (*collection*)
+
+  (* Big Intersection / Union *)
+
+  "@INTER"      :: "[idt, 'a set, 'b set] => 'b set"    ("(INT _:_./ _)" [0, 0, 0] 10)
+  "@UNION"      :: "[idt, 'a set, 'b set] => 'b set"    ("(UN _:_./ _)" [0, 0, 0] 10)
+
+  (* Bounded Quantifiers *)
+
+  "@Ball"       :: "[idt, 'a set, o] => o"              ("(ALL _:_./ _)" [0, 0, 0] 10)
+  "@Bex"        :: "[idt, 'a set, o] => o"              ("(EX _:_./ _)" [0, 0, 0] 10)
+
+
+translations
+  "{x. P}"      == "Collect(%x. P)"
+  "INT x:A. B"  == "INTER(A, %x. B)"
+  "UN x:A. B"   == "UNION(A, %x. B)"
+  "ALL x:A. P"  == "Ball(A, %x. P)"
+  "EX x:A. P"   == "Bex(A, %x. P)"
+
+
+rules
+  mem_Collect_iff       "(a : {x.P(x)}) <-> P(a)"
+  set_extension         "A=B <-> (ALL x.x:A <-> x:B)"
+
+  Ball_def      "Ball(A, P)  == ALL x. x:A --> P(x)"
+  Bex_def       "Bex(A, P)   == EX x. x:A & P(x)"
+  mono_def      "mono(f)     == (ALL A B. A <= B --> f(A) <= f(B))"
+  subset_def    "A <= B      == ALL x:A. x:B"
+  singleton_def "{a}         == {x.x=a}"
+  empty_def     "{}          == {x.False}"
+  Un_def        "A Un B      == {x.x:A | x:B}"
+  Int_def       "A Int B     == {x.x:A & x:B}"
+  Compl_def     "Compl(A)    == {x. ~x:A}"
+  INTER_def     "INTER(A, B) == {y. ALL x:A. y: B(x)}"
+  UNION_def     "UNION(A, B) == {y. EX x:A. y: B(x)}"
+  Inter_def     "Inter(S)    == (INT x:S. x)"
+  Union_def     "Union(S)    == (UN x:S. x)"
+
+end
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Term.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,146 @@
+(*  Title: 	CCL/terms
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For terms.thy.
+*)
+
+open Term;
+
+val simp_can_defs = [one_def,inl_def,inr_def];
+val simp_ncan_defs = [if_def,when_def,split_def,fst_def,snd_def,thd_def];
+val simp_defs = simp_can_defs @ simp_ncan_defs;
+
+val ind_can_defs = [zero_def,succ_def,nil_def,cons_def];
+val ind_ncan_defs = [ncase_def,nrec_def,lcase_def,lrec_def];
+val ind_defs = ind_can_defs @ ind_ncan_defs;
+
+val data_defs = simp_defs @ ind_defs @ [napply_def];
+val genrec_defs = [letrec_def,letrec2_def,letrec3_def];
+
+val term_congs = ccl_mk_congs Term.thy 
+    ["inl","inr","succ","op .","split","if","when","ncase","nrec","lcase","lrec",
+     "fst","snd","thd","let","letrec","letrec2","letrec3","napply"];
+
+(*** Beta Rules, including strictness ***)
+
+goalw Term.thy [let_def] "~ t=bot--> let x be t in f(x) = f(t)";
+by (res_inst_tac [("t","t")] term_case 1);
+by (ALLGOALS(SIMP_TAC(CCL_ss addrews [caseBtrue,caseBfalse,caseBpair,caseBlam])));
+val letB = result() RS mp;
+
+goalw Term.thy [let_def] "let x be bot in f(x) = bot";
+br caseBbot 1;
+val letBabot = result();
+
+goalw Term.thy [let_def] "let x be t in bot = bot";
+brs ([caseBbot] RL [term_case]) 1;
+by (ALLGOALS(SIMP_TAC(CCL_ss addrews [caseBtrue,caseBfalse,caseBpair,caseBlam])));
+val letBbbot = result();
+
+goalw Term.thy [apply_def] "(lam x.b(x)) ` a = b(a)";
+by (ALLGOALS(SIMP_TAC(CCL_ss addrews [caseBtrue,caseBfalse,caseBpair,caseBlam])));
+val applyB = result();
+
+goalw Term.thy [apply_def] "bot ` a = bot";
+br caseBbot 1;
+val applyBbot = result();
+
+goalw Term.thy [fix_def] "fix(f) = f(fix(f))";
+by (resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1);
+val fixB = result();
+
+goalw Term.thy [letrec_def]
+      "letrec g x be h(x,g) in g(a) = h(a,%y.letrec g x be h(x,g) in g(y))";
+by (resolve_tac [fixB RS ssubst] 1 THEN 
+    resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1);
+val letrecB = result();
+
+val rawBs = caseBs @ [applyB,applyBbot,letrecB];
+
+fun raw_mk_beta_rl defs s = prove_goalw Term.thy defs s
+           (fn _ => [SIMP_TAC (CCL_ss addrews rawBs  addcongs term_congs) 1]);
+fun mk_beta_rl s = raw_mk_beta_rl data_defs s;
+
+val ifBtrue    = mk_beta_rl "if true then t else u = t";
+val ifBfalse   = mk_beta_rl "if false then t else u = u";
+val ifBbot     = mk_beta_rl "if bot then t else u = bot";
+
+val whenBinl   = mk_beta_rl "when(inl(a),t,u) = t(a)";
+val whenBinr   = mk_beta_rl "when(inr(a),t,u) = u(a)";
+val whenBbot   = mk_beta_rl "when(bot,t,u) = bot";
+
+val splitB     = mk_beta_rl "split(<a,b>,h) = h(a,b)";
+val splitBbot  = mk_beta_rl "split(bot,h) = bot";
+val fstB       = mk_beta_rl "fst(<a,b>) = a";
+val fstBbot    = mk_beta_rl "fst(bot) = bot";
+val sndB       = mk_beta_rl "snd(<a,b>) = b";
+val sndBbot    = mk_beta_rl "snd(bot) = bot";
+val thdB       = mk_beta_rl "thd(<a,<b,c>>) = c";
+val thdBbot    = mk_beta_rl "thd(bot) = bot";
+
+val ncaseBzero = mk_beta_rl "ncase(zero,t,u) = t";
+val ncaseBsucc = mk_beta_rl "ncase(succ(n),t,u) = u(n)";
+val ncaseBbot  = mk_beta_rl "ncase(bot,t,u) = bot";
+val nrecBzero  = mk_beta_rl "nrec(zero,t,u) = t";
+val nrecBsucc  = mk_beta_rl "nrec(succ(n),t,u) = u(n,nrec(n,t,u))";
+val nrecBbot   = mk_beta_rl "nrec(bot,t,u) = bot";
+
+val lcaseBnil  = mk_beta_rl "lcase([],t,u) = t";
+val lcaseBcons = mk_beta_rl "lcase(x.xs,t,u) = u(x,xs)";
+val lcaseBbot  = mk_beta_rl "lcase(bot,t,u) = bot";
+val lrecBnil   = mk_beta_rl "lrec([],t,u) = t";
+val lrecBcons  = mk_beta_rl "lrec(x.xs,t,u) = u(x,xs,lrec(xs,t,u))";
+val lrecBbot   = mk_beta_rl "lrec(bot,t,u) = bot";
+
+val letrec2B = raw_mk_beta_rl (data_defs @ [letrec2_def])
+       "letrec g x y be h(x,y,g) in g(p,q) = \
+\                     h(p,q,%u v.letrec g x y be h(x,y,g) in g(u,v))";
+val letrec3B = raw_mk_beta_rl (data_defs @ [letrec3_def])
+       "letrec g x y z be h(x,y,z,g) in g(p,q,r) = \
+\                     h(p,q,r,%u v w.letrec g x y z be h(x,y,z,g) in g(u,v,w))";
+
+val napplyBzero   = mk_beta_rl "f^zero`a = a";
+val napplyBsucc   = mk_beta_rl "f^succ(n)`a = f(f^n`a)";
+
+val termBs = [letB,applyB,applyBbot,splitB,splitBbot,
+              fstB,fstBbot,sndB,sndBbot,thdB,thdBbot,
+              ifBtrue,ifBfalse,ifBbot,whenBinl,whenBinr,whenBbot,
+              ncaseBzero,ncaseBsucc,ncaseBbot,nrecBzero,nrecBsucc,nrecBbot,
+              lcaseBnil,lcaseBcons,lcaseBbot,lrecBnil,lrecBcons,lrecBbot,
+              napplyBzero,napplyBsucc];
+
+(*** Constructors are injective ***)
+
+val term_injs = map (mk_inj_rl Term.thy 
+                             [applyB,splitB,whenBinl,whenBinr,ncaseBsucc,lcaseBcons] 
+                             (ccl_congs @ term_congs))
+               ["(inl(a) = inl(a')) <-> (a=a')",
+                "(inr(a) = inr(a')) <-> (a=a')",
+                "(succ(a) = succ(a')) <-> (a=a')",
+                "(a.b = a'.b') <-> (a=a' & b=b')"];
+
+(*** Constructors are distinct ***)
+
+val term_dstncts = mkall_dstnct_thms Term.thy data_defs (ccl_injs @ term_injs)
+                    [["bot","inl","inr"],["bot","zero","succ"],["bot","nil","op ."]];
+
+(*** Rules for pre-order [= ***)
+
+local
+  fun mk_thm s = prove_goalw Term.thy data_defs s (fn _ => 
+                  [SIMP_TAC (ccl_ss addrews (ccl_porews)) 1]);
+in
+  val term_porews = map mk_thm ["inl(a) [= inl(a') <-> a [= a'",
+                                "inr(b) [= inr(b') <-> b [= b'",
+                                "succ(n) [= succ(n') <-> n [= n'",
+                                "x.xs [= x'.xs' <-> x [= x'  & xs [= xs'"];
+end;
+
+(*** Rewriting and Proving ***)
+
+val term_rews = termBs @ term_injs @ term_dstncts @ ccl_porews @ term_porews;
+val term_ss = ccl_ss addrews term_rews addcongs term_congs;
+
+val term_cs = ccl_cs addSEs (term_dstncts RL [notE]) addSDs (XH_to_Ds term_injs);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Term.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,131 @@
+(*  Title: 	CCL/terms.thy
+    ID:         $Id$
+    Author: 	Martin Coen
+    Copyright   1993  University of Cambridge
+
+Definitions of usual program constructs in CCL.
+
+*)
+
+Term = CCL +
+
+consts
+
+  one        ::	      "i"
+
+  if         ::       "[i,i,i]=>i"           ("(3if _/ then _/ else _)" [] 60)
+
+  inl,inr    ::	      "i=>i"
+  when       ::	      "[i,i=>i,i=>i]=>i" 
+
+  split      ::	      "[i,[i,i]=>i]=>i"
+  fst,snd,   
+  thd        ::       "i=>i"
+
+  zero       ::	      "i"
+  succ       ::	      "i=>i"
+  ncase      ::	      "[i,i,i=>i]=>i"
+  nrec       ::	      "[i,i,[i,i]=>i]=>i"
+
+  nil        ::       "i"                    ("([])")
+  "."        ::       "[i,i]=>i"             (infixr 80)
+  lcase      ::	      "[i,i,[i,i]=>i]=>i"
+  lrec       ::	      "[i,i,[i,i,i]=>i]=>i"
+
+  let        ::       "[i,i=>i]=>i"
+  letrec     ::       "[[i,i=>i]=>i,(i=>i)=>i]=>i"
+  letrec2    ::       "[[i,i,i=>i=>i]=>i,(i=>i=>i)=>i]=>i"
+  letrec3    ::       "[[i,i,i,i=>i=>i=>i]=>i,(i=>i=>i=>i)=>i]=>i"  
+
+  "@let"     ::       "[id,i,i]=>i"             ("(3let _ be _/ in _)" [] 60)
+  "@letrec"  ::       "[id,id,i,i]=>i"          ("(3letrec _ _ be _/ in _)"  [] 60)
+  "@letrec2" ::       "[id,id,id,i,i]=>i"       ("(3letrec _ _ _ be _/ in _)"  [] 60)
+  "@letrec3" ::       "[id,id,id,id,i,i]=>i"    ("(3letrec _ _ _ _ be _/ in _)"  [] 60)
+
+  napply    :: "[i=>i,i,i]=>i"      ("(_ ^ _ ` _)")
+
+rules
+
+  one_def                    "one == true"
+  if_def     "if b then t else u  == case(b,t,u,% x y.bot,%v.bot)"
+  inl_def                 "inl(a) == <true,a>"
+  inr_def                 "inr(b) == <false,b>"
+  when_def           "when(t,f,g) == split(t,%b x.if b then f(x) else g(x))"
+  split_def           "split(t,f) == case(t,bot,bot,f,%u.bot)"
+  fst_def                 "fst(t) == split(t,%x y.x)"
+  snd_def                 "snd(t) == split(t,%x y.y)"
+  thd_def                 "thd(t) == split(t,%x p.split(p,%y z.z))"
+  zero_def                  "zero == inl(one)"
+  succ_def               "succ(n) == inr(n)"
+  ncase_def         "ncase(n,b,c) == when(n,%x.b,%y.c(y))"
+  nrec_def          " nrec(n,b,c) == letrec g x be ncase(x,b,%y.c(y,g(y))) in g(n)"
+  nil_def	              "[] == inl(one)"
+  cons_def                   "h.t == inr(<h,t>)"
+  lcase_def         "lcase(l,b,c) == when(l,%x.b,%y.split(y,c))"
+  lrec_def           "lrec(l,b,c) == letrec g x be lcase(x,b,%h t.c(h,t,g(t))) in g(l)"
+
+  let_def  "let x be t in f(x) == case(t,f(true),f(false),%x y.f(<x,y>),%u.f(lam x.u(x)))"
+  letrec_def    
+  "letrec g x be h(x,g) in b(g) == b(%x.fix(%f.lam x.h(x,%y.f`y))`x)"
+
+  letrec2_def  "letrec g x y be h(x,y,g) in f(g)== \
+\               letrec g' p be split(p,%x y.h(x,y,%u v.g'(<u,v>))) \
+\                          in f(%x y.g'(<x,y>))"
+
+  letrec3_def  "letrec g x y z be h(x,y,z,g) in f(g) == \
+\             letrec g' p be split(p,%x xs.split(xs,%y z.h(x,y,z,%u v w.g'(<u,<v,w>>)))) \
+\                          in f(%x y z.g'(<x,<y,z>>))"
+
+  napply_def "f ^n` a == nrec(n,a,%x g.f(g))"
+
+end
+
+ML
+
+(** Quantifier translations: variable binding **)
+
+fun let_tr [Free(id,T),a,b] = Const("let",dummyT) $ a $ absfree(id,T,b);
+fun let_tr' [a,Abs(id,T,b)] =
+     let val (id',b') = variant_abs(id,T,b)
+     in Const("@let",dummyT) $ Free(id',T) $ a $ b' end;
+
+fun letrec_tr [Free(f,S),Free(x,T),a,b] = 
+      Const("letrec",dummyT) $ absfree(x,T,absfree(f,S,a)) $ absfree(f,S,b);
+fun letrec2_tr [Free(f,S),Free(x,T),Free(y,U),a,b] = 
+      Const("letrec2",dummyT) $ absfree(x,T,absfree(y,U,absfree(f,S,a))) $ absfree(f,S,b);
+fun letrec3_tr [Free(f,S),Free(x,T),Free(y,U),Free(z,V),a,b] = 
+      Const("letrec3",dummyT) $ absfree(x,T,absfree(y,U,absfree(z,U,absfree(f,S,a)))) $ absfree(f,S,b);
+
+fun letrec_tr' [Abs(x,T,Abs(f,S,a)),Abs(ff,SS,b)] =
+     let val (f',b')  = variant_abs(ff,SS,b)
+         val (_,a'') = variant_abs(f,S,a)
+         val (x',a')  = variant_abs(x,T,a'')
+     in Const("@letrec",dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end;
+fun letrec2_tr' [Abs(x,T,Abs(y,U,Abs(f,S,a))),Abs(ff,SS,b)] =
+     let val (f',b') = variant_abs(ff,SS,b)
+         val ( _,a1) = variant_abs(f,S,a)
+         val (y',a2) = variant_abs(y,U,a1)
+         val (x',a') = variant_abs(x,T,a2)
+     in Const("@letrec2",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b'
+      end;
+fun letrec3_tr' [Abs(x,T,Abs(y,U,Abs(z,V,Abs(f,S,a)))),Abs(ff,SS,b)] =
+     let val (f',b') = variant_abs(ff,SS,b)
+         val ( _,a1) = variant_abs(f,S,a)
+         val (z',a2) = variant_abs(z,V,a1)
+         val (y',a3) = variant_abs(y,U,a2)
+         val (x',a') = variant_abs(x,T,a3)
+     in Const("@letrec3",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b'
+      end;
+
+val  parse_translation=
+    [("@let",       let_tr),
+     ("@letrec",    letrec_tr),
+     ("@letrec2",   letrec2_tr),
+     ("@letrec3",   letrec3_tr)
+    ];
+val print_translation=
+    [("let",       let_tr'),
+     ("letrec",    letrec_tr'),
+     ("letrec2",   letrec2_tr'),
+     ("letrec3",   letrec3_tr')
+    ];
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Trancl.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,215 @@
+(*  Title: 	CCL/trancl
+    ID:         $Id$
+
+For trancl.thy.
+
+Modified version of
+    Title: 	HOL/trancl.ML
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+*)
+
+open Trancl;
+
+(** Natural deduction for trans(r) **)
+
+val prems = goalw Trancl.thy [trans_def]
+    "(!! x y z. [| <x,y>:r;  <y,z>:r |] ==> <x,z>:r) ==> trans(r)";
+by (REPEAT (ares_tac (prems@[allI,impI]) 1));
+val transI = result();
+
+val major::prems = goalw Trancl.thy [trans_def]
+    "[| trans(r);  <a,b>:r;  <b,c>:r |] ==> <a,c>:r";
+by (cut_facts_tac [major] 1);
+by (fast_tac (FOL_cs addIs prems) 1);
+val transD = result();
+
+(** Identity relation **)
+
+goalw Trancl.thy [id_def] "<a,a> : id";  
+by (rtac CollectI 1);
+by (rtac exI 1);
+by (rtac refl 1);
+val idI = result();
+
+val major::prems = goalw Trancl.thy [id_def]
+    "[| p: id;  !!x.[| p = <x,x> |] ==> P  \
+\    |] ==>  P";  
+by (rtac (major RS CollectE) 1);
+by (etac exE 1);
+by (eresolve_tac prems 1);
+val idE = result();
+
+(** Composition of two relations **)
+
+val prems = goalw Trancl.thy [comp_def]
+    "[| <a,b>:s; <b,c>:r |] ==> <a,c> : r O s";
+by (fast_tac (set_cs addIs prems) 1);
+val compI = result();
+
+(*proof requires higher-level assumptions or a delaying of hyp_subst_tac*)
+val prems = goalw Trancl.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 prems = goal Trancl.thy
+    "[| <a,c> : r O s;  \
+\       !!y. [| <a,y>:s;  <y,c>:r |] ==> P \
+\    |] ==> P";
+by (rtac compE 1);
+by (REPEAT (ares_tac prems 1 ORELSE eresolve_tac [pair_inject,ssubst] 1));
+val compEpair = result();
+
+val comp_cs = set_cs addIs [compI,idI] 
+		       addEs [compE,idE] 
+		       addSEs [pair_inject];
+
+val prems = goal Trancl.thy
+    "[| r'<=r; s'<=s |] ==> (r' O s') <= (r O s)";
+by (cut_facts_tac prems 1);
+by (fast_tac comp_cs 1);
+val comp_mono = result();
+
+(** The relation rtrancl **)
+
+goal Trancl.thy "mono(%s. id Un (r O s))";
+by (rtac monoI 1);
+by (REPEAT (ares_tac [monoI, subset_refl, comp_mono, Un_mono] 1));
+val rtrancl_fun_mono = result();
+
+val rtrancl_unfold = rtrancl_fun_mono RS (rtrancl_def RS def_lfp_Tarski);
+
+(*Reflexivity of rtrancl*)
+goal Trancl.thy "<a,a> : r^*";
+br (rtrancl_unfold RS ssubst) 1;
+by (fast_tac comp_cs 1);
+val rtrancl_refl = result();
+
+(*Closure under composition with r*)
+val prems = goal Trancl.thy
+    "[| <a,b> : r^*;  <b,c> : r |] ==> <a,c> : r^*";
+br (rtrancl_unfold RS ssubst) 1;
+by (fast_tac (comp_cs addIs prems) 1);
+val rtrancl_into_rtrancl = result();
+
+(*rtrancl of r contains r*)
+val [prem] = goal Trancl.thy "[| <a,b> : r |] ==> <a,b> : r^*";
+by (rtac (rtrancl_refl RS rtrancl_into_rtrancl) 1);
+by (rtac prem 1);
+val r_into_rtrancl = result();
+
+
+(** standard induction rule **)
+
+val major::prems = goal Trancl.thy 
+  "[| <a,b> : r^*; \
+\     !!x. P(<x,x>); \
+\     !!x y z.[| P(<x,y>); <x,y>: r^*; <y,z>: r |]  ==>  P(<x,z>) |] \
+\  ==>  P(<a,b>)";
+by (rtac (major RS (rtrancl_def RS def_induct)) 1);
+by (rtac rtrancl_fun_mono 1);
+by (fast_tac (comp_cs addIs prems) 1);
+val rtrancl_full_induct = result();
+
+(*nice induction rule*)
+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 (fast_tac FOL_cs 1);
+(*now do the induction*)
+by (resolve_tac [major RS rtrancl_full_induct] 1);
+by (fast_tac (comp_cs addIs prems) 1);
+by (fast_tac (comp_cs addIs prems) 1);
+val rtrancl_induct = result();
+
+(*transitivity of transitive closure!! -- by induction.*)
+goal Trancl.thy "trans(r^*)";
+by (rtac transI 1);
+by (res_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);
+by (rtac (major RS rtrancl_induct) 2);
+by (fast_tac (set_cs addIs prems) 2);
+by (fast_tac (set_cs addIs prems) 2);
+by (REPEAT (eresolve_tac ([asm_rl,exE,disjE,conjE]@prems) 1));
+val rtranclE = result();
+
+
+(**** The relation trancl ****)
+
+(** 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 r*)
+val [prem] = goalw Trancl.thy [trancl_def]
+   "[| <a,b> : r |] ==> <a,b> : r^+";
+by (REPEAT (ares_tac [prem,compI,rtrancl_refl] 1));
+val r_into_trancl = result();
+
+(*intro rule by definition: from rtrancl 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 rtrancl*)
+val prems = goal Trancl.thy
+    "[| <a,b> : r;  <b,c> : r^* |]   ==>  <a,c> : r^+";
+by (resolve_tac (prems RL [rtranclE]) 1);
+by (etac subst 1);
+by (resolve_tac (prems RL [r_into_trancl]) 1);
+by (rtac (trans_rtrancl RS transD RS rtrancl_into_trancl1) 1);
+by (REPEAT (ares_tac (prems@[r_into_rtrancl]) 1));
+val rtrancl_into_trancl2 = 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 (REPEAT (eresolve_tac ([asm_rl,disjE,exE,conjE]@prems) 1));
+by (rtac (rewrite_rule [trancl_def] major RS compEpair) 1);
+by (etac rtranclE 1);
+by (fast_tac comp_cs 1);
+by (fast_tac (comp_cs addSIs [rtrancl_into_trancl1]) 1);
+val tranclE = result();
+
+(*Transitivity of r^+.
+  Proved by unfolding since it uses transitivity of rtrancl. *)
+goalw Trancl.thy [trancl_def] "trans(r^+)";
+by (rtac transI 1);
+by (REPEAT (etac compEpair 1));
+by (rtac (rtrancl_into_rtrancl RS (trans_rtrancl RS transD RS compI)) 1);
+by (REPEAT (assume_tac 1));
+val trans_trancl = result();
+
+val prems = goal Trancl.thy
+    "[| <a,b> : r;  <b,c> : r^+ |]   ==>  <a,c> : r^+";
+by (rtac (r_into_trancl RS (trans_trancl RS transD)) 1);
+by (resolve_tac prems 1);
+by (resolve_tac prems 1);
+val trancl_into_trancl2 = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Trancl.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,28 @@
+(*  Title: 	CCL/trancl.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Transitive closure of a relation
+*)
+
+Trancl = CCL +
+
+consts
+    trans   :: "i set => o" 	              (*transitivity predicate*)
+    id	    :: "i set"
+    rtrancl :: "i set => i set"	              ("(_^*)" [100] 100)
+    trancl  :: "i set => i set"	              ("(_^+)" [100] 100)  
+    O	    :: "[i set,i set] => i set"       (infixr 60)
+
+rules   
+
+trans_def	"trans(r) == (ALL x y z. <x,y>:r --> <y,z>:r --> <x,z>:r)"
+comp_def	(*composition of relations*)
+		"r O s == {xz. EX x y z. xz = <x,z> & <x,y>:s & <y,z>:r}"
+id_def		(*the identity relation*)
+		"id == {p. EX x. p = <x,x>}"
+rtrancl_def	"r^* == lfp(%s. id Un (r O s))"
+trancl_def	"r^+ == r O rtrancl(r)"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Type.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,308 @@
+(*  Title: 	CCL/types
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+For types.thy.
+*)
+
+open Type;
+
+val simp_type_defs = [Subtype_def,Unit_def,Bool_def,Plus_def,Sigma_def,Pi_def,
+                      Lift_def,Tall_def,Tex_def];
+val ind_type_defs = [Nat_def,List_def];
+
+val simp_data_defs = [one_def,inl_def,inr_def];
+val ind_data_defs = [zero_def,succ_def,nil_def,cons_def];
+
+goal Set.thy "A <= B <-> (ALL x.x:A --> x:B)";
+by (fast_tac set_cs 1);
+val subsetXH = result();
+
+(*** Exhaustion Rules ***)
+
+fun mk_XH_tac thy defs rls s = prove_goalw thy defs s (fn _ => [cfast_tac rls 1]);
+val XH_tac = mk_XH_tac Type.thy simp_type_defs [];
+
+val EmptyXH = XH_tac "a : {} <-> False";
+val SubtypeXH = XH_tac "a : {x:A.P(x)} <-> (a:A & P(a))";
+val UnitXH = XH_tac "a : Unit          <-> a=one";
+val BoolXH = XH_tac "a : Bool          <-> a=true | a=false";
+val PlusXH = XH_tac "a : A+B           <-> (EX x:A.a=inl(x)) | (EX x:B.a=inr(x))";
+val PiXH   = XH_tac "a : PROD x:A.B(x) <-> (EX b.a=lam x.b(x) & (ALL x:A.b(x):B(x)))";
+val SgXH   = XH_tac "a : SUM x:A.B(x)  <-> (EX x:A.EX y:B(x).a=<x,y>)";
+
+val XHs = [EmptyXH,SubtypeXH,UnitXH,BoolXH,PlusXH,PiXH,SgXH];
+
+val LiftXH = XH_tac "a : [A] <-> (a=bot | a:A)";
+val TallXH = XH_tac "a : TALL X.B(X) <-> (ALL X. a:B(X))";
+val TexXH  = XH_tac "a : TEX X.B(X) <-> (EX X. a:B(X))";
+
+val case_rls = XH_to_Es XHs;
+
+(*** Canonical Type Rules ***)
+
+fun mk_canT_tac thy xhs s = prove_goal thy s 
+                 (fn prems => [fast_tac (set_cs addIs (prems @ (xhs RL [iffD2]))) 1]);
+val canT_tac = mk_canT_tac Type.thy XHs;
+
+val oneT   = canT_tac "one : Unit";
+val trueT  = canT_tac "true : Bool";
+val falseT = canT_tac "false : Bool";
+val lamT   = canT_tac "[| !!x.x:A ==> b(x):B(x) |] ==> lam x.b(x) : Pi(A,B)";
+val pairT  = canT_tac "[| a:A; b:B(a) |] ==> <a,b>:Sigma(A,B)";
+val inlT   = canT_tac "a:A ==> inl(a) : A+B";
+val inrT   = canT_tac "b:B ==> inr(b) : A+B";
+
+val canTs = [oneT,trueT,falseT,pairT,lamT,inlT,inrT];
+
+(*** Non-Canonical Type Rules ***)
+
+local
+val lemma = prove_goal Type.thy "[| a:B(u);  u=v |] ==> a : B(v)"
+                   (fn prems => [cfast_tac prems 1]);
+in
+fun mk_ncanT_tac thy defs top_crls crls s = prove_goalw thy defs s 
+  (fn major::prems => [(resolve_tac ([major] RL top_crls) 1),
+                       (REPEAT_SOME (eresolve_tac (crls @ [exE,bexE,conjE,disjE]))),
+                       (ALLGOALS (ASM_SIMP_TAC term_ss)),
+                       (ALLGOALS (ares_tac (prems RL [lemma]) ORELSE' 
+                                  eresolve_tac [bspec])),
+                       (safe_tac (ccl_cs addSIs prems))]);
+end;
+
+val ncanT_tac = mk_ncanT_tac Type.thy [] case_rls case_rls;
+
+val ifT = ncanT_tac 
+     "[| b:Bool; b=true ==> t:A(true); b=false ==> u:A(false) |] ==> \
+\     if b then t else u : A(b)";
+
+val applyT = ncanT_tac 
+    "[| f : Pi(A,B);  a:A |] ==> f ` a : B(a)";
+
+val splitT = ncanT_tac 
+    "[| p:Sigma(A,B); !!x y. [| x:A;  y:B(x); p=<x,y>  |] ==> c(x,y):C(<x,y>) |] ==>  \
+\     split(p,c):C(p)";
+
+val whenT = ncanT_tac 
+     "[| p:A+B; !!x.[| x:A;  p=inl(x) |] ==> a(x):C(inl(x)); \
+\               !!y.[| y:B;  p=inr(y) |] ==> b(y):C(inr(y)) |] ==> \
+\     when(p,a,b) : C(p)";
+
+val ncanTs = [ifT,applyT,splitT,whenT];
+
+(*** Subtypes ***)
+
+val SubtypeD1 = standard ((SubtypeXH RS iffD1) RS conjunct1);
+val SubtypeD2 = standard ((SubtypeXH RS iffD1) RS conjunct2);
+
+val prems = goal Type.thy
+     "[| a:A;  P(a) |] ==> a : {x:A. P(x)}";
+by (REPEAT (resolve_tac (prems@[SubtypeXH RS iffD2,conjI]) 1));
+val SubtypeI = result();
+
+val prems = goal Type.thy
+     "[| a : {x:A. P(x)};  [| a:A;  P(a) |] ==> Q |] ==> Q";
+by (REPEAT (resolve_tac (prems@[SubtypeD1,SubtypeD2]) 1));
+val SubtypeE = result();
+
+(*** Monotonicity ***)
+
+goal Type.thy "mono (%X.X)";
+by (REPEAT (ares_tac [monoI] 1));
+val idM = result();
+
+goal Type.thy "mono(%X.A)";
+by (REPEAT (ares_tac [monoI,subset_refl] 1));
+val constM = result();
+
+val major::prems = goal Type.thy
+    "mono(%X.A(X)) ==> mono(%X.[A(X)])";
+br (subsetI RS monoI) 1;
+bd (LiftXH RS iffD1) 1;
+be disjE 1;
+be (disjI1 RS (LiftXH RS iffD2)) 1;
+br (disjI2 RS (LiftXH RS iffD2)) 1;
+be (major RS monoD RS subsetD) 1;
+ba 1;
+val LiftM = result();
+
+val prems = goal Type.thy
+    "[| mono(%X.A(X)); !!x X. x:A(X) ==> mono(%X.B(X,x)) |] ==> \
+\    mono(%X.Sigma(A(X),B(X)))";
+by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE
+            eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE
+            (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE
+            hyp_subst_tac 1));
+val SgM = result();
+
+val prems = goal Type.thy
+    "[| !!x. x:A ==> mono(%X.B(X,x)) |] ==> mono(%X.Pi(A,B(X)))";
+by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE
+            eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE
+            (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE
+            hyp_subst_tac 1));
+val PiM = result();
+
+val prems = goal Type.thy
+     "[| mono(%X.A(X));  mono(%X.B(X)) |] ==> mono(%X.A(X)+B(X))";
+by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE
+            eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE
+            (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE
+            hyp_subst_tac 1));
+val PlusM = result();
+
+(**************** RECURSIVE TYPES ******************)
+
+(*** Conversion Rules for Fixed Points via monotonicity and Tarski ***)
+
+goal Type.thy "mono(%X.Unit+X)";
+by (REPEAT (ares_tac [PlusM,constM,idM] 1));
+val NatM = result();
+val def_NatB = result() RS (Nat_def RS def_lfp_Tarski);
+
+goal Type.thy "mono(%X.(Unit+Sigma(A,%y.X)))";
+by (REPEAT (ares_tac [PlusM,SgM,constM,idM] 1));
+val ListM = result();
+val def_ListB = result() RS (List_def RS def_lfp_Tarski);
+val def_ListsB = result() RS (Lists_def RS def_gfp_Tarski);
+
+goal Type.thy "mono(%X.({} + Sigma(A,%y.X)))";
+by (REPEAT (ares_tac [PlusM,SgM,constM,idM] 1));
+val IListsM = result();
+val def_IListsB = result() RS (ILists_def RS def_gfp_Tarski);
+
+val ind_type_eqs = [def_NatB,def_ListB,def_ListsB,def_IListsB];
+
+(*** Exhaustion Rules ***)
+
+fun mk_iXH_tac teqs ddefs rls s = prove_goalw Type.thy ddefs s 
+           (fn _ => [resolve_tac (teqs RL [XHlemma1]) 1,
+                     fast_tac (set_cs addSIs canTs addSEs case_rls) 1]);
+
+val iXH_tac = mk_iXH_tac ind_type_eqs ind_data_defs [];
+
+val NatXH  = iXH_tac "a : Nat <-> (a=zero | (EX x:Nat.a=succ(x)))";
+val ListXH = iXH_tac "a : List(A) <-> (a=[] | (EX x:A.EX xs:List(A).a=x.xs))";
+val ListsXH = iXH_tac "a : Lists(A) <-> (a=[] | (EX x:A.EX xs:Lists(A).a=x.xs))";
+val IListsXH = iXH_tac "a : ILists(A) <-> (EX x:A.EX xs:ILists(A).a=x.xs)";
+
+val iXHs = [NatXH,ListXH];
+val icase_rls = XH_to_Es iXHs;
+
+(*** Type Rules ***)
+
+val icanT_tac = mk_canT_tac Type.thy iXHs;
+val incanT_tac = mk_ncanT_tac Type.thy [] icase_rls case_rls;
+
+val zeroT = icanT_tac "zero : Nat";
+val succT = icanT_tac "n:Nat ==> succ(n) : Nat";
+val nilT  = icanT_tac "[] : List(A)";
+val consT = icanT_tac "[| h:A;  t:List(A) |] ==> h.t : List(A)";
+
+val icanTs = [zeroT,succT,nilT,consT];
+
+val ncaseT = incanT_tac 
+     "[| n:Nat; n=zero ==> b:C(zero); \
+\        !!x.[| x:Nat;  n=succ(x) |] ==> c(x):C(succ(x)) |] ==>  \
+\     ncase(n,b,c) : C(n)";
+
+val lcaseT = incanT_tac
+     "[| l:List(A); l=[] ==> b:C([]); \
+\        !!h t.[| h:A;  t:List(A); l=h.t |] ==> c(h,t):C(h.t) |] ==> \
+\     lcase(l,b,c) : C(l)";
+
+val incanTs = [ncaseT,lcaseT];
+
+(*** Induction Rules ***)
+
+val ind_Ms = [NatM,ListM];
+
+fun mk_ind_tac ddefs tdefs Ms canTs case_rls s = prove_goalw Type.thy ddefs s 
+     (fn major::prems => [resolve_tac (Ms RL ([major] RL (tdefs RL [def_induct]))) 1,
+                          fast_tac (set_cs addSIs (prems @ canTs) addSEs case_rls) 1]);
+
+val ind_tac = mk_ind_tac ind_data_defs ind_type_defs ind_Ms canTs case_rls;
+
+val Nat_ind = ind_tac
+     "[| n:Nat; P(zero); !!x.[| x:Nat; P(x) |] ==> P(succ(x)) |] ==>  \
+\     P(n)";
+
+val List_ind = ind_tac
+     "[| l:List(A); P([]); \
+\        !!x xs.[| x:A;  xs:List(A); P(xs) |] ==> P(x.xs) |] ==> \
+\     P(l)";
+
+val inds = [Nat_ind,List_ind];
+
+(*** Primitive Recursive Rules ***)
+
+fun mk_prec_tac inds s = prove_goal Type.thy s
+     (fn major::prems => [resolve_tac ([major] RL inds) 1,
+                          ALLGOALS (SIMP_TAC term_ss THEN'
+                                    fast_tac (set_cs addSIs prems))]);
+val prec_tac = mk_prec_tac inds;
+
+val nrecT = prec_tac
+     "[| n:Nat; b:C(zero); \
+\        !!x g.[| x:Nat; g:C(x) |] ==> c(x,g):C(succ(x)) |] ==>  \
+\     nrec(n,b,c) : C(n)";
+
+val lrecT = prec_tac
+     "[| l:List(A); b:C([]); \
+\        !!x xs g.[| x:A;  xs:List(A); g:C(xs) |] ==> c(x,xs,g):C(x.xs) |] ==>  \
+\     lrec(l,b,c) : C(l)";
+
+val precTs = [nrecT,lrecT];
+
+
+(*** Theorem proving ***)
+
+val [major,minor] = goal Type.thy
+    "[| <a,b> : Sigma(A,B);  [| a:A;  b:B(a) |] ==> P   \
+\    |] ==> P";
+br (major RS (XH_to_E SgXH)) 1;
+br minor 1;
+by (ALLGOALS (fast_tac term_cs));
+val SgE2 = result();
+
+(* General theorem proving ignores non-canonical term-formers,             *)
+(*         - intro rules are type rules for canonical terms                *)
+(*         - elim rules are case rules (no non-canonical terms appear)     *)
+
+val type_cs = term_cs addSIs (SubtypeI::(canTs @ icanTs))
+                      addSEs (SubtypeE::(XH_to_Es XHs));
+
+
+(*** Infinite Data Types ***)
+
+val [mono] = goal Type.thy "mono(f) ==> lfp(f) <= gfp(f)";
+br (lfp_lowerbound RS subset_trans) 1;
+br (mono RS gfp_lemma3) 1;
+br subset_refl 1;
+val lfp_subset_gfp = result();
+
+val prems = goal Type.thy
+    "[| a:A;  !!x X.[| x:A;  ALL y:A.t(y):X |] ==> t(x) : B(X) |] ==> \
+\    t(a) : gfp(B)";
+br coinduct 1;
+by (res_inst_tac [("P","%x.EX y:A.x=t(y)")] CollectI 1);
+by (ALLGOALS (fast_tac (ccl_cs addSIs prems)));
+val gfpI = result();
+
+val rew::prem::prems = goal Type.thy
+    "[| C==gfp(B);  a:A;  !!x X.[| x:A;  ALL y:A.t(y):X |] ==> t(x) : B(X) |] ==> \
+\    t(a) : C";
+by (rewtac rew);
+by (REPEAT (ares_tac ((prem RS gfpI)::prems) 1));
+val def_gfpI = result();
+
+(* EG *)
+
+val prems = goal Type.thy 
+    "letrec g x be zero.g(x) in g(bot) : Lists(Nat)";
+by (rtac (refl RS (XH_to_I UnitXH) RS (Lists_def RS def_gfpI)) 1);
+br (letrecB RS ssubst) 1;
+bw cons_def;
+by (fast_tac type_cs 1);
+result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Type.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,73 @@
+(*  Title:      CCL/types.thy
+    ID:         $Id$
+    Author:     Martin Coen
+    Copyright   1993  University of Cambridge
+
+Types in CCL are defined as sets of terms.
+
+*)
+
+Type = Term +
+
+consts
+
+  Subtype       :: "['a set, 'a => o] => 'a set"
+  Bool          :: "i set"
+  Unit          :: "i set"
+  "+"           :: "[i set, i set] => i set"            (infixr 55)
+  Pi            :: "[i set, i => i set] => i set"
+  Sigma         :: "[i set, i => i set] => i set"
+  Nat           :: "i set"
+  List          :: "i set => i set"
+  Lists         :: "i set => i set"
+  ILists        :: "i set => i set"
+  TAll          :: "(i set => i set) => i set"          (binder "TALL " 55)
+  TEx           :: "(i set => i set) => i set"          (binder "TEX " 55)
+  Lift          :: "i set => i set"                     ("(3[_])")
+
+  SPLIT         :: "[i, [i, i] => i set] => i set"
+
+  "@Pi"         :: "[idt, i set, i set] => i set"       ("(3PROD _:_./ _)" [] 60)
+  "@Sigma"      :: "[idt, i set, i set] => i set"       ("(3SUM _:_./ _)" [] 60)
+  "@->"         :: "[i set, i set] => i set"            ("(_ ->/ _)"  [54, 53] 53)
+  "@*"          :: "[i set, i set] => i set"            ("(_ */ _)" [56, 55] 55)
+  "@Subtype"    :: "[idt, 'a set, o] => 'a set"         ("(1{_: _ ./ _})")
+
+translations
+  "PROD x:A. B" => "Pi(A, %x. B)"
+  "SUM x:A. B"  => "Sigma(A, %x. B)"
+  "{x: A. B}"   == "Subtype(A, %x. B)"
+
+rules
+
+  Subtype_def "{x:A.P(x)} == {x.x:A & P(x)}"
+  Unit_def          "Unit == {x.x=one}"
+  Bool_def          "Bool == {x.x=true | x=false}"
+  Plus_def           "A+B == {x. (EX a:A.x=inl(a)) | (EX b:B.x=inr(b))}"
+  Pi_def         "Pi(A,B) == {x.EX b.x=lam x.b(x) & (ALL x:A.b(x):B(x))}"
+  Sigma_def   "Sigma(A,B) == {x.EX a:A.EX b:B(a).x=<a,b>}"
+  Nat_def            "Nat == lfp(% X.Unit + X)"
+  List_def       "List(A) == lfp(% X.Unit + A*X)"
+
+  Lists_def     "Lists(A) == gfp(% X.Unit + A*X)"
+  ILists_def   "ILists(A) == gfp(% X.{} + A*X)"
+
+  Tall_def   "TALL X.B(X) == Inter({X.EX Y.X=B(Y)})"
+  Tex_def     "TEX X.B(X) == Union({X.EX Y.X=B(Y)})"
+  Lift_def           "[A] == A Un {bot}"
+
+  SPLIT_def   "SPLIT(p,B) == Union({A.EX x y.p=<x,y> & A=B(x,y)})"
+
+end
+
+
+ML
+
+val parse_translation =
+  [("@->", ndependent_tr "Pi"),
+   ("@*", ndependent_tr "Sigma")];
+
+val print_translation =
+  [("Pi", dependent_tr' ("@Pi", "@->")),
+   ("Sigma", dependent_tr' ("@Sigma", "@*"))];
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Wfd.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,208 @@
+(*  Title: 	CCL/wf
+    ID:         $Id$
+
+For wf.thy.
+
+Based on
+    Titles: 	ZF/wf.ML and HOL/ex/lex-prod
+    Authors: 	Lawrence C Paulson and Tobias Nipkow
+    Copyright   1992  University of Cambridge
+
+*)
+
+open Wfd;
+
+(***********)
+
+val wfd_congs = mk_congs Wfd.thy ["Wfd","wf","op **","wmap","ListPR"];
+
+(***********)
+
+val [major,prem] = goalw Wfd.thy [Wfd_def]
+    "[| Wfd(R);       \
+\       !!x.[| ALL y. <y,x>: R --> P(y) |] ==> P(x) |]  ==>  \
+\    P(a)";
+by (rtac (major RS spec RS mp RS spec RS CollectD) 1);
+by (fast_tac (set_cs addSIs [prem RS CollectI]) 1);
+val wfd_induct = result();
+
+val [p1,p2,p3] = goal Wfd.thy
+    "[| !!x y.<x,y> : R ==> Q(x); \
+\       ALL x. (ALL y. <y,x> : R --> y : P) --> x : P; \
+\       !!x.Q(x) ==> x:P |] ==> a:P";
+br (p2 RS  spec  RS mp) 1;
+by (fast_tac (set_cs addSIs [p1 RS p3]) 1);
+val wfd_strengthen_lemma = result();
+
+fun wfd_strengthen_tac s i = res_inst_tac [("Q",s)] wfd_strengthen_lemma i THEN
+                             assume_tac (i+1);
+
+val wfd::prems = goal Wfd.thy "[| Wfd(r);  <a,x>:r;  <x,a>:r |] ==> P";
+by (subgoal_tac "ALL x. <a,x>:r --> <x,a>:r --> P" 1);
+by (fast_tac (FOL_cs addIs prems) 1);
+br (wfd RS  wfd_induct) 1;
+by (ALLGOALS (fast_tac (ccl_cs addSIs prems)));
+val wf_anti_sym = result();
+
+val prems = goal Wfd.thy "[| Wfd(r);  <a,a>: r |] ==> P";
+by (rtac wf_anti_sym 1);
+by (REPEAT (resolve_tac prems 1));
+val wf_anti_refl = result();
+
+(*** Irreflexive transitive closure ***)
+
+val [prem] = goal Wfd.thy "Wfd(R) ==> Wfd(R^+)";
+by (rewtac Wfd_def);
+by (REPEAT (ares_tac [allI,ballI,impI] 1));
+(*must retain the universal formula for later use!*)
+by (rtac allE 1 THEN assume_tac 1);
+by (etac mp 1);
+br (prem RS wfd_induct) 1;
+by (rtac (impI RS allI) 1);
+by (etac tranclE 1);
+by (fast_tac ccl_cs 1);
+be (spec RS mp RS spec RS mp) 1;
+by (REPEAT (atac 1));
+val trancl_wf = result();
+
+(*** Lexicographic Ordering ***)
+
+goalw Wfd.thy [lex_def] 
+ "p : ra**rb <-> (EX a a' b b'.p = <<a,b>,<a',b'>> & (<a,a'> : ra | a=a' & <b,b'> : rb))";
+by (fast_tac ccl_cs 1);
+val lexXH = result();
+
+val prems = goal Wfd.thy
+ "<a,a'> : ra ==> <<a,b>,<a',b'>> : ra**rb";
+by (fast_tac (ccl_cs addSIs (prems @ [lexXH RS iffD2])) 1);
+val lexI1 = result();
+
+val prems = goal Wfd.thy
+ "<b,b'> : rb ==> <<a,b>,<a,b'>> : ra**rb";
+by (fast_tac (ccl_cs addSIs (prems @ [lexXH RS iffD2])) 1);
+val lexI2 = result();
+
+val major::prems = goal Wfd.thy
+ "[| p : ra**rb;  \
+\    !!a a' b b'.[| <a,a'> : ra; p=<<a,b>,<a',b'>> |] ==> R;  \
+\    !!a b b'.[| <b,b'> : rb;  p = <<a,b>,<a,b'>> |] ==> R  |] ==> \
+\ R";
+br (major RS (lexXH RS iffD1) RS exE) 1;
+by (REPEAT_SOME (eresolve_tac ([exE,conjE,disjE]@prems)));
+by (ALLGOALS (fast_tac ccl_cs));
+val lexE = result();
+
+val [major,minor] = goal Wfd.thy
+ "[| p : r**s;  !!a a' b b'. p = <<a,b>,<a',b'>> ==> P |] ==>P";
+br (major RS lexE) 1;
+by (ALLGOALS (fast_tac (set_cs addSEs [minor])));
+val lex_pair = result();
+
+val [wfa,wfb] = goal Wfd.thy
+ "[| Wfd(R); Wfd(S) |] ==> Wfd(R**S)";
+bw Wfd_def;
+by (safe_tac ccl_cs);
+by (wfd_strengthen_tac "%x.EX a b.x=<a,b>" 1);
+by (fast_tac (term_cs addSEs [lex_pair]) 1);
+by (subgoal_tac "ALL a b.<a,b>:P" 1);
+by (fast_tac ccl_cs 1);
+br (wfa RS wfd_induct RS allI) 1;
+br (wfb RS wfd_induct RS allI) 1;back();
+by (fast_tac (type_cs addSEs [lexE]) 1);
+val lex_wf = result();
+
+(*** Mapping ***)
+
+goalw Wfd.thy [wmap_def] 
+ "p : wmap(f,r) <-> (EX x y. p=<x,y>  &  <f(x),f(y)> : r)";
+by (fast_tac ccl_cs 1);
+val wmapXH = result();
+
+val prems = goal Wfd.thy
+ "<f(a),f(b)> : r ==> <a,b> : wmap(f,r)";
+by (fast_tac (ccl_cs addSIs (prems @ [wmapXH RS iffD2])) 1);
+val wmapI = result();
+
+val major::prems = goal Wfd.thy
+ "[| p : wmap(f,r);  !!a b.[| <f(a),f(b)> : r;  p=<a,b> |] ==> R |] ==> R";
+br (major RS (wmapXH RS iffD1) RS exE) 1;
+by (REPEAT_SOME (eresolve_tac ([exE,conjE,disjE]@prems)));
+by (ALLGOALS (fast_tac ccl_cs));
+val wmapE = result();
+
+val [wf] = goal Wfd.thy
+ "Wfd(r) ==> Wfd(wmap(f,r))";
+bw Wfd_def;
+by (safe_tac ccl_cs);
+by (subgoal_tac "ALL b.ALL a.f(a)=b-->a:P" 1);
+by (fast_tac ccl_cs 1);
+br (wf RS wfd_induct RS allI) 1;
+by (safe_tac ccl_cs);
+be (spec RS mp) 1;
+by (safe_tac (ccl_cs addSEs [wmapE]));
+be (spec RS mp RS spec RS mp) 1;
+ba 1;
+br refl 1;
+val wmap_wf = result();
+
+(* Projections *)
+
+val prems = goal Wfd.thy "<xa,ya> : r ==> <<xa,xb>,<ya,yb>> : wmap(fst,r)";
+br wmapI 1;
+by (SIMP_TAC (term_ss addrews prems) 1);
+val wfstI = result();
+
+val prems = goal Wfd.thy "<xb,yb> : r ==> <<xa,xb>,<ya,yb>> : wmap(snd,r)";
+br wmapI 1;
+by (SIMP_TAC (term_ss addrews prems) 1);
+val wsndI = result();
+
+val prems = goal Wfd.thy "<xc,yc> : r ==> <<xa,<xb,xc>>,<ya,<yb,yc>>> : wmap(thd,r)";
+br wmapI 1;
+by (SIMP_TAC (term_ss addrews prems) 1);
+val wthdI = result();
+
+(*** Ground well-founded relations ***)
+
+val prems = goalw Wfd.thy [wf_def] 
+    "[| Wfd(r);  a : r |] ==> a : wf(r)";
+by (fast_tac (set_cs addSIs prems) 1);
+val wfI = result();
+
+val prems = goalw Wfd.thy [Wfd_def] "Wfd({})";
+by (fast_tac (set_cs addEs [EmptyXH RS iffD1 RS FalseE]) 1);
+val Empty_wf = result();
+
+val prems = goalw Wfd.thy [wf_def] "Wfd(wf(R))";
+by (res_inst_tac [("Q","Wfd(R)")] (excluded_middle RS disjE) 1);
+by (ALLGOALS (ASM_SIMP_TAC (CCL_ss addcongs wfd_congs)));
+br Empty_wf 1;
+val wf_wf = result();
+
+goalw Wfd.thy [NatPR_def]  "p : NatPR <-> (EX x:Nat.p=<x,succ(x)>)";
+by (fast_tac set_cs 1);
+val NatPRXH = result();
+
+goalw Wfd.thy [ListPR_def]  "p : ListPR(A) <-> (EX h:A.EX t:List(A).p=<t,h.t>)";
+by (fast_tac set_cs 1);
+val ListPRXH = result();
+
+val NatPRI = refl RS (bexI RS (NatPRXH RS iffD2));
+val ListPRI = refl RS (bexI RS (bexI RS (ListPRXH RS iffD2)));
+
+goalw Wfd.thy [Wfd_def]  "Wfd(NatPR)";
+by (safe_tac set_cs);
+by (wfd_strengthen_tac "%x.x:Nat" 1);
+by (fast_tac (type_cs addSEs [XH_to_E NatPRXH]) 1);
+be Nat_ind 1;
+by (ALLGOALS (fast_tac (type_cs addEs [XH_to_E NatPRXH])));
+val NatPR_wf = result();
+
+goalw Wfd.thy [Wfd_def]  "Wfd(ListPR(A))";
+by (safe_tac set_cs);
+by (wfd_strengthen_tac "%x.x:List(A)" 1);
+by (fast_tac (type_cs addSEs [XH_to_E ListPRXH]) 1);
+be List_ind 1;
+by (ALLGOALS (fast_tac (type_cs addEs [XH_to_E ListPRXH])));
+val ListPR_wf = result();
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/Wfd.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,34 @@
+(*  Title: 	CCL/wf.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Well-founded relations in CCL.
+*)
+
+Wfd = Trancl + Type +
+
+consts
+      (*** Predicates ***)
+  Wfd        ::       "[i set] => o"
+      (*** Relations ***)
+  wf         ::       "[i set] => i set"
+  wmap       ::       "[i=>i,i set] => i set"
+  "**"       ::       "[i set,i set] => i set"      (infixl 70)
+  NatPR      ::       "i set"
+  ListPR     ::       "i set => i set"
+
+rules
+
+  Wfd_def
+  "Wfd(R) == ALL P.(ALL x.(ALL y.<y,x> : R --> y:P) --> x:P) --> (ALL a.a:P)"
+
+  wf_def         "wf(R) == {x.x:R & Wfd(R)}"
+
+  wmap_def       "wmap(f,R) == {p. EX x y. p=<x,y>  &  <f(x),f(y)> : R}"
+  lex_def
+  "ra**rb == {p. EX a a' b b'.p = <<a,b>,<a',b'>> & (<a,a'> : ra | (a=a' & <b,b'> : rb))}"
+
+  NatPR_def      "NatPR == {p.EX x:Nat. p=<x,succ(x)>}"
+  ListPR_def     "ListPR(A) == {p.EX h:A.EX t:List(A). p=<t,h.t>}"
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ccl.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,362 @@
+(*  Title: 	CCL/ccl
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For ccl.thy.
+*)
+
+open CCL;
+
+val ccl_data_defs = [apply_def,fix_def];
+
+(*** Simplifier for pre-order and equality ***)
+
+structure CCL_SimpData : SIMP_DATA =
+  struct
+  val refl_thms		= [refl, po_refl, iff_refl]
+  val trans_thms	= [trans, iff_trans, po_trans]
+  val red1		= iffD1
+  val red2		= iffD2
+  val mk_rew_rules	= mk_rew_rules
+  val case_splits	= []         (*NO IF'S!*)
+  val norm_thms		= norm_thms
+  val subst_thms	= [subst];
+  val dest_red		= dest_red
+  end;
+
+structure CCL_Simp = SimpFun(CCL_SimpData);
+open CCL_Simp;
+
+val auto_ss = empty_ss setauto (fn hyps => ares_tac (TrueI::hyps));
+
+val po_refl_iff_T = make_iff_T po_refl;
+
+val CCL_ss = auto_ss addcongs (FOL_congs @ set_congs)
+                     addrews  ([po_refl_iff_T] @ FOL_rews @ mem_rews);
+
+(*** Congruence Rules ***)
+
+(*similar to AP_THM in Gordon's HOL*)
+val fun_cong = prove_goal CCL.thy "(f::'a=>'b) = g ==> f(x)=g(x)"
+  (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
+
+(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
+val arg_cong = prove_goal CCL.thy "x=y ==> f(x)=f(y)"
+ (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
+
+goal CCL.thy  "(ALL x. f(x) = g(x)) --> (%x.f(x)) = (%x.g(x))";
+by (SIMP_TAC (CCL_ss addrews [eq_iff]) 1);
+by (fast_tac (set_cs addIs [po_abstractn]) 1);
+val abstractn = standard (allI RS (result() RS mp));
+
+fun type_of_terms (Const("Trueprop",_) $ 
+                   (Const("op =",(Type ("fun", [t,_]))) $ _ $ _)) = t;
+
+fun abs_prems thm = 
+   let fun do_abs n thm (Type ("fun", [_,t])) = do_abs n (abstractn RSN (n,thm)) t
+         | do_abs n thm _                     = thm
+       fun do_prems n      [] thm = thm
+         | do_prems n (x::xs) thm = do_prems (n+1) xs (do_abs n thm (type_of_terms x));
+   in do_prems 1 (prems_of thm) thm
+   end;
+
+fun ccl_mk_congs thy cs = map abs_prems (mk_congs thy cs); 
+
+val ccl_congs = ccl_mk_congs CCL.thy 
+ ["op [=","SIM","POgen","EQgen","pair","lambda","case","op `","fix"];
+
+val caseBs = [caseBtrue,caseBfalse,caseBpair,caseBlam,caseBbot];
+
+(*** Termination and Divergence ***)
+
+goalw CCL.thy [Trm_def,Dvg_def] "Trm(t) <-> ~ t = bot";
+br iff_refl 1;
+val Trm_iff = result();
+
+goalw CCL.thy [Trm_def,Dvg_def] "Dvg(t) <-> t = bot";
+br iff_refl 1;
+val Dvg_iff = result();
+
+(*** Constructors are injective ***)
+
+val prems = goal CCL.thy
+    "[| x=a;  y=b;  x=y |] ==> a=b";
+by  (REPEAT (SOMEGOAL (ares_tac (prems@[box_equals]))));
+val eq_lemma = result();
+
+fun mk_inj_rl thy rews congs s = 
+      let fun mk_inj_lemmas r = ([arg_cong] RL [(r RS (r RS eq_lemma))]);
+          val inj_lemmas = flat (map mk_inj_lemmas rews);
+          val tac = REPEAT (ares_tac [iffI,allI,conjI] 1 ORELSE
+                            eresolve_tac inj_lemmas 1 ORELSE
+                            ASM_SIMP_TAC (CCL_ss addrews rews 
+                                                 addcongs congs) 1)
+      in prove_goal thy s (fn _ => [tac])
+      end;
+
+val ccl_injs = map (mk_inj_rl CCL.thy caseBs ccl_congs)
+               ["<a,b> = <a',b'> <-> (a=a' & b=b')",
+                "(lam x.b(x) = lam x.b'(x)) <-> ((ALL z.b(z)=b'(z)))"];
+
+val pair_inject = ((hd ccl_injs) RS iffD1) RS conjE;
+
+(*** Constructors are distinct ***)
+
+local
+  fun pairs_of f x [] = []
+    | pairs_of f x (y::ys) = (f x y) :: (f y x) :: (pairs_of f x ys);
+
+  fun mk_combs ff [] = []
+    | mk_combs ff (x::xs) = (pairs_of ff x xs) @ mk_combs ff xs;
+
+(* Doesn't handle binder types correctly *)
+  fun saturate thy sy name = 
+       let fun arg_str 0 a s = s
+         | arg_str 1 a s = "(" ^ a ^ "a" ^ s ^ ")"
+         | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s);
+           val sg = sign_of thy;
+           val T = case Sign.Symtab.lookup(#const_tab(Sign.rep_sg sg),sy) of
+  		            None => error(sy^" not declared") | Some(T) => T;
+           val arity = length (fst (strip_type T));
+       in sy ^ (arg_str arity name "") end;
+
+  fun mk_thm_str thy a b = "~ " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b");
+
+  val lemma = prove_goal CCL.thy "t=t' --> case(t,b,c,d,e) = case(t',b,c,d,e)"
+                   (fn _ => [SIMP_TAC (CCL_ss addcongs ccl_congs) 1]) RS mp;
+  fun mk_lemma (ra,rb) = [lemma] RL [ra RS (rb RS eq_lemma)] RL 
+                           [distinctness RS notE,sym RS (distinctness RS notE)];
+in
+  fun mk_lemmas rls = flat (map mk_lemma (mk_combs pair rls));
+  fun mk_dstnct_rls thy xs = mk_combs (mk_thm_str thy) xs;
+end;
+
+
+val caseB_lemmas = mk_lemmas caseBs;
+
+val ccl_dstncts = 
+        let fun mk_raw_dstnct_thm rls s = 
+                  prove_goal CCL.thy s (fn _=> [rtac notI 1,eresolve_tac rls 1])
+        in map (mk_raw_dstnct_thm caseB_lemmas) 
+                (mk_dstnct_rls CCL.thy ["bot","true","false","pair","lambda"]) end;
+
+fun mk_dstnct_thms thy defs inj_rls xs = 
+          let fun mk_dstnct_thm rls s = prove_goalw thy defs s 
+                               (fn _ => [SIMP_TAC (CCL_ss addrews (rls@inj_rls)) 1])
+          in map (mk_dstnct_thm ccl_dstncts) (mk_dstnct_rls thy xs) end;
+
+fun mkall_dstnct_thms thy defs i_rls xss = flat (map (mk_dstnct_thms thy defs i_rls) xss);
+
+(*** Rewriting and Proving ***)
+
+fun XH_to_I rl = rl RS iffD2;
+fun XH_to_D rl = rl RS iffD1;
+val XH_to_E = make_elim o XH_to_D;
+val XH_to_Is = map XH_to_I;
+val XH_to_Ds = map XH_to_D;
+val XH_to_Es = map XH_to_E;
+
+val ccl_rews = caseBs @ ccl_injs @ ccl_dstncts;
+val ccl_ss = CCL_ss addrews ccl_rews addcongs ccl_congs;
+
+val ccl_cs = set_cs addSEs (pair_inject::(ccl_dstncts RL [notE])) 
+                    addSDs (XH_to_Ds ccl_injs);
+
+(****** Facts from gfp Definition of [= and = ******)
+
+val major::prems = goal Set.thy "[| A=B;  a:B <-> P |] ==> a:A <-> P";
+brs (prems RL [major RS ssubst]) 1;
+val XHlemma1 = result();
+
+goal CCL.thy "(P(t,t') <-> Q) --> (<t,t'> : {p.EX t t'.p=<t,t'> &  P(t,t')} <-> Q)";
+by (fast_tac ccl_cs 1);
+val XHlemma2 = result() RS mp;
+
+(*** Pre-Order ***)
+
+goalw CCL.thy [POgen_def,SIM_def]  "mono(%X.POgen(X))";
+br monoI 1;
+by (safe_tac ccl_cs);
+by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
+by (ALLGOALS (SIMP_TAC ccl_ss));
+by (ALLGOALS (fast_tac set_cs));
+val POgen_mono = result();
+
+goalw CCL.thy [POgen_def,SIM_def]
+  "<t,t'> : POgen(R) <-> t= bot | (t=true & t'=true)  | (t=false & t'=false) | \
+\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
+\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
+br (iff_refl RS XHlemma2) 1;
+val POgenXH = result();
+
+goal CCL.thy
+  "t [= t' <-> t=bot | (t=true & t'=true) | (t=false & t'=false) | \
+\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a [= a' & b [= b') | \
+\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x) [= f'(x)))";
+by (SIMP_TAC (ccl_ss addrews [PO_iff]) 1);
+br (rewrite_rule [POgen_def,SIM_def] 
+                 (POgen_mono RS (PO_def RS def_gfp_Tarski) RS XHlemma1)) 1;
+br (iff_refl RS XHlemma2) 1;
+val poXH = result();
+
+goal CCL.thy "bot [= b";
+br (poXH RS iffD2) 1;
+by (SIMP_TAC ccl_ss 1);
+val po_bot = result();
+
+goal CCL.thy "a [= bot --> a=bot";
+br impI 1;
+bd (poXH RS iffD1) 1;
+be rev_mp 1;
+by (SIMP_TAC ccl_ss 1);
+val bot_poleast = result() RS mp;
+
+goal CCL.thy "<a,b> [= <a',b'> <->  a [= a' & b [= b'";
+br (poXH RS iff_trans) 1;
+by (SIMP_TAC ccl_ss 1);
+by (fast_tac ccl_cs 1);
+val po_pair = result();
+
+goal CCL.thy "lam x.f(x) [= lam x.f'(x) <-> (ALL x. f(x) [= f'(x))";
+br (poXH RS iff_trans) 1;
+by (SIMP_TAC ccl_ss 1);
+by (REPEAT (ares_tac [iffI,allI] 1 ORELSE eresolve_tac [exE,conjE] 1));
+by (ASM_SIMP_TAC ccl_ss 1);
+by (fast_tac ccl_cs 1);
+val po_lam = result();
+
+val ccl_porews = [po_bot,po_pair,po_lam];
+
+val [p1,p2,p3,p4,p5] = goal CCL.thy
+    "[| t [= t';  a [= a';  b [= b';  !!x y.c(x,y) [= c'(x,y); \
+\       !!u.d(u) [= d'(u) |] ==> case(t,a,b,c,d) [= case(t',a',b',c',d')";
+br (p1 RS po_cong RS po_trans) 1;
+br (p2 RS po_cong RS po_trans) 1;
+br (p3 RS po_cong RS po_trans) 1;
+br (p4 RS po_abstractn RS po_abstractn RS po_cong RS po_trans) 1;
+by (res_inst_tac [("f1","%d.case(t',a',b',c',d)")] 
+               (p5 RS po_abstractn RS po_cong RS po_trans) 1);
+br po_refl 1;
+val case_pocong = result();
+
+val [p1,p2] = goalw CCL.thy ccl_data_defs
+    "[| f [= f';  a [= a' |] ==> f ` a [= f' ` a'";
+by (REPEAT (ares_tac [po_refl,case_pocong,p1,p2 RS po_cong] 1));
+val apply_pocong = result();
+
+
+val prems = goal CCL.thy "~ lam x.b(x) [= bot";
+br notI 1;
+bd bot_poleast 1;
+be (distinctness RS notE) 1;
+val npo_lam_bot = result();
+
+val eq1::eq2::prems = goal CCL.thy
+    "[| x=a;  y=b;  x[=y |] ==> a[=b";
+br (eq1 RS subst) 1;
+br (eq2 RS subst) 1;
+brs prems 1;
+val po_lemma = result();
+
+goal CCL.thy "~ <a,b> [= lam x.f(x)";
+br notI 1;
+br (npo_lam_bot RS notE) 1;
+be (case_pocong RS (caseBlam RS (caseBpair RS po_lemma))) 1;
+by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
+val npo_pair_lam = result();
+
+goal CCL.thy "~ lam x.f(x) [= <a,b>";
+br notI 1;
+br (npo_lam_bot RS notE) 1;
+be (case_pocong RS (caseBpair RS (caseBlam RS po_lemma))) 1;
+by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
+val npo_lam_pair = result();
+
+fun mk_thm s = prove_goal CCL.thy s (fn _ => 
+                          [rtac notI 1,dtac case_pocong 1,etac rev_mp 5,
+                           ALLGOALS (SIMP_TAC ccl_ss),
+                           REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)]);
+
+val npo_rls = [npo_pair_lam,npo_lam_pair] @ map mk_thm
+            ["~ true [= false",          "~ false [= true",
+             "~ true [= <a,b>",          "~ <a,b> [= true",
+             "~ true [= lam x.f(x)","~ lam x.f(x) [= true",
+            "~ false [= <a,b>",          "~ <a,b> [= false",
+            "~ false [= lam x.f(x)","~ lam x.f(x) [= false"];
+
+(* Coinduction for [= *)
+
+val prems = goal CCL.thy "[|  <t,u> : R;  R <= POgen(R) |] ==> t [= u";
+br (PO_def RS def_coinduct RS (PO_iff RS iffD2)) 1;
+by (REPEAT (ares_tac prems 1));
+val po_coinduct = result();
+
+fun po_coinduct_tac s i = res_inst_tac [("R",s)] po_coinduct i;
+
+(*************** EQUALITY *******************)
+
+goalw CCL.thy [EQgen_def,SIM_def]  "mono(%X.EQgen(X))";
+br monoI 1;
+by (safe_tac set_cs);
+by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
+by (ALLGOALS (SIMP_TAC ccl_ss));
+by (ALLGOALS (fast_tac set_cs));
+val EQgen_mono = result();
+
+goalw CCL.thy [EQgen_def,SIM_def]
+  "<t,t'> : EQgen(R) <-> (t=bot & t'=bot)  | (t=true & t'=true)  | \
+\                                            (t=false & t'=false) | \
+\                (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
+\                (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
+br (iff_refl RS XHlemma2) 1;
+val EQgenXH = result();
+
+goal CCL.thy
+  "t=t' <-> (t=bot & t'=bot)  | (t=true & t'=true)  | (t=false & t'=false) | \
+\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a=a' & b=b') | \
+\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x)=f'(x)))";
+by (subgoal_tac
+  "<t,t'> : EQ <-> (t=bot & t'=bot)  | (t=true & t'=true) | (t=false & t'=false) | \
+\             (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : EQ & <b,b'> : EQ) | \
+\             (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : EQ))" 1);
+be rev_mp 1;
+by (SIMP_TAC (CCL_ss addrews [EQ_iff RS iff_sym]) 1);
+br (rewrite_rule [EQgen_def,SIM_def]
+                 (EQgen_mono RS (EQ_def RS def_gfp_Tarski) RS XHlemma1)) 1;
+br (iff_refl RS XHlemma2) 1;
+val eqXH = result();
+
+val prems = goal CCL.thy "[|  <t,u> : R;  R <= EQgen(R) |] ==> t = u";
+br (EQ_def RS def_coinduct RS (EQ_iff RS iffD2)) 1;
+by (REPEAT (ares_tac prems 1));
+val eq_coinduct = result();
+
+val prems = goal CCL.thy 
+    "[|  <t,u> : R;  R <= EQgen(lfp(%x.EQgen(x) Un R Un EQ)) |] ==> t = u";
+br (EQ_def RS def_coinduct3 RS (EQ_iff RS iffD2)) 1;
+by (REPEAT (ares_tac (EQgen_mono::prems) 1));
+val eq_coinduct3 = result();
+
+fun eq_coinduct_tac s i = res_inst_tac [("R",s)] eq_coinduct i;
+fun eq_coinduct3_tac s i = res_inst_tac [("R",s)] eq_coinduct3 i;
+
+(*** Untyped Case Analysis and Other Facts ***)
+
+goalw CCL.thy [apply_def]  "(EX f.t=lam x.f(x)) --> t = lam x.(t ` x)";
+by (safe_tac ccl_cs);
+by (SIMP_TAC ccl_ss 1);
+val cond_eta = result() RS mp;
+
+goal CCL.thy "(t=bot) | (t=true) | (t=false) | (EX a b.t=<a,b>) | (EX f.t=lam x.f(x))";
+by (cut_facts_tac [refl RS (eqXH RS iffD1)] 1);
+by (fast_tac set_cs 1);
+val exhaustion = result();
+
+val prems = goal CCL.thy 
+    "[| P(bot);  P(true);  P(false);  !!x y.P(<x,y>);  !!b.P(lam x.b(x)) |] ==> P(t)";
+by (cut_facts_tac [exhaustion] 1);
+by (REPEAT_SOME (ares_tac prems ORELSE' eresolve_tac [disjE,exE,ssubst]));
+val term_case = result();
+
+fun term_case_tac a i = res_inst_tac [("t",a)] term_case i;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ccl.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,148 @@
+(*  Title: 	CCL/ccl.thy
+    ID:         $Id$
+    Author: 	Martin Coen
+    Copyright   1993  University of Cambridge
+
+Classical Computational Logic for Untyped Lambda Calculus with reduction to 
+weak head-normal form.
+
+Based on FOL extended with set collection, a primitive higher-order logic.
+HOL is too strong - descriptions prevent a type of programs being defined
+which contains only executable terms.
+*)
+
+CCL = Gfp +
+
+classes prog < term
+
+default prog
+
+types i 0
+
+arities 
+      i          :: prog
+      fun        :: (prog,prog)prog
+
+consts
+  (*** Evaluation Judgement ***)
+  "--->"      ::       "[i,i]=>prop"          (infixl 20)
+
+  (*** Bisimulations for pre-order and equality ***)
+  "[="        ::       "['a,'a]=>o"           (infixl 50)
+  SIM         ::       "[i,i,i set]=>o"
+  POgen,EQgen ::       "i set => i set"
+  PO,EQ       ::       "i set"
+
+  (*** Term Formers ***)
+  true,false  ::       "i"
+  pair        ::       "[i,i]=>i"             ("(1<_,/_>)")
+  lambda      ::       "(i=>i)=>i"            (binder "lam " 55)
+  case        ::       "[i,i,i,[i,i]=>i,(i=>i)=>i]=>i"
+  "`"         ::       "[i,i]=>i"             (infixl 56)
+  bot         ::       "i"
+  fix         ::       "(i=>i)=>i"
+
+  (*** Defined Predicates ***)
+  Trm,Dvg     ::       "i => o"
+
+rules
+
+  (******* EVALUATION SEMANTICS *******)
+
+  (**  This is the evaluation semantics from which the axioms below were derived.  **)
+  (**  It is included here just as an evaluator for FUN and has no influence on    **)
+  (**  inference in the theory CCL.                                                **)
+
+  trueV       "true ---> true"
+  falseV      "false ---> false"
+  pairV       "<a,b> ---> <a,b>"
+  lamV        "lam x.b(x) ---> lam x.b(x)"
+  caseVtrue   "[| t ---> true;  d ---> c |] ==> case(t,d,e,f,g) ---> c"
+  caseVfalse  "[| t ---> false;  e ---> c |] ==> case(t,d,e,f,g) ---> c"
+  caseVpair   "[| t ---> <a,b>;  f(a,b) ---> c |] ==> case(t,d,e,f,g) ---> c"
+  caseVlam    "[| t ---> lam x.b(x);  g(b) ---> c |] ==> case(t,d,e,f,g) ---> c"
+
+  (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***)
+
+  canonical  "[| t ---> c; c==true ==> u--->v; \
+\                          c==false ==> u--->v; \
+\                    !!a b.c==<a,b> ==> u--->v; \
+\                      !!f.c==lam x.f(x) ==> u--->v |] ==> \
+\             u--->v"
+
+  (* Should be derivable - but probably a bitch! *)
+  substitute "[| a==a'; t(a)--->c(a) |] ==> t(a')--->c(a')"
+
+  (************** LOGIC ***************)
+
+  (*** Definitions used in the following rules ***)
+
+  apply_def     "f ` t == case(f,bot,bot,%x y.bot,%u.u(t))"
+  bot_def         "bot == (lam x.x`x)`(lam x.x`x)"
+  fix_def      "fix(f) == (lam x.f(x`x))`(lam x.f(x`x))"
+
+  (*  The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *)
+  (*  as a bisimulation.  They can both be expressed as (bi)simulations up to        *)
+  (*  behavioural equivalence (ie the relations PO and EQ defined below).            *)
+
+  SIM_def
+  "SIM(t,t',R) ==  (t=true & t'=true) | (t=false & t'=false) | \
+\                  (EX a a' b b'.t=<a,b> & t'=<a',b'> & <a,a'> : R & <b,b'> : R) | \
+\                  (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))"
+
+  POgen_def  "POgen(R) == {p. EX t t'. p=<t,t'> & (t = bot | SIM(t,t',R))}"
+  EQgen_def  "EQgen(R) == {p. EX t t'. p=<t,t'> & (t = bot & t' = bot | SIM(t,t',R))}"
+
+  PO_def    "PO == gfp(POgen)"
+  EQ_def    "EQ == gfp(EQgen)"
+
+  (*** Rules ***)
+
+  (** Partial Order **)
+
+  po_refl        "a [= a"
+  po_trans       "[| a [= b;  b [= c |] ==> a [= c"
+  po_cong        "a [= b ==> f(a) [= f(b)"
+
+  (* Extend definition of [= to program fragments of higher type *)
+  po_abstractn   "(!!x. f(x) [= g(x)) ==> (%x.f(x)) [= (%x.g(x))"
+
+  (** Equality - equivalence axioms inherited from FOL.thy   **)
+  (**          - congruence of "=" is axiomatised implicitly **)
+
+  eq_iff         "t = t' <-> t [= t' & t' [= t"
+
+  (** Properties of canonical values given by greatest fixed point definitions **)
+ 
+  PO_iff         "t [= t' <-> <t,t'> : PO"
+  EQ_iff         "t =  t' <-> <t,t'> : EQ"
+
+  (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **)
+
+  caseBtrue            "case(true,d,e,f,g) = d"
+  caseBfalse          "case(false,d,e,f,g) = e"
+  caseBpair           "case(<a,b>,d,e,f,g) = f(a,b)"
+  caseBlam       "case(lam x.b(x),d,e,f,g) = g(b)"
+  caseBbot              "case(bot,d,e,f,g) = bot"            (* strictness *)
+
+  (** The theory is non-trivial **)
+  distinctness   "~ lam x.b(x) = bot"
+
+  (*** Definitions of Termination and Divergence ***)
+
+  Dvg_def  "Dvg(t) == t = bot"
+  Trm_def  "Trm(t) == ~ Dvg(t)"
+
+end
+
+
+(*
+Would be interesting to build a similar theory for a typed programming language:
+    ie.     true :: bool,      fix :: ('a=>'a)=>'a  etc......
+
+This is starting to look like LCF.
+What are the advantages of this approach?   
+        - less axiomatic                                            
+        - wfd induction / coinduction and fixed point induction available
+           
+*)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/coinduction.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,107 @@
+(*  Title: 	92/CCL/coinduction
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Lemmas and tactics for using the rule coinduct3 on [= and =.
+*)
+
+val [mono,prem] = goal Lfp.thy "[| mono(f);  a : f(lfp(f)) |] ==> a : lfp(f)";
+br ((mono RS lfp_Tarski) RS ssubst) 1;
+br prem 1;
+val lfpI = result();
+
+val prems = goal CCL.thy "[| a=a';  a' : A |] ==> a : A";
+by (SIMP_TAC (term_ss addrews prems) 1);
+val ssubst_single = result();
+
+val prems = goal CCL.thy "[| a=a';  b=b';  <a',b'> : A |] ==> <a,b> : A";
+by (SIMP_TAC (term_ss addrews prems) 1);
+val ssubst_pair = result();
+
+(***)
+
+local 
+fun mk_thm s = prove_goal Term.thy s (fn mono::prems => 
+       [fast_tac (term_cs addIs ((mono RS coinduct3_mono_lemma RS lfpI)::prems)) 1]);
+in
+val ci3_RI    = mk_thm "[|  mono(Agen);  a : R |] ==> a : lfp(%x. Agen(x) Un R Un A)";
+val ci3_AgenI = mk_thm "[|  mono(Agen);  a : Agen(lfp(%x. Agen(x) Un R Un A)) |] ==> \
+\                       a : lfp(%x. Agen(x) Un R Un A)";
+val ci3_AI    = mk_thm "[|  mono(Agen);  a : A |] ==> a : lfp(%x. Agen(x) Un R Un A)";
+end;
+
+fun mk_genIs thy defs genXH gen_mono s = prove_goalw thy defs s 
+      (fn prems => [rtac (genXH RS iffD2) 1,
+                    (SIMP_TAC term_ss 1),
+                    TRY (fast_tac (term_cs addIs 
+                            ([genXH RS iffD2,gen_mono RS coinduct3_mono_lemma RS lfpI]
+                             @ prems)) 1)]);
+
+(** POgen **)
+
+goal Term.thy "<a,a> : PO";
+br (po_refl RS (XH_to_D PO_iff)) 1;
+val PO_refl = result();
+
+val POgenIs = map (mk_genIs Term.thy data_defs POgenXH POgen_mono)
+      ["<true,true> : POgen(R)",
+       "<false,false> : POgen(R)",
+       "[| <a,a'> : R;  <b,b'> : R |] ==> <<a,b>,<a',b'>> : POgen(R)",
+       "[|!!x. <b(x),b'(x)> : R |] ==><lam x.b(x),lam x.b'(x)> : POgen(R)",
+       "<one,one> : POgen(R)",
+       "<a,a'> : lfp(%x. POgen(x) Un R Un PO) ==> \
+\                         <inl(a),inl(a')> : POgen(lfp(%x. POgen(x) Un R Un PO))",
+       "<b,b'> : lfp(%x. POgen(x) Un R Un PO) ==> \
+\                         <inr(b),inr(b')> : POgen(lfp(%x. POgen(x) Un R Un PO))",
+       "<zero,zero> : POgen(lfp(%x. POgen(x) Un R Un PO))",
+       "<n,n'> : lfp(%x. POgen(x) Un R Un PO) ==> \
+\                         <succ(n),succ(n')> : POgen(lfp(%x. POgen(x) Un R Un PO))",
+       "<[],[]> : POgen(lfp(%x. POgen(x) Un R Un PO))",
+       "[| <h,h'> : lfp(%x. POgen(x) Un R Un PO); \
+\          <t,t'> : lfp(%x. POgen(x) Un R Un PO) |] ==> \
+\       <h.t,h'.t'> : POgen(lfp(%x. POgen(x) Un R Un PO))"];
+
+fun POgen_tac (rla,rlb) i =
+       SELECT_GOAL (safe_tac ccl_cs) i THEN
+       rtac (rlb RS (rla RS ssubst_pair)) i THEN
+       (REPEAT (resolve_tac (POgenIs @ [PO_refl RS (POgen_mono RS ci3_AI)] @ 
+                   (POgenIs RL [POgen_mono RS ci3_AgenI]) @ [POgen_mono RS ci3_RI]) i));
+
+(** EQgen **)
+
+goal Term.thy "<a,a> : EQ";
+br (refl RS (EQ_iff RS iffD1)) 1;
+val EQ_refl = result();
+
+val EQgenIs = map (mk_genIs Term.thy data_defs EQgenXH EQgen_mono)
+      ["<true,true> : EQgen(R)",
+       "<false,false> : EQgen(R)",
+       "[| <a,a'> : R;  <b,b'> : R |] ==> <<a,b>,<a',b'>> : EQgen(R)",
+       "[|!!x. <b(x),b'(x)> : R |] ==> <lam x.b(x),lam x.b'(x)> : EQgen(R)",
+       "<one,one> : EQgen(R)",
+       "<a,a'> : lfp(%x. EQgen(x) Un R Un EQ) ==> \
+\                         <inl(a),inl(a')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
+       "<b,b'> : lfp(%x. EQgen(x) Un R Un EQ) ==> \
+\                         <inr(b),inr(b')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
+       "<zero,zero> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
+       "<n,n'> : lfp(%x. EQgen(x) Un R Un EQ) ==> \
+\                         <succ(n),succ(n')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
+       "<[],[]> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
+       "[| <h,h'> : lfp(%x. EQgen(x) Un R Un EQ); \
+\          <t,t'> : lfp(%x. EQgen(x) Un R Un EQ) |] ==> \
+\       <h.t,h'.t'> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"];
+
+fun EQgen_raw_tac i =
+       (REPEAT (resolve_tac (EQgenIs @ [EQ_refl RS (EQgen_mono RS ci3_AI)] @ 
+                   (EQgenIs RL [EQgen_mono RS ci3_AgenI]) @ [EQgen_mono RS ci3_RI]) i));
+
+(* Goals of the form R <= EQgen(R) - rewrite elements <a,b> : EQgen(R) using rews and *)
+(* then reduce this to a goal <a',b'> : R (hopefully?)                                *)
+(*      rews are rewrite rules that would cause looping in the simpifier              *)
+
+fun EQgen_tac simp_set rews i = 
+       SELECT_GOAL (TRY (safe_tac ccl_cs) THEN
+                    resolve_tac ((rews@[refl]) RL ((rews@[refl]) RL [ssubst_pair])) i THEN
+                    ALLGOALS (SIMP_TAC simp_set) THEN
+                    ALLGOALS EQgen_raw_tac) i;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/equalities.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,134 @@
+(*  Title: 	CCL/equalities
+    ID:         $Id$
+
+Modified version of
+    Title: 	HOL/equalities
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1991  University of Cambridge
+
+Equalities involving union, intersection, inclusion, etc.
+*)
+
+writeln"File HOL/equalities";
+
+val eq_cs = set_cs addSIs [equalityI];
+
+(** Binary Intersection **)
+
+goal Set.thy "A Int A = A";
+by (fast_tac eq_cs 1);
+val Int_absorb = result();
+
+goal Set.thy "A Int B  =  B Int A";
+by (fast_tac eq_cs 1);
+val Int_commute = result();
+
+goal Set.thy "(A Int B) Int C  =  A Int (B Int C)";
+by (fast_tac eq_cs 1);
+val Int_assoc = result();
+
+goal Set.thy "(A Un B) Int C  =  (A Int C) Un (B Int C)";
+by (fast_tac eq_cs 1);
+val Int_Un_distrib = result();
+
+goal Set.thy "(A<=B) <-> (A Int B = A)";
+by (fast_tac (eq_cs addSEs [equalityE]) 1);
+val subset_Int_eq = result();
+
+(** Binary Union **)
+
+goal Set.thy "A Un A = A";
+by (fast_tac eq_cs 1);
+val Un_absorb = result();
+
+goal Set.thy "A Un B  =  B Un A";
+by (fast_tac eq_cs 1);
+val Un_commute = result();
+
+goal Set.thy "(A Un B) Un C  =  A Un (B Un C)";
+by (fast_tac eq_cs 1);
+val Un_assoc = result();
+
+goal Set.thy "(A Int B) Un C  =  (A Un C) Int (B Un C)";
+by (fast_tac eq_cs 1);
+val Un_Int_distrib = result();
+
+goal Set.thy
+ "(A Int B) Un (B Int C) Un (C Int A) = (A Un B) Int (B Un C) Int (C Un A)";
+by (fast_tac eq_cs 1);
+val Un_Int_crazy = result();
+
+goal Set.thy "(A<=B) <-> (A Un B = B)";
+by (fast_tac (eq_cs addSEs [equalityE]) 1);
+val subset_Un_eq = result();
+
+(** Simple properties of Compl -- complement of a set **)
+
+goal Set.thy "A Int Compl(A) = {x.False}";
+by (fast_tac eq_cs 1);
+val Compl_disjoint = result();
+
+goal Set.thy "A Un Compl(A) = {x.True}";
+by (fast_tac eq_cs 1);
+val Compl_partition = result();
+
+goal Set.thy "Compl(Compl(A)) = A";
+by (fast_tac eq_cs 1);
+val double_complement = result();
+
+goal Set.thy "Compl(A Un B) = Compl(A) Int Compl(B)";
+by (fast_tac eq_cs 1);
+val Compl_Un = result();
+
+goal Set.thy "Compl(A Int B) = Compl(A) Un Compl(B)";
+by (fast_tac eq_cs 1);
+val Compl_Int = result();
+
+goal Set.thy "Compl(UN x:A. B(x)) = (INT x:A. Compl(B(x)))";
+by (fast_tac eq_cs 1);
+val Compl_UN = result();
+
+goal Set.thy "Compl(INT x:A. B(x)) = (UN x:A. Compl(B(x)))";
+by (fast_tac eq_cs 1);
+val Compl_INT = result();
+
+(*Halmos, Naive Set Theory, page 16.*)
+
+goal Set.thy "((A Int B) Un C = A Int (B Un C)) <-> (C<=A)";
+by (fast_tac (eq_cs addSEs [equalityE]) 1);
+val Un_Int_assoc_eq = result();
+
+
+(** Big Union and Intersection **)
+
+goal Set.thy "Union(A Un B) = Union(A) Un Union(B)";
+by (fast_tac eq_cs 1);
+val Union_Un_distrib = result();
+
+val prems = goal Set.thy
+   "(Union(C) Int A = {x.False}) <-> (ALL B:C. B Int A = {x.False})";
+by (fast_tac (eq_cs addSEs [equalityE]) 1);
+val Union_disjoint = result();
+
+goal Set.thy "Inter(A Un B) = Inter(A) Int Inter(B)";
+by (best_tac eq_cs 1);
+val Inter_Un_distrib = result();
+
+(** Unions and Intersections of Families **)
+
+goal Set.thy "(UN x:A. B(x)) = Union({Y. EX x:A. Y=B(x)})";
+by (fast_tac eq_cs 1);
+val UN_eq = result();
+
+(*Look: it has an EXISTENTIAL quantifier*)
+goal Set.thy "(INT x:A. B(x)) = Inter({Y. EX x:A. Y=B(x)})";
+by (fast_tac eq_cs 1);
+val INT_eq = result();
+
+goal Set.thy "A Int Union(B) = (UN C:B. A Int C)";
+by (fast_tac eq_cs 1);
+val Int_Union_image = result();
+
+goal Set.thy "A Un Inter(B) = (INT C:B. A Un C)";
+by (fast_tac eq_cs 1);
+val Un_Inter_image = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/eval.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,104 @@
+(*  Title: 	92/CCL/eval
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+*)
+
+
+
+(*** Evaluation ***)
+
+val EVal_rls = ref [trueV,falseV,pairV,lamV,caseVtrue,caseVfalse,caseVpair,caseVlam];
+val eval_tac = DEPTH_SOLVE_1 (resolve_tac (!EVal_rls) 1);
+fun ceval_tac rls = DEPTH_SOLVE_1 (resolve_tac (!EVal_rls@rls) 1);
+
+val prems = goalw thy [apply_def]
+   "[| f ---> lam x.b(x);  b(a) ---> c |] ==> f ` a ---> c";
+by (ceval_tac prems);
+val applyV = result();
+
+EVal_rls := !EVal_rls @ [applyV];
+
+val major::prems = goalw thy [let_def]
+   "[| t ---> a;  f(a) ---> c |] ==> let x be t in f(x) ---> c";
+br (major RS canonical) 1;
+by (REPEAT (DEPTH_SOLVE_1 (resolve_tac ([major]@prems@(!EVal_rls)) 1 ORELSE
+                           eresolve_tac [substitute] 1)));
+val letV = result();
+
+val prems = goalw thy [fix_def]
+   "f(fix(f)) ---> c ==> fix(f) ---> c";
+br applyV 1;
+br lamV 1;
+brs prems 1;
+val fixV = result();
+
+val prems = goalw thy [letrec_def]
+    "h(t,%y.letrec g x be h(x,g) in g(y)) ---> c ==> \
+\                  letrec g x be h(x,g) in g(t) ---> c";
+by (REPEAT (resolve_tac (prems @ [fixV,applyV,lamV]) 1));
+val letrecV = result();
+
+EVal_rls := !EVal_rls @ [letV,letrecV,fixV];
+
+fun mk_V_rl s = prove_goalw thy data_defs s (fn prems => [ceval_tac prems]);
+
+val V_rls = map mk_V_rl 
+             ["true ---> true",
+              "false ---> false",
+              "[| b--->true;  t--->c |] ==> if b then t else u ---> c",
+              "[| b--->false;  u--->c |] ==> if b then t else u ---> c",
+              "<a,b> ---> <a,b>",
+              "[| t ---> <a,b>;  h(a,b) ---> c |] ==> split(t,h) ---> c",
+              "zero ---> zero",
+              "succ(n) ---> succ(n)",
+              "[| n ---> zero; t ---> c |] ==> ncase(n,t,u) ---> c",
+              "[| n ---> succ(x); u(x) ---> c |] ==> ncase(n,t,u) ---> c",
+              "[| n ---> zero; t ---> c |] ==> nrec(n,t,u) ---> c",
+              "[| n--->succ(x); u(x,nrec(x,t,u))--->c |] ==> nrec(n,t,u)--->c",
+              "[] ---> []",
+              "h.t ---> h.t",
+              "[| l ---> []; t ---> c |] ==> lcase(l,t,u) ---> c",
+              "[| l ---> x.xs; u(x,xs) ---> c |] ==> lcase(l,t,u) ---> c",
+              "[| l ---> []; t ---> c |] ==> lrec(l,t,u) ---> c",
+              "[| l--->x.xs; u(x,xs,lrec(xs,t,u))--->c |] ==> lrec(l,t,u)--->c"];
+
+EVal_rls := !EVal_rls @ V_rls;
+
+(* Factorial *)
+
+val prems = goal thy
+    "letrec f n be ncase(n,succ(zero),%x.nrec(n,zero,%y g.nrec(f(x),g,%z h.succ(h)))) \
+\              in f(succ(succ(zero))) ---> ?a";
+by (ceval_tac []);
+
+val prems = goal thy
+    "letrec f n be ncase(n,succ(zero),%x.nrec(n,zero,%y g.nrec(f(x),g,%z h.succ(h)))) \
+\              in f(succ(succ(succ(zero)))) ---> ?a";
+by (ceval_tac []);
+
+(* Less Than Or Equal *)
+
+fun isle x y = prove_goal thy 
+    ("letrec f p be split(p,%m n.ncase(m,true,%x.ncase(n,false,%y.f(<x,y>)))) \
+\              in f(<"^x^","^y^">) ---> ?a")
+    (fn prems => [ceval_tac []]);
+
+isle "succ(zero)" "succ(zero)";
+isle "succ(zero)" "succ(succ(succ(succ(zero))))";
+isle "succ(succ(succ(succ(succ(zero)))))" "succ(succ(succ(succ(zero))))";
+
+
+(* Reverse *)
+
+val prems = goal thy
+    "letrec id l be lcase(l,[],%x xs.x.id(xs)) \
+\              in id(zero.succ(zero).[]) ---> ?a";
+by (ceval_tac []);
+
+val prems = goal thy
+    "letrec rev l be lcase(l,[],%x xs.lrec(rev(xs),x.[],%y ys g.y.g)) \
+\              in rev(zero.succ(zero).(succ((lam x.x)`succ(zero))).([])) ---> ?a";
+by (ceval_tac []);
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/Flag.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,46 @@
+(*  Title: 	CCL/ex/flag
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For flag.thy.
+*)
+
+open Flag;
+
+(******)
+
+val flag_defs = [Colour_def,red_def,white_def,blue_def,ccase_def];
+
+(******)
+
+val ColourXH = mk_XH_tac Flag.thy (simp_type_defs @flag_defs) [] 
+          "a : Colour <-> (a=red | a=white | a=blue)";
+
+val Colour_case = XH_to_E ColourXH;
+
+val redT = mk_canT_tac Flag.thy [ColourXH] "red : Colour";
+val whiteT = mk_canT_tac Flag.thy [ColourXH] "white : Colour";
+val blueT = mk_canT_tac Flag.thy [ColourXH] "blue : Colour";
+
+
+val ccaseT = mk_ncanT_tac Flag.thy flag_defs case_rls case_rls
+     "[| c:Colour; \
+\        c=red ==> r : C(red); c=white ==> w : C(white); c=blue ==> b : C(blue) |] ==> \
+\     ccase(c,r,w,b) : C(c)";
+
+(***)
+
+val prems = goalw Flag.thy [flag_def]
+    "flag : List(Colour)->List(Colour)*List(Colour)*List(Colour)";
+by (typechk_tac [redT,whiteT,blueT,ccaseT] 1);
+by clean_ccs_tac;
+be (ListPRI RS (ListPR_wf RS wfI)) 1;
+ba 1;
+result();
+
+
+val prems = goalw Flag.thy [flag_def]
+    "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).FLAG(x,l)}";
+by (gen_ccs_tac [redT,whiteT,blueT,ccaseT] 1);
+by (REPEAT_SOME (ares_tac [ListPRI RS (ListPR_wf RS wfI)]));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/Flag.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,48 @@
+(*  Title: 	CCL/ex/flag.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Dutch national flag program - except that the point of Dijkstra's example was to use 
+arrays and this uses lists.
+
+*)
+
+Flag = List + 
+
+consts
+
+  Colour             :: "i set"
+  red, white, blue   :: "i"
+  ccase              :: "[i,i,i,i]=>i"
+  flag               :: "i"
+
+rules
+
+  Colour_def  "Colour == Unit + Unit + Unit"
+  red_def        "red == inl(one)"
+  white_def    "white == inr(inl(one))"
+  blue_def     "blue == inr(inr(one))"
+
+  ccase_def   "ccase(c,r,w,b) == when(c,%x.r,%wb.when(wb,%x.w,%x.b))"
+
+  flag_def    "flag == lam l.letrec \
+\      flagx l be lcase(l,<[],<[],[]>>, \
+\                       %h t. split(flagx(t),%lr p.split(p,%lw lb. \
+\                            ccase(h, <red.lr,<lw,lb>>, \
+\                                     <lr,<white.lw,lb>>, \
+\                                     <lr,<lw,blue.lb>>)))) \
+\      in flagx(l)"    
+
+  Flag_def
+     "Flag(l,x) == ALL lr:List(Colour).ALL lw:List(Colour).ALL lb:List(Colour). \
+\                    x = <lr,<lw,lb>> --> \
+\                  (ALL c:Colour.(c mem lr = true --> c=red) & \
+\                                (c mem lw = true --> c=white) & \
+\                                (c mem lb = true --> c=blue)) & \
+\                  Perm(l,lr @ lw @ lb)"
+
+end
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/List.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,108 @@
+(*  Title: 	CCL/ex/list
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For list.thy.
+*)
+
+open List;
+
+val list_defs = [map_def,comp_def,append_def,filter_def,flat_def,
+                 insert_def,isort_def,partition_def,qsort_def];
+
+(****)
+
+val listBs = map (fn s=>prove_goalw List.thy list_defs s (fn _ => [SIMP_TAC term_ss 1]))
+     ["(f o g) = (%a.f(g(a)))",
+      "(f o g)(a) = f(g(a))",
+      "map(f,[]) = []",
+      "map(f,x.xs) = f(x).map(f,xs)",
+      "[] @ m = m",
+      "x.xs @ m = x.(xs @ m)",
+      "filter(f,[]) = []",
+      "filter(f,x.xs) = if f`x then x.filter(f,xs) else filter(f,xs)",
+      "flat([]) = []",
+      "flat(x.xs) = x @ flat(xs)",
+      "insert(f,a,[]) = a.[]",
+      "insert(f,a,x.xs) = if f`a`x then a.x.xs else x.insert(f,a,xs)"];
+
+val list_congs = ccl_mk_congs List.thy ["map","op @","filter","flat","insert","napply"];
+
+val list_ss = nat_ss addrews listBs addcongs list_congs;
+
+(****)
+
+val [prem] = goal List.thy "n:Nat ==> map(f) ^ n ` [] = []";
+br (prem RS Nat_ind) 1;
+by (ALLGOALS (ASM_SIMP_TAC list_ss));
+val nmapBnil = result();
+
+val [prem] = goal List.thy "n:Nat ==> map(f)^n`(x.xs) = f^n`x.map(f)^n`xs";
+br (prem RS Nat_ind) 1;
+by (ALLGOALS (ASM_SIMP_TAC list_ss));
+val nmapBcons = result();
+
+(***)
+
+val prems = goalw List.thy [map_def]
+  "[| !!x.x:A==>f(x):B;  l : List(A) |] ==> map(f,l) : List(B)";
+by (typechk_tac prems 1);
+val mapT = result();
+
+val prems = goalw List.thy [append_def]
+  "[| l : List(A);  m : List(A) |] ==> l @ m : List(A)";
+by (typechk_tac prems 1);
+val appendT = result();
+
+val prems = goal List.thy
+  "[| l : {l:List(A). m : {m:List(A).P(l @ m)}} |] ==> l @ m : {x:List(A). P(x)}";
+by (cut_facts_tac prems 1);
+by (fast_tac (set_cs addSIs [SubtypeI,appendT] addSEs [SubtypeE]) 1);
+val appendTS = result();
+
+val prems = goalw List.thy [filter_def]
+  "[| f:A->Bool;   l : List(A) |] ==> filter(f,l) : List(A)";
+by (typechk_tac prems 1);
+val filterT = result();
+
+val prems = goalw List.thy [flat_def]
+  "l : List(List(A)) ==> flat(l) : List(A)";
+by (typechk_tac (appendT::prems) 1);
+val flatT = result();
+
+val prems = goalw List.thy [insert_def]
+  "[|  f : A->A->Bool; a:A; l : List(A) |] ==> insert(f,a,l) : List(A)";
+by (typechk_tac prems 1);
+val insertT = result();
+
+val prems = goal List.thy
+  "[| f : {f:A->A->Bool. a : {a:A. l : {l:List(A).P(insert(f,a,l))}}} |] ==> \
+\  insert(f,a,l)  : {x:List(A). P(x)}";
+by (cut_facts_tac prems 1);
+by (fast_tac (set_cs addSIs [SubtypeI,insertT] addSEs [SubtypeE]) 1);
+val insertTS = result();
+
+val prems = goalw List.thy [partition_def]
+  "[| f:A->Bool;  l : List(A) |] ==> partition(f,l) : List(A)*List(A)";
+by (typechk_tac prems 1);
+by clean_ccs_tac;
+br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 2;
+br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 1;
+by (REPEAT (atac 1));
+val partitionT = result();
+
+(*** Correctness Conditions for Insertion Sort ***)
+
+
+val prems = goalw List.thy [isort_def] 
+    "f:A->A->Bool ==> isort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}";
+by (gen_ccs_tac  ([insertTS,insertT]@prems) 1);
+
+
+(*** Correctness Conditions for Quick Sort ***)
+
+val prems = goalw List.thy [qsort_def] 
+    "f:A->A->Bool ==> qsort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}";
+by (gen_ccs_tac  ([partitionT,appendTS,appendT]@prems) 1);
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/List.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,44 @@
+(*  Title: 	CCL/ex/list.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Programs defined over lists.
+*)
+
+List = Nat + 
+
+consts
+  map       :: "[i=>i,i]=>i"
+  "o"       :: "[i=>i,i=>i]=>i=>i"             (infixr 55)
+  "@"       :: "[i,i]=>i"             (infixr 55)
+  mem       :: "[i,i]=>i"             (infixr 55)
+  filter    :: "[i,i]=>i"
+  flat      :: "i=>i"
+  partition :: "[i,i]=>i"
+  insert    :: "[i,i,i]=>i"
+  isort     :: "i=>i"
+  qsort     :: "i=>i"
+
+rules 
+
+  map_def     "map(f,l)   == lrec(l,[],%x xs g.f(x).g)"
+  comp_def    "f o g == (%x.f(g(x)))"
+  append_def  "l @ m == lrec(l,m,%x xs g.x.g)"
+  mem_def     "a mem l == lrec(l,false,%h t g.if eq(a,h) then true else g)"
+  filter_def  "filter(f,l) == lrec(l,[],%x xs g.if f`x then x.g else g)"
+  flat_def    "flat(l) == lrec(l,[],%h t g.h @ g)"
+
+  insert_def  "insert(f,a,l) == lrec(l,a.[],%h t g.if f`a`h then a.h.t else h.g)"
+  isort_def   "isort(f) == lam l.lrec(l,[],%h t g.insert(f,h,g))"
+
+  partition_def 
+  "partition(f,l) == letrec part l a b be lcase(l,<a,b>,%x xs.\
+\                            if f`x then part(xs,x.a,b) else part(xs,a,x.b)) \
+\                    in part(l,[],[])"
+  qsort_def   "qsort(f) == lam l. letrec qsortx l be lcase(l,[],%h t. \
+\                                   let p be partition(f`h,t) \
+\                                   in split(p,%x y.qsortx(x) @ h.qsortx(y))) \
+\                          in qsortx(l)"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/Nat.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,75 @@
+(*  Title: 	CCL/ex/nat
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For nat.thy.
+*)
+
+open Nat;
+
+val nat_defs = [not_def,add_def,mult_def,sub_def,le_def,lt_def,ack_def,napply_def];
+
+val natBs = map (fn s=>prove_goalw Nat.thy nat_defs s (fn _ => [SIMP_TAC term_ss 1]))
+     ["not(true) = false",
+      "not(false) = true",
+      "zero #+ n = n",
+      "succ(n) #+ m = succ(n #+ m)",
+      "zero #* n = zero",
+      "succ(n) #* m = m #+ (n #* m)",
+      "f^zero`a = a",
+      "f^succ(n)`a = f(f^n`a)"];
+
+val nat_congs  = ccl_mk_congs Nat.thy ["not","op #+","op #*","op #-","op ##",
+                                     "op #<","op #<=","ackermann","napply"];
+
+val nat_ss = term_ss addrews natBs addcongs nat_congs;
+
+(*** Lemma for napply ***)
+
+val [prem] = goal Nat.thy "n:Nat ==> f^n`f(a) = f^succ(n)`a";
+br (prem RS Nat_ind) 1;
+by (ALLGOALS (ASM_SIMP_TAC (nat_ss addcongs [read_instantiate [("f","f")] arg_cong])));
+val napply_f = result();
+
+(****)
+
+val prems = goalw Nat.thy [add_def] "[| a:Nat;  b:Nat |] ==> a #+ b : Nat";
+by (typechk_tac prems 1);
+val addT = result();
+
+val prems = goalw Nat.thy [mult_def] "[| a:Nat;  b:Nat |] ==> a #* b : Nat";
+by (typechk_tac (addT::prems) 1);
+val multT = result();
+
+(* Defined to return zero if a<b *)
+val prems = goalw Nat.thy [sub_def] "[| a:Nat;  b:Nat |] ==> a #- b : Nat";
+by (typechk_tac (prems) 1);
+by clean_ccs_tac;
+be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1;
+val subT = result();
+
+val prems = goalw Nat.thy [le_def] "[| a:Nat;  b:Nat |] ==> a #<= b : Bool";
+by (typechk_tac (prems) 1);
+by clean_ccs_tac;
+be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1;
+val leT = result();
+
+val prems = goalw Nat.thy [not_def,lt_def] "[| a:Nat;  b:Nat |] ==> a #< b : Bool";
+by (typechk_tac (prems@[leT]) 1);
+val ltT = result();
+
+(* Correctness conditions for subtractive division **)
+
+val prems = goalw Nat.thy [div_def] 
+    "[| a:Nat;  b:{x:Nat.~x=zero} |] ==> a ## b : {x:Nat. DIV(a,b,x)}";
+by (gen_ccs_tac (prems@[ltT,subT]) 1);
+
+(* Termination Conditions for Ackermann's Function *)
+
+val prems = goalw Nat.thy [ack_def]
+    "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat";
+by (gen_ccs_tac prems 1);
+val relI = NatPR_wf RS (NatPR_wf RS lex_wf RS wfI);
+by (REPEAT (eresolve_tac [NatPRI RS (lexI1 RS relI),NatPRI RS (lexI2 RS relI)] 1));
+result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/Nat.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,38 @@
+(*  Title: 	CCL/ex/nat.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Programs defined over the natural numbers
+*)
+
+Nat = Wfd +
+
+consts
+
+  not              :: "i=>i"
+  "#+","#*","#-",
+  "##","#<","#<="  :: "[i,i]=>i"            (infixr 60)
+  ackermann        :: "[i,i]=>i"
+
+rules 
+
+  not_def     "not(b) == if b then false else true"
+
+  add_def     "a #+ b == nrec(a,b,%x g.succ(g))"
+  mult_def    "a #* b == nrec(a,zero,%x g.b #+ g)"
+  sub_def     "a #- b == letrec sub x y be ncase(y,x,%yy.ncase(x,zero,%xx.sub(xx,yy))) \
+\                        in sub(a,b)"
+  le_def     "a #<= b == letrec le x y be ncase(x,true,%xx.ncase(y,false,%yy.le(xx,yy))) \
+\                        in le(a,b)"
+  lt_def     "a #< b == not(b #<= a)"
+
+  div_def    "a ## b == letrec div x y be if x #< y then zero else succ(div(x#-y,y)) \
+\                       in div(a,b)"
+  ack_def    
+  "ackermann(a,b) == letrec ack n m be ncase(n,succ(m),%x. \
+\                          ncase(m,ack(x,succ(zero)),%y.ack(x,ack(succ(x),y))))\
+\                    in ack(a,b)"
+
+end
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/ROOT.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,17 @@
+(*  Title:      CCL/ex/ROOT
+    ID:         $Id$
+    Author:     Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Executes all examples for Classical Computational Logic
+*)
+
+CCL_build_completed;	(*Cause examples to fail if CCL did*)
+
+writeln"Root file for CCL examples";
+proof_timing := true;
+time_use_thy "ex/nat";
+time_use_thy "ex/list";
+time_use_thy "ex/stream";
+time_use_thy "ex/flag";
+maketest"END: Root file for CCL examples";
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/Stream.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,112 @@
+(*  Title: 	CCL/ex/stream
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For stream.thy.
+
+Proving properties about infinite lists using coinduction:
+    Lists(A)  is the set of all finite and infinite lists of elements of A.
+    ILists(A) is the set of infinite lists of elements of A.
+*)
+
+open Stream;
+
+(*** Map of composition is composition of maps ***)
+
+val prems = goal Stream.thy "l:Lists(A) ==> map(f o g,l) = map(f,map(g,l))";
+by (eq_coinduct3_tac 
+       "{p. EX x y.p=<x,y> & (EX l:Lists(A).x=map(f o g,l) & y=map(f,map(g,l)))}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (SIMP_TAC list_ss 1);
+by (fast_tac ccl_cs 1);
+val map_comp = result();
+
+(*** Mapping the identity function leaves a list unchanged ***)
+
+val prems = goal Stream.thy "l:Lists(A) ==> map(%x.x,l) = l";
+by (eq_coinduct3_tac 
+       "{p. EX x y.p=<x,y> & (EX l:Lists(A).x=map(%x.x,l) & y=l)}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val map_id = result();
+
+(*** Mapping distributes over append ***)
+
+val prems = goal Stream.thy 
+        "[| l:Lists(A); m:Lists(A) |] ==> map(f,l@m) = map(f,l) @ map(f,m)";
+by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX l:Lists(A).EX m:Lists(A). \
+\                                           x=map(f,l@m) & y=map(f,l) @ map(f,m))}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val map_append = result();
+
+(*** Append is associative ***)
+
+val prems = goal Stream.thy 
+        "[| k:Lists(A); l:Lists(A); m:Lists(A) |] ==> k @ l @ m = (k @ l) @ m";
+by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX k:Lists(A).EX l:Lists(A).EX m:Lists(A). \
+\                                                   x=k @ l @ m & y=(k @ l) @ m)}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+be (XH_to_E ListsXH) 1;back();
+by (EQgen_tac list_ss [] 1);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val append_assoc = result();
+
+(*** Appending anything to an infinite list doesn't alter it ****)
+
+val prems = goal Stream.thy "l:ILists(A) ==> l @ m = l";
+by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX l:ILists(A).EX m.x=l@m & y=l)}" 1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac set_cs);
+be (XH_to_E IListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val ilist_append = result();
+
+(*** The equivalance of two versions of an iteration function       ***)
+(*                                                                    *)
+(*        fun iter1(f,a) = a.iter1(f,f(a))                            *)
+(*        fun iter2(f,a) = a.map(f,iter2(f,a))                        *)
+
+goalw Stream.thy [iter1_def] "iter1(f,a) = a.iter1(f,f(a))";
+br (letrecB RS trans) 1;
+by (SIMP_TAC term_ss 1);
+val iter1B = result();
+
+goalw Stream.thy [iter2_def] "iter2(f,a) = a . map(f,iter2(f,a))";
+br (letrecB RS trans) 1;
+br refl 1;
+val iter2B = result();
+
+val [prem] =goal Stream.thy
+   "n:Nat ==> map(f) ^ n ` iter2(f,a) = f ^ n ` a . map(f) ^ n ` map(f,iter2(f,a))";
+br (iter2B RS ssubst) 1;back();back();
+by (SIMP_TAC (list_ss addrews [prem RS nmapBcons]) 1);
+val iter2Blemma = result();
+
+goal Stream.thy "iter1(f,a) = iter2(f,a)";
+by (eq_coinduct3_tac 
+    "{p. EX x y.p=<x,y> & (EX n:Nat.x=iter1(f,f^n`a) & y=map(f)^n`iter2(f,a))}" 1);
+by (fast_tac (type_cs addSIs [napplyBzero RS sym,napplyBzero RS sym RS arg_cong]) 1);
+by (EQgen_tac list_ss [iter1B,iter2Blemma] 1);
+by (rtac (napply_f RS ssubst) 1 THEN atac 1);
+by (res_inst_tac [("f1","f")] (napplyBsucc RS subst) 1);
+by (fast_tac type_cs 1);
+val iter1_iter2_eq = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/Stream.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,20 @@
+(*  Title: 	CCL/ex/stream.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Programs defined over streams.
+*)
+
+Stream = List + 
+
+consts
+
+  iter1,iter2   ::  "[i=>i,i]=>i"
+
+rules 
+
+  iter1_def   "iter1(f,a) == letrec iter x be x.iter(f(x)) in iter(a)"
+  iter2_def   "iter2(f,a) == letrec iter x be x.map(f,iter(x)) in iter(a)"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/flag.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,46 @@
+(*  Title: 	CCL/ex/flag
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For flag.thy.
+*)
+
+open Flag;
+
+(******)
+
+val flag_defs = [Colour_def,red_def,white_def,blue_def,ccase_def];
+
+(******)
+
+val ColourXH = mk_XH_tac Flag.thy (simp_type_defs @flag_defs) [] 
+          "a : Colour <-> (a=red | a=white | a=blue)";
+
+val Colour_case = XH_to_E ColourXH;
+
+val redT = mk_canT_tac Flag.thy [ColourXH] "red : Colour";
+val whiteT = mk_canT_tac Flag.thy [ColourXH] "white : Colour";
+val blueT = mk_canT_tac Flag.thy [ColourXH] "blue : Colour";
+
+
+val ccaseT = mk_ncanT_tac Flag.thy flag_defs case_rls case_rls
+     "[| c:Colour; \
+\        c=red ==> r : C(red); c=white ==> w : C(white); c=blue ==> b : C(blue) |] ==> \
+\     ccase(c,r,w,b) : C(c)";
+
+(***)
+
+val prems = goalw Flag.thy [flag_def]
+    "flag : List(Colour)->List(Colour)*List(Colour)*List(Colour)";
+by (typechk_tac [redT,whiteT,blueT,ccaseT] 1);
+by clean_ccs_tac;
+be (ListPRI RS (ListPR_wf RS wfI)) 1;
+ba 1;
+result();
+
+
+val prems = goalw Flag.thy [flag_def]
+    "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).FLAG(x,l)}";
+by (gen_ccs_tac [redT,whiteT,blueT,ccaseT] 1);
+by (REPEAT_SOME (ares_tac [ListPRI RS (ListPR_wf RS wfI)]));
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/flag.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,48 @@
+(*  Title: 	CCL/ex/flag.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Dutch national flag program - except that the point of Dijkstra's example was to use 
+arrays and this uses lists.
+
+*)
+
+Flag = List + 
+
+consts
+
+  Colour             :: "i set"
+  red, white, blue   :: "i"
+  ccase              :: "[i,i,i,i]=>i"
+  flag               :: "i"
+
+rules
+
+  Colour_def  "Colour == Unit + Unit + Unit"
+  red_def        "red == inl(one)"
+  white_def    "white == inr(inl(one))"
+  blue_def     "blue == inr(inr(one))"
+
+  ccase_def   "ccase(c,r,w,b) == when(c,%x.r,%wb.when(wb,%x.w,%x.b))"
+
+  flag_def    "flag == lam l.letrec \
+\      flagx l be lcase(l,<[],<[],[]>>, \
+\                       %h t. split(flagx(t),%lr p.split(p,%lw lb. \
+\                            ccase(h, <red.lr,<lw,lb>>, \
+\                                     <lr,<white.lw,lb>>, \
+\                                     <lr,<lw,blue.lb>>)))) \
+\      in flagx(l)"    
+
+  Flag_def
+     "Flag(l,x) == ALL lr:List(Colour).ALL lw:List(Colour).ALL lb:List(Colour). \
+\                    x = <lr,<lw,lb>> --> \
+\                  (ALL c:Colour.(c mem lr = true --> c=red) & \
+\                                (c mem lw = true --> c=white) & \
+\                                (c mem lb = true --> c=blue)) & \
+\                  Perm(l,lr @ lw @ lb)"
+
+end
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/list.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,108 @@
+(*  Title: 	CCL/ex/list
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For list.thy.
+*)
+
+open List;
+
+val list_defs = [map_def,comp_def,append_def,filter_def,flat_def,
+                 insert_def,isort_def,partition_def,qsort_def];
+
+(****)
+
+val listBs = map (fn s=>prove_goalw List.thy list_defs s (fn _ => [SIMP_TAC term_ss 1]))
+     ["(f o g) = (%a.f(g(a)))",
+      "(f o g)(a) = f(g(a))",
+      "map(f,[]) = []",
+      "map(f,x.xs) = f(x).map(f,xs)",
+      "[] @ m = m",
+      "x.xs @ m = x.(xs @ m)",
+      "filter(f,[]) = []",
+      "filter(f,x.xs) = if f`x then x.filter(f,xs) else filter(f,xs)",
+      "flat([]) = []",
+      "flat(x.xs) = x @ flat(xs)",
+      "insert(f,a,[]) = a.[]",
+      "insert(f,a,x.xs) = if f`a`x then a.x.xs else x.insert(f,a,xs)"];
+
+val list_congs = ccl_mk_congs List.thy ["map","op @","filter","flat","insert","napply"];
+
+val list_ss = nat_ss addrews listBs addcongs list_congs;
+
+(****)
+
+val [prem] = goal List.thy "n:Nat ==> map(f) ^ n ` [] = []";
+br (prem RS Nat_ind) 1;
+by (ALLGOALS (ASM_SIMP_TAC list_ss));
+val nmapBnil = result();
+
+val [prem] = goal List.thy "n:Nat ==> map(f)^n`(x.xs) = f^n`x.map(f)^n`xs";
+br (prem RS Nat_ind) 1;
+by (ALLGOALS (ASM_SIMP_TAC list_ss));
+val nmapBcons = result();
+
+(***)
+
+val prems = goalw List.thy [map_def]
+  "[| !!x.x:A==>f(x):B;  l : List(A) |] ==> map(f,l) : List(B)";
+by (typechk_tac prems 1);
+val mapT = result();
+
+val prems = goalw List.thy [append_def]
+  "[| l : List(A);  m : List(A) |] ==> l @ m : List(A)";
+by (typechk_tac prems 1);
+val appendT = result();
+
+val prems = goal List.thy
+  "[| l : {l:List(A). m : {m:List(A).P(l @ m)}} |] ==> l @ m : {x:List(A). P(x)}";
+by (cut_facts_tac prems 1);
+by (fast_tac (set_cs addSIs [SubtypeI,appendT] addSEs [SubtypeE]) 1);
+val appendTS = result();
+
+val prems = goalw List.thy [filter_def]
+  "[| f:A->Bool;   l : List(A) |] ==> filter(f,l) : List(A)";
+by (typechk_tac prems 1);
+val filterT = result();
+
+val prems = goalw List.thy [flat_def]
+  "l : List(List(A)) ==> flat(l) : List(A)";
+by (typechk_tac (appendT::prems) 1);
+val flatT = result();
+
+val prems = goalw List.thy [insert_def]
+  "[|  f : A->A->Bool; a:A; l : List(A) |] ==> insert(f,a,l) : List(A)";
+by (typechk_tac prems 1);
+val insertT = result();
+
+val prems = goal List.thy
+  "[| f : {f:A->A->Bool. a : {a:A. l : {l:List(A).P(insert(f,a,l))}}} |] ==> \
+\  insert(f,a,l)  : {x:List(A). P(x)}";
+by (cut_facts_tac prems 1);
+by (fast_tac (set_cs addSIs [SubtypeI,insertT] addSEs [SubtypeE]) 1);
+val insertTS = result();
+
+val prems = goalw List.thy [partition_def]
+  "[| f:A->Bool;  l : List(A) |] ==> partition(f,l) : List(A)*List(A)";
+by (typechk_tac prems 1);
+by clean_ccs_tac;
+br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 2;
+br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 1;
+by (REPEAT (atac 1));
+val partitionT = result();
+
+(*** Correctness Conditions for Insertion Sort ***)
+
+
+val prems = goalw List.thy [isort_def] 
+    "f:A->A->Bool ==> isort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}";
+by (gen_ccs_tac  ([insertTS,insertT]@prems) 1);
+
+
+(*** Correctness Conditions for Quick Sort ***)
+
+val prems = goalw List.thy [qsort_def] 
+    "f:A->A->Bool ==> qsort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}";
+by (gen_ccs_tac  ([partitionT,appendTS,appendT]@prems) 1);
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/list.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,44 @@
+(*  Title: 	CCL/ex/list.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Programs defined over lists.
+*)
+
+List = Nat + 
+
+consts
+  map       :: "[i=>i,i]=>i"
+  "o"       :: "[i=>i,i=>i]=>i=>i"             (infixr 55)
+  "@"       :: "[i,i]=>i"             (infixr 55)
+  mem       :: "[i,i]=>i"             (infixr 55)
+  filter    :: "[i,i]=>i"
+  flat      :: "i=>i"
+  partition :: "[i,i]=>i"
+  insert    :: "[i,i,i]=>i"
+  isort     :: "i=>i"
+  qsort     :: "i=>i"
+
+rules 
+
+  map_def     "map(f,l)   == lrec(l,[],%x xs g.f(x).g)"
+  comp_def    "f o g == (%x.f(g(x)))"
+  append_def  "l @ m == lrec(l,m,%x xs g.x.g)"
+  mem_def     "a mem l == lrec(l,false,%h t g.if eq(a,h) then true else g)"
+  filter_def  "filter(f,l) == lrec(l,[],%x xs g.if f`x then x.g else g)"
+  flat_def    "flat(l) == lrec(l,[],%h t g.h @ g)"
+
+  insert_def  "insert(f,a,l) == lrec(l,a.[],%h t g.if f`a`h then a.h.t else h.g)"
+  isort_def   "isort(f) == lam l.lrec(l,[],%h t g.insert(f,h,g))"
+
+  partition_def 
+  "partition(f,l) == letrec part l a b be lcase(l,<a,b>,%x xs.\
+\                            if f`x then part(xs,x.a,b) else part(xs,a,x.b)) \
+\                    in part(l,[],[])"
+  qsort_def   "qsort(f) == lam l. letrec qsortx l be lcase(l,[],%h t. \
+\                                   let p be partition(f`h,t) \
+\                                   in split(p,%x y.qsortx(x) @ h.qsortx(y))) \
+\                          in qsortx(l)"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/nat.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,75 @@
+(*  Title: 	CCL/ex/nat
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For nat.thy.
+*)
+
+open Nat;
+
+val nat_defs = [not_def,add_def,mult_def,sub_def,le_def,lt_def,ack_def,napply_def];
+
+val natBs = map (fn s=>prove_goalw Nat.thy nat_defs s (fn _ => [SIMP_TAC term_ss 1]))
+     ["not(true) = false",
+      "not(false) = true",
+      "zero #+ n = n",
+      "succ(n) #+ m = succ(n #+ m)",
+      "zero #* n = zero",
+      "succ(n) #* m = m #+ (n #* m)",
+      "f^zero`a = a",
+      "f^succ(n)`a = f(f^n`a)"];
+
+val nat_congs  = ccl_mk_congs Nat.thy ["not","op #+","op #*","op #-","op ##",
+                                     "op #<","op #<=","ackermann","napply"];
+
+val nat_ss = term_ss addrews natBs addcongs nat_congs;
+
+(*** Lemma for napply ***)
+
+val [prem] = goal Nat.thy "n:Nat ==> f^n`f(a) = f^succ(n)`a";
+br (prem RS Nat_ind) 1;
+by (ALLGOALS (ASM_SIMP_TAC (nat_ss addcongs [read_instantiate [("f","f")] arg_cong])));
+val napply_f = result();
+
+(****)
+
+val prems = goalw Nat.thy [add_def] "[| a:Nat;  b:Nat |] ==> a #+ b : Nat";
+by (typechk_tac prems 1);
+val addT = result();
+
+val prems = goalw Nat.thy [mult_def] "[| a:Nat;  b:Nat |] ==> a #* b : Nat";
+by (typechk_tac (addT::prems) 1);
+val multT = result();
+
+(* Defined to return zero if a<b *)
+val prems = goalw Nat.thy [sub_def] "[| a:Nat;  b:Nat |] ==> a #- b : Nat";
+by (typechk_tac (prems) 1);
+by clean_ccs_tac;
+be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1;
+val subT = result();
+
+val prems = goalw Nat.thy [le_def] "[| a:Nat;  b:Nat |] ==> a #<= b : Bool";
+by (typechk_tac (prems) 1);
+by clean_ccs_tac;
+be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1;
+val leT = result();
+
+val prems = goalw Nat.thy [not_def,lt_def] "[| a:Nat;  b:Nat |] ==> a #< b : Bool";
+by (typechk_tac (prems@[leT]) 1);
+val ltT = result();
+
+(* Correctness conditions for subtractive division **)
+
+val prems = goalw Nat.thy [div_def] 
+    "[| a:Nat;  b:{x:Nat.~x=zero} |] ==> a ## b : {x:Nat. DIV(a,b,x)}";
+by (gen_ccs_tac (prems@[ltT,subT]) 1);
+
+(* Termination Conditions for Ackermann's Function *)
+
+val prems = goalw Nat.thy [ack_def]
+    "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat";
+by (gen_ccs_tac prems 1);
+val relI = NatPR_wf RS (NatPR_wf RS lex_wf RS wfI);
+by (REPEAT (eresolve_tac [NatPRI RS (lexI1 RS relI),NatPRI RS (lexI2 RS relI)] 1));
+result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/nat.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,38 @@
+(*  Title: 	CCL/ex/nat.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Programs defined over the natural numbers
+*)
+
+Nat = Wfd +
+
+consts
+
+  not              :: "i=>i"
+  "#+","#*","#-",
+  "##","#<","#<="  :: "[i,i]=>i"            (infixr 60)
+  ackermann        :: "[i,i]=>i"
+
+rules 
+
+  not_def     "not(b) == if b then false else true"
+
+  add_def     "a #+ b == nrec(a,b,%x g.succ(g))"
+  mult_def    "a #* b == nrec(a,zero,%x g.b #+ g)"
+  sub_def     "a #- b == letrec sub x y be ncase(y,x,%yy.ncase(x,zero,%xx.sub(xx,yy))) \
+\                        in sub(a,b)"
+  le_def     "a #<= b == letrec le x y be ncase(x,true,%xx.ncase(y,false,%yy.le(xx,yy))) \
+\                        in le(a,b)"
+  lt_def     "a #< b == not(b #<= a)"
+
+  div_def    "a ## b == letrec div x y be if x #< y then zero else succ(div(x#-y,y)) \
+\                       in div(a,b)"
+  ack_def    
+  "ackermann(a,b) == letrec ack n m be ncase(n,succ(m),%x. \
+\                          ncase(m,ack(x,succ(zero)),%y.ack(x,ack(succ(x),y))))\
+\                    in ack(a,b)"
+
+end
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/stream.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,112 @@
+(*  Title: 	CCL/ex/stream
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For stream.thy.
+
+Proving properties about infinite lists using coinduction:
+    Lists(A)  is the set of all finite and infinite lists of elements of A.
+    ILists(A) is the set of infinite lists of elements of A.
+*)
+
+open Stream;
+
+(*** Map of composition is composition of maps ***)
+
+val prems = goal Stream.thy "l:Lists(A) ==> map(f o g,l) = map(f,map(g,l))";
+by (eq_coinduct3_tac 
+       "{p. EX x y.p=<x,y> & (EX l:Lists(A).x=map(f o g,l) & y=map(f,map(g,l)))}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (SIMP_TAC list_ss 1);
+by (fast_tac ccl_cs 1);
+val map_comp = result();
+
+(*** Mapping the identity function leaves a list unchanged ***)
+
+val prems = goal Stream.thy "l:Lists(A) ==> map(%x.x,l) = l";
+by (eq_coinduct3_tac 
+       "{p. EX x y.p=<x,y> & (EX l:Lists(A).x=map(%x.x,l) & y=l)}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val map_id = result();
+
+(*** Mapping distributes over append ***)
+
+val prems = goal Stream.thy 
+        "[| l:Lists(A); m:Lists(A) |] ==> map(f,l@m) = map(f,l) @ map(f,m)";
+by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX l:Lists(A).EX m:Lists(A). \
+\                                           x=map(f,l@m) & y=map(f,l) @ map(f,m))}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val map_append = result();
+
+(*** Append is associative ***)
+
+val prems = goal Stream.thy 
+        "[| k:Lists(A); l:Lists(A); m:Lists(A) |] ==> k @ l @ m = (k @ l) @ m";
+by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX k:Lists(A).EX l:Lists(A).EX m:Lists(A). \
+\                                                   x=k @ l @ m & y=(k @ l) @ m)}"  1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac type_cs);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+be (XH_to_E ListsXH) 1;back();
+by (EQgen_tac list_ss [] 1);
+be (XH_to_E ListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val append_assoc = result();
+
+(*** Appending anything to an infinite list doesn't alter it ****)
+
+val prems = goal Stream.thy "l:ILists(A) ==> l @ m = l";
+by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX l:ILists(A).EX m.x=l@m & y=l)}" 1);
+by (fast_tac (ccl_cs addSIs prems) 1);
+by (safe_tac set_cs);
+be (XH_to_E IListsXH) 1;
+by (EQgen_tac list_ss [] 1);
+by (fast_tac ccl_cs 1);
+val ilist_append = result();
+
+(*** The equivalance of two versions of an iteration function       ***)
+(*                                                                    *)
+(*        fun iter1(f,a) = a.iter1(f,f(a))                            *)
+(*        fun iter2(f,a) = a.map(f,iter2(f,a))                        *)
+
+goalw Stream.thy [iter1_def] "iter1(f,a) = a.iter1(f,f(a))";
+br (letrecB RS trans) 1;
+by (SIMP_TAC term_ss 1);
+val iter1B = result();
+
+goalw Stream.thy [iter2_def] "iter2(f,a) = a . map(f,iter2(f,a))";
+br (letrecB RS trans) 1;
+br refl 1;
+val iter2B = result();
+
+val [prem] =goal Stream.thy
+   "n:Nat ==> map(f) ^ n ` iter2(f,a) = f ^ n ` a . map(f) ^ n ` map(f,iter2(f,a))";
+br (iter2B RS ssubst) 1;back();back();
+by (SIMP_TAC (list_ss addrews [prem RS nmapBcons]) 1);
+val iter2Blemma = result();
+
+goal Stream.thy "iter1(f,a) = iter2(f,a)";
+by (eq_coinduct3_tac 
+    "{p. EX x y.p=<x,y> & (EX n:Nat.x=iter1(f,f^n`a) & y=map(f)^n`iter2(f,a))}" 1);
+by (fast_tac (type_cs addSIs [napplyBzero RS sym,napplyBzero RS sym RS arg_cong]) 1);
+by (EQgen_tac list_ss [iter1B,iter2Blemma] 1);
+by (rtac (napply_f RS ssubst) 1 THEN atac 1);
+by (res_inst_tac [("f1","f")] (napplyBsucc RS subst) 1);
+by (fast_tac type_cs 1);
+val iter1_iter2_eq = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/ex/stream.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,20 @@
+(*  Title: 	CCL/ex/stream.thy
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+Programs defined over streams.
+*)
+
+Stream = List + 
+
+consts
+
+  iter1,iter2   ::  "[i=>i,i]=>i"
+
+rules 
+
+  iter1_def   "iter1(f,a) == letrec iter x be x.iter(f(x)) in iter(a)"
+  iter2_def   "iter2(f,a) == letrec iter x be x.map(f,iter(x)) in iter(a)"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/fix.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,202 @@
+(*  Title: 	CCL/fix
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For fix.thy.
+*)
+
+open Fix;
+
+val prems = goalw Fix.thy [INCL_def]
+     "[| !!x.P(x) <-> Q(x) |] ==> INCL(%x.P(x)) <-> INCL(%x.Q(x))";
+by (REPEAT (ares_tac ([refl] @ FOL_congs @ set_congs @ prems) 1));
+val INCL_cong = result();
+
+val fix_congs = [INCL_cong] @ ccl_mk_congs Fix.thy ["napply"];
+
+(*** Fixed Point Induction ***)
+
+val [base,step,incl] = goalw Fix.thy [INCL_def]
+    "[| P(bot);  !!x.P(x) ==> P(f(x));  INCL(P) |] ==> P(fix(f))";
+br (incl RS spec RS mp) 1;
+by (rtac (Nat_ind RS ballI) 1 THEN atac 1);
+by (ALLGOALS (SIMP_TAC term_ss));
+by (REPEAT (ares_tac [base,step] 1));
+val fix_ind = result();
+
+(*** Inclusive Predicates ***)
+
+val prems = goalw Fix.thy [INCL_def]
+     "INCL(P) <-> (ALL f. (ALL n:Nat. P(f ^ n ` bot)) --> P(fix(f)))";
+br iff_refl 1;
+val inclXH = result();
+
+val prems = goal Fix.thy
+     "[| !!f.ALL n:Nat.P(f^n`bot) ==> P(fix(f)) |] ==> INCL(%x.P(x))";
+by (fast_tac (term_cs addIs (prems @ [XH_to_I inclXH])) 1);
+val inclI = result();
+
+val incl::prems = goal Fix.thy
+     "[| INCL(P);  !!n.n:Nat ==> P(f^n`bot) |] ==> P(fix(f))";
+by (fast_tac (term_cs addIs ([ballI RS (incl RS (XH_to_D inclXH) RS spec RS mp)] 
+                       @ prems)) 1);
+val inclD = result();
+
+val incl::prems = goal Fix.thy
+     "[| INCL(P);  (ALL n:Nat.P(f^n`bot))-->P(fix(f)) ==> R |] ==> R";
+by (fast_tac (term_cs addIs ([incl RS inclD] @ prems)) 1);
+val inclE = result();
+
+val fix_ss = term_ss addcongs fix_congs;
+
+(*** Lemmas for Inclusive Predicates ***)
+
+goal Fix.thy "INCL(%x.~ a(x) [= t)";
+br inclI 1;
+bd bspec 1;
+br zeroT 1;
+be contrapos 1;
+br po_trans 1;
+ba 2;
+br (napplyBzero RS ssubst) 1;
+by (rtac po_cong 1 THEN rtac po_bot 1);
+val npo_INCL = result();
+
+val prems = goal Fix.thy "[| INCL(P);  INCL(Q) |] ==> INCL(%x.P(x) & Q(x))";
+by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
+val conj_INCL = result();
+
+val prems = goal Fix.thy "[| !!a.INCL(P(a)) |] ==> INCL(%x.ALL a.P(a,x))";
+by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
+val all_INCL = result();
+
+val prems = goal Fix.thy "[| !!a.a:A ==> INCL(P(a)) |] ==> INCL(%x.ALL a:A.P(a,x))";
+by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
+val ball_INCL = result();
+
+goal Fix.thy "INCL(%x.a(x) = b(x)::'a::prog)";
+by (SIMP_TAC (fix_ss addrews [eq_iff]) 1);
+by (REPEAT (resolve_tac [conj_INCL,po_INCL] 1));
+val eq_INCL = result();
+
+(*** Derivation of Reachability Condition ***)
+
+(* Fixed points of idgen *)
+
+goal Fix.thy "idgen(fix(idgen)) = fix(idgen)";
+br (fixB RS sym) 1;
+val fix_idgenfp = result();
+
+goalw Fix.thy [idgen_def] "idgen(lam x.x) = lam x.x";
+by (SIMP_TAC term_ss 1);
+br (term_case RS allI) 1;
+by (ALLGOALS (SIMP_TAC term_ss));
+val id_idgenfp = result();
+
+(* All fixed points are lam-expressions *)
+
+val [prem] = goal Fix.thy "idgen(d) = d ==> d = lam x.?f(x)";
+br (prem RS subst) 1;
+bw idgen_def;
+br refl 1;
+val idgenfp_lam = result();
+
+(* Lemmas for rewriting fixed points of idgen *)
+
+val prems = goalw Fix.thy [idgen_def] 
+    "[| a = b;  a ` t = u |] ==> b ` t = u";
+by (SIMP_TAC (term_ss addrews (prems RL [sym])) 1);
+val l_lemma= result();
+
+val idgen_lemmas =
+    let fun mk_thm s = prove_goalw Fix.thy [idgen_def] s
+           (fn [prem] => [rtac (prem RS l_lemma) 1,SIMP_TAC term_ss 1])
+    in map mk_thm
+          [    "idgen(d) = d ==> d ` bot = bot",
+               "idgen(d) = d ==> d ` true = true",
+               "idgen(d) = d ==> d ` false = false",
+               "idgen(d) = d ==> d ` <a,b> = <d ` a,d ` b>",
+               "idgen(d) = d ==> d ` (lam x.f(x)) = lam x.d ` f(x)"]
+    end;
+
+(* Proof of Reachability law - show that fix and lam x.x both give LEAST fixed points 
+                               of idgen and hence are they same *)
+
+val [p1,p2,p3] = goal CCL.thy
+    "[| ALL x.t ` x [= u ` x;  EX f.t=lam x.f(x);  EX f.u=lam x.f(x) |] ==> t [= u";
+br (p2 RS cond_eta RS ssubst) 1;
+br (p3 RS cond_eta RS ssubst) 1;
+br (p1 RS (po_lam RS iffD2)) 1;
+val po_eta = result();
+
+val [prem] = goalw Fix.thy [idgen_def] "idgen(d) = d ==> d = lam x.?f(x)";
+br (prem RS subst) 1;
+br refl 1;
+val po_eta_lemma = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> \
+\      {p.EX a b.p=<a,b> & (EX t.a=fix(idgen) ` t & b = d ` t)} <=   \
+\      POgen({p.EX a b.p=<a,b> & (EX t.a=fix(idgen) ` t  & b = d ` t)})";
+by (REPEAT (step_tac term_cs 1));
+by (term_case_tac "t" 1);
+by (ALLGOALS (SIMP_TAC (term_ss addrews (POgenXH::([prem,fix_idgenfp] RL idgen_lemmas)))));
+by (ALLGOALS (fast_tac set_cs));
+val lemma1 = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> fix(idgen) [= d";
+br (allI RS po_eta) 1;
+br (lemma1 RSN(2,po_coinduct)) 1;
+by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp])));
+val fix_least_idgen = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> \
+\      {p.EX a b.p=<a,b> & b = d ` a} <= POgen({p.EX a b.p=<a,b> & b = d ` a})";
+by (REPEAT (step_tac term_cs 1));
+by (term_case_tac "a" 1);
+by (ALLGOALS (SIMP_TAC (term_ss addrews (POgenXH::([prem] RL idgen_lemmas)))));
+by (ALLGOALS (fast_tac set_cs));
+val lemma2 = result();
+
+val [prem] = goal Fix.thy
+    "idgen(d) = d ==> lam x.x [= d";
+br (allI RS po_eta) 1;
+br (lemma2 RSN(2,po_coinduct)) 1;
+by (SIMP_TAC term_ss 1);
+by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp])));
+val id_least_idgen = result();
+
+goal Fix.thy  "fix(idgen) = lam x.x";
+by (fast_tac (term_cs addIs [eq_iff RS iffD2,
+                             id_idgenfp RS fix_least_idgen,
+                             fix_idgenfp RS id_least_idgen]) 1);
+val reachability = result();
+
+(********)
+
+val [prem] = goal Fix.thy "f = lam x.x ==> f`t = t";
+br (prem RS sym RS subst) 1;
+br applyB 1;
+val id_apply = result();
+
+val prems = goal Fix.thy
+     "[| P(bot);  P(true);  P(false);  \
+\        !!x y.[| P(x);  P(y) |] ==> P(<x,y>);  \
+\        !!u.(!!x.P(u(x))) ==> P(lam x.u(x));  INCL(P) |] ==> \
+\     P(t)";
+br (reachability RS id_apply RS subst) 1;
+by (res_inst_tac [("x","t")] spec 1);
+br fix_ind 1;
+bw idgen_def;
+by (REPEAT_SOME (ares_tac [allI]));
+br (applyBbot RS ssubst) 1;
+brs prems 1;
+br (applyB RS ssubst )1;
+by (res_inst_tac [("t","xa")] term_case 1);
+by (ALLGOALS (SIMP_TAC term_ss));
+by (ALLGOALS (fast_tac (term_cs addIs ([all_INCL,INCL_subst] @ prems))));
+val term_ind = result();
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/fix.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,26 @@
+(*  Title: 	CCL/Lazy/fix.thy
+    ID:         $Id$
+    Author: 	Martin Coen
+    Copyright   1993  University of Cambridge
+
+Tentative attempt at including fixed point induction.
+Justified by Smith.
+*)
+
+Fix = Type + 
+
+consts
+
+  idgen      ::	      "[i]=>i"
+  INCL      :: "[i=>o]=>o"
+
+rules
+
+  idgen_def
+  "idgen(f) == lam t.case(t,true,false,%x y.<f`x, f`y>,%u.lam x.f ` u(x))"
+
+  INCL_def   "INCL(%x.P(x)) == (ALL f.(ALL n:Nat.P(f^n`bot)) --> P(fix(f)))"
+  po_INCL    "INCL(%x.a(x) [= b(x))"
+  INCL_subst "INCL(P) ==> INCL(%x.P((g::i=>i)(x)))"
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/genrec.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,165 @@
+(*  Title: 	92/CCL/genrec
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+*)
+
+(*** General Recursive Functions ***)
+
+val major::prems = goal Wfd.thy 
+    "[| a : A;  \
+\       !!p g.[| p:A; ALL x:{x: A. <x,p>:wf(R)}. g(x) : D(x) |] ==>\
+\               h(p,g) : D(p) |] ==> \
+\    letrec g x be h(x,g) in g(a) : D(a)";
+br (major RS rev_mp) 1;
+br (wf_wf RS wfd_induct) 1;
+br (letrecB RS ssubst) 1;
+br impI 1;
+bes prems 1;
+br ballI 1;
+be (spec RS mp RS mp) 1;
+by (REPEAT (eresolve_tac [SubtypeD1,SubtypeD2] 1));
+val letrecT = result();
+
+goalw Wfd.thy [SPLIT_def] "SPLIT(<a,b>,B) = B(a,b)";
+br set_ext 1;
+by (fast_tac ccl_cs 1);
+val SPLITB = result();
+
+val prems = goalw Wfd.thy [letrec2_def]
+    "[| a : A;  b : B;  \
+\     !!p q g.[| p:A; q:B; \
+\             ALL x:A.ALL y:{y: B. <<x,y>,<p,q>>:wf(R)}. g(x,y) : D(x,y) |] ==>\
+\               h(p,q,g) : D(p,q) |] ==> \
+\    letrec g x y be h(x,y,g) in g(a,b) : D(a,b)";
+br (SPLITB RS subst) 1;
+by (REPEAT (ares_tac ([letrecT,pairT,splitT]@prems) 1));
+br (SPLITB RS ssubst) 1;
+by (REPEAT (ares_tac ([ballI,SubtypeI]@prems) 1));
+br (SPLITB RS subst) 1;
+by (REPEAT (ares_tac ([letrecT,SubtypeI,pairT,splitT]@prems) 1 ORELSE 
+            eresolve_tac [bspec,SubtypeE,sym RS subst] 1));
+val letrec2T = result();
+
+goal Wfd.thy "SPLIT(<a,<b,c>>,%x xs.SPLIT(xs,%y z.B(x,y,z))) = B(a,b,c)";
+by (SIMP_TAC (ccl_ss addrews [SPLITB]) 1);
+val lemma = result();
+
+val prems = goalw Wfd.thy [letrec3_def]
+    "[| a : A;  b : B;  c : C;  \
+\    !!p q r g.[| p:A; q:B; r:C; \
+\      ALL x:A.ALL y:B.ALL z:{z:C. <<x,<y,z>>,<p,<q,r>>> : wf(R)}. \
+\                                                       g(x,y,z) : D(x,y,z) |] ==>\
+\               h(p,q,r,g) : D(p,q,r) |] ==> \
+\    letrec g x y z be h(x,y,z,g) in g(a,b,c) : D(a,b,c)";
+br (lemma RS subst) 1;
+by (REPEAT (ares_tac ([letrecT,pairT,splitT]@prems) 1));
+by (SIMP_TAC (ccl_ss addrews [SPLITB]) 1);
+by (REPEAT (ares_tac ([ballI,SubtypeI]@prems) 1));
+br (lemma RS subst) 1;
+by (REPEAT (ares_tac ([letrecT,SubtypeI,pairT,splitT]@prems) 1 ORELSE 
+            eresolve_tac [bspec,SubtypeE,sym RS subst] 1));
+val letrec3T = result();
+
+val letrecTs = [letrecT,letrec2T,letrec3T];
+
+
+(*** Type Checking for Recursive Calls ***)
+
+val major::prems = goal Wfd.thy
+    "[| ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x); \
+\       g(a) : D(a) ==> g(a) : E;  a:A;  <a,p>:wf(R) |] ==> \
+\   g(a) : E";
+by (REPEAT (ares_tac ([SubtypeI,major RS bspec,major]@prems) 1));
+val rcallT = result();
+
+val major::prems = goal Wfd.thy
+    "[| ALL x:A.ALL y:{y:B.<<x,y>,<p,q>>:wf(R)}.g(x,y):D(x,y); \
+\       g(a,b) : D(a,b) ==> g(a,b) : E;  a:A;  b:B;  <<a,b>,<p,q>>:wf(R) |] ==> \
+\   g(a,b) : E";
+by (REPEAT (ares_tac ([SubtypeI,major RS bspec RS bspec,major]@prems) 1));
+val rcall2T = result();
+
+val major::prems = goal Wfd.thy
+    "[| ALL x:A.ALL y:B.ALL z:{z:C.<<x,<y,z>>,<p,<q,r>>>:wf(R)}. g(x,y,z):D(x,y,z); \
+\       g(a,b,c) : D(a,b,c) ==> g(a,b,c) : E;  \
+\       a:A;  b:B;  c:C;  <<a,<b,c>>,<p,<q,r>>> : wf(R) |] ==> \
+\   g(a,b,c) : E";
+by (REPEAT (ares_tac ([SubtypeI,major RS bspec RS bspec RS bspec,major]@prems) 1));
+val rcall3T = result();
+
+val rcallTs = [rcallT,rcall2T,rcall3T];
+
+(*** Instantiating an induction hypothesis with an equality assumption ***)
+
+val prems = goal Wfd.thy
+    "[| g(a) = b; ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x);  \
+\       [| ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x);  b=g(a);  g(a) : D(a) |] ==> P; \
+\       ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x) ==> a:A;  \
+\       ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x) ==> <a,p>:wf(R) |] ==> \
+\   P";
+brs (prems RL prems) 1;
+brs (prems RL [sym]) 1;
+br rcallT 1;
+by (REPEAT (ares_tac prems 1));
+val hyprcallT = result();
+
+val prems = goal Wfd.thy
+    "[| g(a) = b; ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x);\
+\       [| b=g(a);  g(a) : D(a) |] ==> P; a:A;  <a,p>:wf(R) |] ==> \
+\   P";
+brs (prems) 1;
+brs (prems RL [sym]) 1;
+br rcallT 1;
+by (REPEAT (ares_tac prems 1));
+val hyprcallT = result();
+
+val prems = goal Wfd.thy
+    "[| g(a,b) = c; ALL x:A.ALL y:{y:B.<<x,y>,<p,q>>:wf(R)}.g(x,y):D(x,y); \
+\       [| c=g(a,b);  g(a,b) : D(a,b) |] ==> P; \
+\       a:A;  b:B;  <<a,b>,<p,q>>:wf(R) |] ==> \
+\   P";
+brs (prems) 1;
+brs (prems RL [sym]) 1;
+br rcall2T 1;
+by (REPEAT (ares_tac prems 1));
+val hyprcall2T = result();
+
+val prems = goal Wfd.thy
+  "[| g(a,b,c) = d; \
+\     ALL x:A.ALL y:B.ALL z:{z:C.<<x,<y,z>>,<p,<q,r>>>:wf(R)}.g(x,y,z):D(x,y,z); \
+\   [| d=g(a,b,c);  g(a,b,c) : D(a,b,c) |] ==> P; \
+\   a:A;  b:B;  c:C;  <<a,<b,c>>,<p,<q,r>>> : wf(R) |] ==> \
+\   P";
+brs (prems) 1;
+brs (prems RL [sym]) 1;
+br rcall3T 1;
+by (REPEAT (ares_tac prems 1));
+val hyprcall3T = result();
+
+val hyprcallTs = [hyprcallT,hyprcall2T,hyprcall3T];
+
+(*** Rules to Remove Induction Hypotheses after Type Checking ***)
+
+val prems = goal Wfd.thy
+    "[| ALL x:{x:A.<x,p>:wf(R)}.g(x):D(x); P |] ==> \
+\    P";
+by (REPEAT (ares_tac prems 1));
+val rmIH1  = result();
+
+val prems = goal Wfd.thy
+    "[| ALL x:A.ALL y:{y:B.<<x,y>,<p,q>>:wf(R)}.g(x,y):D(x,y); P |] ==> \
+\    P";
+by (REPEAT (ares_tac prems 1));
+val rmIH2  = result();
+
+val prems = goal Wfd.thy
+ "[| ALL x:A.ALL y:B.ALL z:{z:C.<<x,<y,z>>,<p,<q,r>>>:wf(R)}.g(x,y,z):D(x,y,z); \
+\    P |] ==> \
+\    P";
+by (REPEAT (ares_tac prems 1));
+val rmIH3  = result();
+
+val rmIHs = [rmIH1,rmIH2,rmIH3];
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/gfp.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,133 @@
+(*  Title: 	CCL/gfp
+    ID:         $Id$
+
+Modified version of
+    Title: 	HOL/gfp
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For gfp.thy.  The Knaster-Tarski Theorem for greatest fixed points.
+*)
+
+open Gfp;
+
+(*** Proof of Knaster-Tarski Theorem using gfp ***)
+
+(* gfp(f) is the least upper bound of {u. u <= f(u)} *)
+
+val prems = goalw Gfp.thy [gfp_def] "[| A <= f(A) |] ==> A <= gfp(f)";
+by (rtac (CollectI RS Union_upper) 1);
+by (resolve_tac prems 1);
+val gfp_upperbound = result();
+
+val prems = goalw Gfp.thy [gfp_def]
+    "[| !!u. u <= f(u) ==> u<=A |] ==> gfp(f) <= A";
+by (REPEAT (ares_tac ([Union_least]@prems) 1));
+by (etac CollectD 1);
+val gfp_least = result();
+
+val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) <= f(gfp(f))";
+by (EVERY1 [rtac gfp_least, rtac subset_trans, atac,
+	    rtac (mono RS monoD), rtac gfp_upperbound, atac]);
+val gfp_lemma2 = result();
+
+val [mono] = goal Gfp.thy "mono(f) ==> f(gfp(f)) <= gfp(f)";
+by (EVERY1 [rtac gfp_upperbound, rtac (mono RS monoD), 
+	    rtac gfp_lemma2, rtac mono]);
+val gfp_lemma3 = result();
+
+val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) = f(gfp(f))";
+by (REPEAT (resolve_tac [equalityI,gfp_lemma2,gfp_lemma3,mono] 1));
+val gfp_Tarski = result();
+
+(*** Coinduction rules for greatest fixed points ***)
+
+(*weak version*)
+val prems = goal Gfp.thy
+    "[| a: A;  A <= f(A) |] ==> a : gfp(f)";
+by (rtac (gfp_upperbound RS subsetD) 1);
+by (REPEAT (ares_tac prems 1));
+val coinduct = result();
+
+val [prem,mono] = goal Gfp.thy
+    "[| A <= f(A) Un gfp(f);  mono(f) |] ==>  \
+\    A Un gfp(f) <= f(A Un gfp(f))";
+by (rtac subset_trans 1);
+by (rtac (mono RS mono_Un) 2);
+by (rtac (mono RS gfp_Tarski RS subst) 1);
+by (rtac (prem RS Un_least) 1);
+by (rtac Un_upper2 1);
+val coinduct2_lemma = result();
+
+(*strong version, thanks to Martin Coen*)
+val prems = goal Gfp.thy
+    "[| a: A;  A <= f(A) Un gfp(f);  mono(f) |] ==> a : gfp(f)";
+by (rtac (coinduct2_lemma RSN (2,coinduct)) 1);
+by (REPEAT (resolve_tac (prems@[UnI1]) 1));
+val coinduct2 = result();
+
+(***  Even Stronger version of coinduct  [by Martin Coen]
+         - instead of the condition  A <= f(A)
+                           consider  A <= (f(A) Un f(f(A)) ...) Un gfp(A) ***)
+
+val [prem] = goal Gfp.thy "mono(f) ==> mono(%x.f(x) Un A Un B)";
+by (REPEAT (ares_tac [subset_refl, monoI, Un_mono, prem RS monoD] 1));
+val coinduct3_mono_lemma= result();
+
+val [prem,mono] = goal Gfp.thy
+    "[| A <= f(lfp(%x.f(x) Un A Un gfp(f)));  mono(f) |] ==> \
+\    lfp(%x.f(x) Un A Un gfp(f)) <= f(lfp(%x.f(x) Un A Un gfp(f)))";
+by (rtac subset_trans 1);
+br (mono RS coinduct3_mono_lemma RS lfp_lemma3) 1;
+by (rtac (Un_least RS Un_least) 1);
+br subset_refl 1;
+br prem 1;
+br (mono RS gfp_Tarski RS equalityD1 RS subset_trans) 1;
+by (rtac (mono RS monoD) 1);
+by (rtac (mono RS coinduct3_mono_lemma RS lfp_Tarski RS ssubst) 1);
+by (rtac Un_upper2 1);
+val coinduct3_lemma = result();
+
+val prems = goal Gfp.thy
+    "[| a:A;  A <= f(lfp(%x.f(x) Un A Un gfp(f))); mono(f) |] ==> a : gfp(f)";
+by (rtac (coinduct3_lemma RSN (2,coinduct)) 1);
+brs (prems RL [coinduct3_mono_lemma RS lfp_Tarski RS ssubst]) 1;
+br (UnI2 RS UnI1) 1;
+by (REPEAT (resolve_tac prems 1));
+val coinduct3 = result();
+
+
+(** Definition forms of gfp_Tarski, to control unfolding **)
+
+val [rew,mono] = goal Gfp.thy "[| h==gfp(f);  mono(f) |] ==> h = f(h)";
+by (rewtac rew);
+by (rtac (mono RS gfp_Tarski) 1);
+val def_gfp_Tarski = result();
+
+val rew::prems = goal Gfp.thy
+    "[| h==gfp(f);  a:A;  A <= f(A) |] ==> a: h";
+by (rewtac rew);
+by (REPEAT (ares_tac (prems @ [coinduct]) 1));
+val def_coinduct = result();
+
+val rew::prems = goal Gfp.thy
+    "[| h==gfp(f);  a:A;  A <= f(A) Un h; mono(f) |] ==> a: h";
+by (rewtac rew);
+by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct2]) 1));
+val def_coinduct2 = result();
+
+val rew::prems = goal Gfp.thy
+    "[| h==gfp(f);  a:A;  A <= f(lfp(%x.f(x) Un A Un h)); mono(f) |] ==> a: h";
+by (rewtac rew);
+by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct3]) 1));
+val def_coinduct3 = result();
+
+(*Monotonicity of gfp!*)
+val prems = goal Gfp.thy
+    "[| mono(f);  !!Z. f(Z)<=g(Z) |] ==> gfp(f) <= gfp(g)";
+by (rtac gfp_upperbound 1);
+by (rtac subset_trans 1);
+by (rtac gfp_lemma2 1);
+by (resolve_tac prems 1);
+by (resolve_tac prems 1);
+val gfp_mono = result();
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/gfp.thy	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,14 @@
+(*  Title: 	HOL/gfp.thy
+    ID:         $Id$
+    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
+    Copyright   1992  University of Cambridge
+
+Greatest fixed points
+*)
+
+Gfp = Lfp +
+consts gfp :: "['a set=>'a set] => 'a set"
+rules
+ (*greatest fixed point*)
+ gfp_def "gfp(f) == Union({u. u <= f(u)})"
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CCL/hered.ML	Thu Sep 16 12:20:38 1993 +0200
@@ -0,0 +1,196 @@
+(*  Title: 	CCL/hered
+    ID:         $Id$
+    Author: 	Martin Coen, Cambridge University Computer Laboratory
+    Copyright   1993  University of Cambridge
+
+For hered.thy.
+*)
+
+open Hered;
+
+fun type_of_terms (Const("Trueprop",_) $ (Const("op =",(Type ("fun", [t,_])))$_$_)) = t;
+
+val cong_rls = ccl_mk_congs Hered.thy  ["HTTgen"];
+
+(*** Hereditary Termination ***)
+
+goalw Hered.thy [HTTgen_def]  "mono(%X.HTTgen(X))";
+br monoI 1;
+by (fast_tac set_cs 1);
+val HTTgen_mono = result();
+
+goalw Hered.thy [HTTgen_def]
+  "t : HTTgen(A) <-> t=true | t=false | (EX a b.t=<a,b> & a : A & b : A) | \
+\                                       (EX f.t=lam x.f(x) & (ALL x.f(x) : A))";
+by (fast_tac set_cs 1);
+val HTTgenXH = result();
+
+goal Hered.thy
+  "t : HTT <-> t=true | t=false | (EX a b.t=<a,b> & a : HTT & b : HTT) | \
+\                                  (EX f.t=lam x.f(x) & (ALL x.f(x) : HTT))";
+br (rewrite_rule [HTTgen_def] 
+                 (HTTgen_mono RS (HTT_def RS def_gfp_Tarski) RS XHlemma1)) 1;
+by (fast_tac set_cs 1);
+val HTTXH = result();
+
+(*** Introduction Rules for HTT ***)
+
+goal Hered.thy "~ bot : HTT";
+by (fast_tac (term_cs addDs [XH_to_D HTTXH]) 1);
+val HTT_bot = result();
+
+goal Hered.thy "true : HTT";
+by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1);
+val HTT_true = result();
+
+goal Hered.thy "false : HTT";
+by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1);
+val HTT_false = result();
+
+goal Hered.thy "<a,b> : HTT <->  a : HTT  & b : HTT";
+br (HTTXH RS iff_trans) 1;
+by (fast_tac term_cs 1);
+val HTT_pair = result();
+
+goal Hered.thy "lam x.f(x) : HTT <-> (ALL x. f(x) : HTT)";
+br (HTTXH RS iff_trans) 1;
+by (SIMP_TAC term_ss 1);
+by (safe_tac term_cs);
+by (ASM_SIMP_TAC term_ss 1);
+by (fast_tac term_cs 1);
+val HTT_lam = result();
+
+local
+  val raw_HTTrews = [HTT_bot,HTT_true,HTT_false,HTT_pair,HTT_lam];
+  fun mk_thm s = prove_goalw Hered.thy data_defs s (fn _ => 
+                  [SIMP_TAC (term_ss addrews raw_HTTrews) 1]);
+in
+  val HTT_rews = raw_HTTrews @
+               map mk_thm ["one : HTT",
+                           "inl(a) : HTT <-> a : HTT",
+                           "inr(b) : HTT <-> b : HTT",
+                           "zero : HTT",
+                           "succ(n) : HTT <-> n : HTT",
+                           "[] : HTT",
+                           "x.xs : HTT <-> x : HTT & xs : HTT"];
+end;
+
+val HTT_Is = HTT_rews @ (HTT_rews RL [iffD2]);
+
+(*** Coinduction for HTT ***)
+
+val prems = goal Hered.thy "[|  t : R;  R <= HTTgen(R) |] ==> t : HTT";
+br (HTT_def RS def_coinduct) 1;
+by (REPEAT (ares_tac prems 1));
+val HTT_coinduct = result();
+
+fun HTT_coinduct_tac s i = res_inst_tac [("R",s)] HTT_coinduct i;
+
+val prems = goal Hered.thy 
+    "[|  t : R;   R <= HTTgen(lfp(%x. HTTgen(x) Un R Un HTT)) |] ==> t : HTT";
+br (HTTgen_mono RSN(3,HTT_def RS def_coinduct3)) 1;
+by (REPEAT (ares_tac prems 1));
+val HTT_coinduct3 = result();
+val HTT_coinduct3_raw = rewrite_rule [HTTgen_def] HTT_coinduct3;
+
+fun HTT_coinduct3_tac s i = res_inst_tac [("R",s)] HTT_coinduct3 i;
+
+val HTTgenIs = map (mk_genIs Hered.thy data_defs HTTgenXH HTTgen_mono)
+       ["true : HTTgen(R)",
+        "false : HTTgen(R)",
+        "[| a : R;  b : R |] ==> <a,b> : HTTgen(R)",
+        "[| !!x. b(x) : R |] ==> lam x.b(x) : HTTgen(R)",
+        "one : HTTgen(R)",
+        "a : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
+\                         inl(a) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "b : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
+\                         inr(b) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "zero : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "n : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
+\                         succ(n) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "[] : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
+        "[| h : lfp(%x. HTTgen(x) Un R Un HTT); t : lfp(%x. HTTgen(x) Un R Un HTT) |] ==>\
+\                         h.t : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))"];
+
+(*** Formation Rules for Types ***)
+
+goal Hered.thy "Unit <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,UnitXH] @ HTT_rews)) 1);
+val UnitF = result();
+
+goal Hered.thy "Bool <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,BoolXH] @ HTT_rews)) 1);
+by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
+val BoolF = result();
+
+val prems = goal Hered.thy "[| A <= HTT;  B <= HTT |] ==> A + B  <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,PlusXH] @ HTT_rews)) 1);
+by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
+val PlusF = result();
+
+val prems = goal Hered.thy 
+     "[| A <= HTT;  !!x.x:A ==> B(x) <= HTT |] ==> SUM x:A.B(x) <= HTT";
+by (SIMP_TAC (CCL_ss addrews ([subsetXH,SgXH] @ HTT_rews)) 1);
+by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
+val SigmaF = result();
+
+(*** Formation Rules for Recursive types - using coinduction these only need ***)
+(***                                          exhaution rule for type-former ***)
+
+(*Proof by induction - needs induction rule for type*)
+goal Hered.thy "Nat <= HTT";
+by (SIMP_TAC (term_ss addrews [subsetXH]) 1);
+by (safe_tac set_cs);
+be Nat_ind 1;
+by (ALLGOALS (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD]))));
+val NatF = result();
+
+goal Hered.thy "Nat <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI] addEs [XH_to_E NatXH]) 1);
+val NatF = result();
+
+val [prem] = goal Hered.thy "A <= HTT ==> List(A) <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addSIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
+                 addEs [XH_to_E ListXH]) 1);
+val ListF = result();
+
+val [prem] = goal Hered.thy "A <= HTT ==> Lists(A) <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addSIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
+                 addEs [XH_to_E ListsXH]) 1);
+val ListsF = result();
+
+val [prem] = goal Hered.thy "A <= HTT ==> ILists(A) <= HTT";
+by (safe_tac set_cs);
+be HTT_coinduct3 1;
+by (fast_tac (set_cs addSIs HTTgenIs 
+                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
+                 addEs [XH_to_E IListsXH]) 1);
+val IListsF = result();
+
+(*** A possible use for this predicate is proving equality from pre-order       ***)
+(*** but it seems as easy (and more general) to do this directly by coinduction ***)
+(*
+val prems = goal Hered.thy "[| t : HTT;  t [= u |] ==> u [= t";
+by (po_