Initial revision
authorclasohm
Thu Sep 16 12:20:38 1993 +0200 (1993-09-16)
changeset 0a5a9c433f639
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
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/CHANGES-92f.txt	Thu Sep 16 12:20:38 1993 +0200
     1.3 @@ -0,0 +1,40 @@
     1.4 +**** Isabelle-92f : a faster version of Isabelle-92 ****
     1.5 +
     1.6 +Isabelle now runs faster through a combination of improvements: pattern
     1.7 +unification, discrimination nets and removal of assumptions during
     1.8 +simplification.  Classical reasoning (e.g. fast_tac) runs up to 30% faster
     1.9 +when large numbers of rules are involved.  Rewriting (e.g. SIMP_TAC) runs
    1.10 +up to 3 times faster for large subgoals.  
    1.11 +
    1.12 +The new version will not benefit everybody; unless you require greater
    1.13 +speed, it may be best to stay with the existing version.  The new changes
    1.14 +have not been documented properly, and there are a few incompatibilities.
    1.15 +
    1.16 +THE SPEEDUPS
    1.17 +
    1.18 +Pattern unification is completely invisible to users.  It efficiently
    1.19 +handles a common case of higher-order unification.
    1.20 +
    1.21 +Discrimination nets replace the old stringtrees.  They provide fast lookup
    1.22 +in a large set of rules for matching or unification.  New "net" tactics
    1.23 +replace the "compat_..." tactics based on stringtrees.  Tactics
    1.24 +biresolve_from_nets_tac, bimatch_from_nets_tac, resolve_from_net_tac and
    1.25 +match_from_net_tac take a net, rather than a list of rules, and perform
    1.26 +resolution or matching.  Tactics net_biresolve_tac, net_bimatch_tac
    1.27 +net_resolve_tac and net_match_tac take a list of rules, build a net
    1.28 +(internally) and perform resolution or matching.
    1.29 +
    1.30 +The tactical METAHYPS, which allows a subgoal's hypotheses to be taken as a
    1.31 +list of theorems, has been extended to handle unknowns (although not type
    1.32 +unknowns).  The simplification tactics now use METAHYPS to economise on
    1.33 +storage consumption, and to avoid problems involving "parameters" bound in
    1.34 +a subgoal.  The modified simplifier now requires the auto_tac to take an
    1.35 +extra argument: a list of theorems, which represents the assumptions of the
    1.36 +current subgoal.
    1.37 +
    1.38 +OTHER CHANGES
    1.39 +
    1.40 +Apart from minor improvements in Pure Isabelle, the main other changes are
    1.41 +extensions to object-logics.  HOL now contains a treatment of co-induction
    1.42 +and co-recursion, while ZF contains a formalization of equivalence classes,
    1.43 +the integers and binary arithmetic.  None of this material is documented.
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/COPYRIGHT	Thu Sep 16 12:20:38 1993 +0200
     2.3 @@ -0,0 +1,21 @@
     2.4 +ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER.
     2.5 +
     2.6 +Copyright (C) 1992 by the University of Cambridge, Cambridge, England.
     2.7 +
     2.8 +Permission to use, copy, modify, and distribute this software and its
     2.9 +documentation for any non-commercial purpose and without fee is hereby
    2.10 +granted, provided that the above copyright notice appears in all copies and
    2.11 +that both the copyright notice and this permission notice and warranty
    2.12 +disclaimer appear in supporting documentation, and that the name of the
    2.13 +University of Cambridge not be used in advertising or publicity pertaining
    2.14 +to distribution of the software without specific, written prior permission.
    2.15 +
    2.16 +The University of Cambridge disclaims all warranties with regard to this
    2.17 +software, including all implied warranties of merchantability and fitness.
    2.18 +In no event shall the University of Cambridge be liable for any special,
    2.19 +indirect or consequential damages or any damages whatsoever resulting from
    2.20 +loss of use, data or profits, whether in an action of contract, negligence
    2.21 +or other tortious action, arising out of or in connection with the use or
    2.22 +performance of this software.
    2.23 +
    2.24 +
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/EMAILDIST-README	Thu Sep 16 12:20:38 1993 +0200
     3.3 @@ -0,0 +1,37 @@
     3.4 +ISABELLE -- INSTRUCTIONS FOR UNPACKING THE EMAIL DISTRIBUTION 
     3.5 +
     3.6 +The Isabelle email distribution consists of about 8 installments, each
     3.7 +small enough to send by electronic mail.  The files are called Isabelle.aa,
     3.8 +Isabelle.ab, ....  They have been generated by tar, compress, uuencode, and
     3.9 +split, and are packed for email using shar.  To unpack the files, perform
    3.10 +the following steps:
    3.11 +
    3.12 +STEP 1.  Create a new directory to hold Isabelle and move to that
    3.13 +directory (the name of the directory does not matter):
    3.14 +
    3.15 +	mkdir Isabelle;  cd Isabelle
    3.16 +
    3.17 +STEP 2.  Put each message into a separate file and pipe it through unshar.
    3.18 +(If you don't have unshar, remove the header lines generated by the mail
    3.19 +system and submit the file to sh.)
    3.20 +
    3.21 +STEP 3.  Concatenate the files into one file using the command
    3.22 +
    3.23 +	cat Isabelle.?? > 92.tar.Z.uu
    3.24 +
    3.25 +STEP 4.  Undo the uuencode operation using the command
    3.26 +
    3.27 +	uudecode 92.tar.Z.uu
    3.28 +
    3.29 +STEP 5.  You should now have a file 92.tar.Z; uncompress and unpack it using...
    3.30 +
    3.31 +   	uncompress -c 92.tar.Z | tar xf -
    3.32 +
    3.33 +STEP 6.  You should now have a complete Isabelle directory, called 92.  You
    3.34 +may now tidy up by executing
    3.35 +
    3.36 +	rm Isabelle.?? *.hdr 92.tar.Z.uu 92.tar.Z
    3.37 +
    3.38 +Consult the file 92/README for information on compiling Isabelle.
    3.39 +
    3.40 +						Good luck!
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/README	Thu Sep 16 12:20:38 1993 +0200
     4.3 @@ -0,0 +1,113 @@
     4.4 +		     ISABELLE-92 DISTRIBUTION DIRECTORY
     4.5 +
     4.6 +------------------------------------------------------------------------------
     4.7 +ISABELLE-92 IS INCOMPATIBLE WITH EARLIER VERSIONS.  PLEASE CONSULT THE
     4.8 +DOCUMENTATION.
     4.9 +------------------------------------------------------------------------------
    4.10 +
    4.11 +This directory contains the complete Isabelle system.  To build and test the
    4.12 +entire system, including all object-logics, use the shell script make-all.
    4.13 +Pure Isabelle and each of the object-logics can be built separately using the
    4.14 +Makefiles in the respective directories; read them for more information.
    4.15 +
    4.16 +				THE MAKEFILES
    4.17 +
    4.18 +The Makefiles can use two different Standard ML compilers: Poly/ML version
    4.19 +1.88MSX or later (from Abstract Hardware Ltd) and Standard ML of New Jersey
    4.20 +(Version 75 or later).  Poly/ML is a commercial product and costs money,
    4.21 +but it is reliable and its database system is convenient for interactive
    4.22 +work.  SML of New Jersey requires lots of memory and disc space, but it is
    4.23 +free and its code sometimes runs faster.  Both compilers are perfectly
    4.24 +satisfactory for running Isabelle.
    4.25 +
    4.26 +The Makefiles and make-all use enviroment variables that you should set
    4.27 +according to your site configuration.
    4.28 +
    4.29 +ISABELLEBIN is the directory to hold Poly/ML databases or New Jersey ML
    4.30 +images.  When using Poly/ML, ISABELLEBIN must be an absolute pathname (one
    4.31 +starting with "/").
    4.32 +
    4.33 +ML_DBASE is an absolute pathname to the initial Poly/ML database (not
    4.34 +required for New Jersey ML).
    4.35 +
    4.36 +ISABELLECOMP is the ML compiler, typically "poly -noDisplay" or "sml".  If
    4.37 +ISABELLECOMP begins with the letters "poly" then the Makefiles assume that
    4.38 +it is Poly/ML; if it begins with the letters "sml" then they assume
    4.39 +Standard ML of New Jersey.
    4.40 +
    4.41 +
    4.42 +			 STRUCTURE OF THIS DIRECTORY
    4.43 +
    4.44 +The directory Pure containes pure Isabelle, which has no object-logic.
    4.45 +
    4.46 +Other important files include...
    4.47 +    COPYRIGHT   	Copyright notice and Disclaimer of Warranty
    4.48 +    make-rulenames	shell script used during Make
    4.49 +    make-all		shell script for building entire system
    4.50 +    expandshort		shell script to expand "shortcuts" in files
    4.51 +    prove_goal.el       Emacs command to change proof format
    4.52 +    xlisten		shell script for running Isabelle under X
    4.53 +    teeinput		shell script to run Isabelle, logging inputs to a file
    4.54 +    theory-template.ML	template file for defining new theories
    4.55 +    Pure		directory of source files for Pure Isabelle
    4.56 +    Provers		directory of generic theorem provers
    4.57 +
    4.58 +xlisten sets up a window running Isabelle, with a separate small "listener"
    4.59 +window, which keeps a log of all input lines.  This log is a useful record
    4.60 +of a session.  If you are not running X windows, teeinput can still be used at
    4.61 +least to record (if not to display) the log.
    4.62 +
    4.63 +The following subdirectories contain object-logics:
    4.64 +    FOL 	Natural deduction logic (intuitionistic and classical)
    4.65 +    ZF		Zermelo-Fraenkel Set theory
    4.66 +    CTT		Constructive Type Theory
    4.67 +    HOL		Classical Higher-Order Logic
    4.68 +    LK		Classical sequent calculus
    4.69 +    Modal	The modal logics T, S4, S43
    4.70 +    LCF         Logic for Computable Functions (domain theory)
    4.71 +    Cube	Barendregt's Lambda Cube
    4.72 +
    4.73 +Object-logics include examples files in subdirectory ex or file ex.ML.
    4.74 +These files can be loaded in batch mode.  The commands can also be
    4.75 +executed interactively, using the windows on your workstation.  This is a
    4.76 +good way to get started.
    4.77 +
    4.78 +Each object-logic is built on top of Pure Isabelle, and possibly on top of
    4.79 +another object logic (like FOL or LK).  A database or binary called Pure is
    4.80 +first created, then the object-logic is loaded on top.  Poly/ML extends
    4.81 +Pure using its "make_database" operation.  Standard ML of New Jersey starts
    4.82 +with the Pure core image and loads the object-logic's ROOT.ML.
    4.83 +
    4.84 +		HOW TO GET A STANDARD ML COMPILER
    4.85 +
    4.86 +To obtain Poly/ML, contact Mike Crawley <mjc@ahl.co.uk> at Abstract
    4.87 +Hardware Ltd, The Howell Building, Brunel University, Uxbridge UB8 3PH,
    4.88 +England.
    4.89 +
    4.90 +To obtain Standard ML of New Jersey, contact David MacQueen
    4.91 +<dbm@com.att.research> at AT&T Bell Laboratories, 600 Mountain Avenue,
    4.92 +Murray Hill, NJ 07974, USA.  This compiler is available by FTP.  Connect to
    4.93 +research.att.com; login as anonymous with your userid as password; set
    4.94 +binary mode; transfer files from the directory dist/ml.
    4.95 +
    4.96 +------------------------------------------------------------------------------
    4.97 +
    4.98 +Please report any problems you encounter.  While we will try to be helpful,
    4.99 +we can accept no responsibility for the deficiences of Isabelle amd their
   4.100 +consequences.
   4.101 +
   4.102 +Lawrence C Paulson		E-mail: lcp@cl.cam.ac.uk
   4.103 +Computer Laboratory 		Phone: +44-223-334600
   4.104 +University of Cambridge 	Fax:   +44-223-334748 
   4.105 +Pembroke Street 
   4.106 +Cambridge CB2 3QG 
   4.107 +England
   4.108 +
   4.109 +Tobias Nipkow			E-mail: nipkow@informatik.tu-muenchen.de
   4.110 +Institut fuer Informatik	Phone: +49-89-2105-2690
   4.111 +T. U. Muenchen			Fax:   +49-89-2105-8183
   4.112 +Postfach 20 24 20
   4.113 +D-8000 Muenchen 2
   4.114 +Germany
   4.115 +
   4.116 +Last updated 25 August 1992
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/agrep	Thu Sep 16 12:20:38 1993 +0200
     5.3 @@ -0,0 +1,2 @@
     5.4 +#! /bin/csh
     5.5 +grep "$*" {Pure/Syntax,Pure/Thy}/*ML */*ML */ex/*ML 
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/edits.txt	Thu Sep 16 12:20:38 1993 +0200
     6.3 @@ -0,0 +1,1372 @@
     6.4 +EDITS TO THE ISABELLE SYSTEM FOR 1993
     6.5 +
     6.6 +11 January 
     6.7 +
     6.8 +*/README: Eliminated references to Makefile.NJ, which no longer exists.
     6.9 +
    6.10 +**** New tar file placed on /homes/lcp (464K) **** 
    6.11 +
    6.12 +14 January
    6.13 +
    6.14 +Provers/simp/pr_goal_lhs: now distinct from pr_goal_concl so that tracing
    6.15 +prints conditions correctly.
    6.16 +
    6.17 +{CTT/arith,HOL/ex/arith/ZF/arith}/add_mult_distrib: renamed from
    6.18 +add_mult_dist, to agree with the other _distrib rules
    6.19 +
    6.20 +20 January
    6.21 +
    6.22 +Pure/Syntax/type_ext.ML: "I have fixed a few anomalies in the pretty
    6.23 +printing annotations for types.  Only the layout has changed." -- Toby
    6.24 +
    6.25 +21 January
    6.26 +
    6.27 +{CTT/arith,HOL/ex/arith/ZF/arith}/add_inverse_diff: renamed to add_diff_inverse
    6.28 +
    6.29 +22 January
    6.30 +
    6.31 +ZF/ex/equiv: new theory of equivalence classes
    6.32 +ZF/ex/integ: new theory of integers
    6.33 +HOL/set.thy: added indentation of 3 to all binding operators
    6.34 +
    6.35 +ZF/bool/boolI0,boolI1: renamed as bool_0I, bool_1I
    6.36 +
    6.37 +25 January
    6.38 +
    6.39 +MAKE-ALL (NJ 0.75) ran perfectly.  It took 3:19 hours!?
    6.40 +
    6.41 +ZF/bool/not,and,or,xor: new
    6.42 +
    6.43 +27 January
    6.44 +
    6.45 +ZF/ex/bin: new theory of binary integer arithmetic
    6.46 +
    6.47 +27 January
    6.48 +
    6.49 +MAKE-ALL (Poly/ML) ran perfectly.  It took 6:33 hours???
    6.50 +(ZF took almost 5 hours!)
    6.51 +
    6.52 +**** New tar file placed on /homes/lcp (472K) **** 
    6.53 +
    6.54 +HOL/set/UN_cong,INT_cong: new
    6.55 +HOL/subset/mem_rews,set_congs,set_ss: new
    6.56 +HOL/simpdata/o_apply: new; added to HOL_ss
    6.57 +
    6.58 +29 January
    6.59 +
    6.60 +Pure/Thy/syntax/mk_structure: the dummy theory created by type infixes is
    6.61 +now called name^"(type infix)" instead of "", avoid triggering a spurious
    6.62 +error "Attempt to merge different versions of theory: " in
    6.63 +Pure/sign/merge_stamps
    6.64 +
    6.65 +2 February
    6.66 +
    6.67 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:48 hours.  Runs in 1992 took
    6.68 +under 2:20 hours, but the new files in ZF/ex take time: nearly 23 minutes
    6.69 +according to make10836.log.
    6.70 +
    6.71 +Pure/Thy/scan/comment: renamed from komt
    6.72 +Pure/Thy/scan/numeric: renamed from zahl
    6.73 +
    6.74 +Pure/Syntax/syntax,lexicon,type_ext,extension,sextension: modified by
    6.75 +Tobias to change ID, TVAR, ... to lower case.
    6.76 +
    6.77 +Cube/cube.thy,HOL/hol.thy,HOL/set.thy,CTT/ctt.thy,LK/lk.thy,ZF/zf.thy: now
    6.78 +with ID, ... in lower case and other tidying
    6.79 +
    6.80 +3 February
    6.81 +
    6.82 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:50 hours.
    6.83 +
    6.84 +4 February
    6.85 +
    6.86 +HOL/nat/nat_ss: now includes the rule Suc_less_eq: (Suc(m) < Suc(n)) = (m<n)
    6.87 +and the nat_case rules and congruence rules
    6.88 +
    6.89 +HOL/sum/sumE: now has the "strong" form with equality assumptions.  WAS
    6.90 +    val prems = goalw Sum.thy [Inl_def,Inr_def]
    6.91 +	"[| !!x::'a. P(Inl(x));  !!y::'b. P(Inr(y)) \
    6.92 +    \    |] ==> P(s)";
    6.93 +    by (res_inst_tac [("t","s")] (Rep_Sum_inverse RS subst) 1);
    6.94 +    by (rtac (rewrite_rule [Sum_def] Rep_Sum RS CollectE) 1);
    6.95 +    by (REPEAT (eresolve_tac [disjE,exE,ssubst] 1 ORELSE resolve_tac prems 1));
    6.96 +    val sumE = result();
    6.97 +
    6.98 +8 February
    6.99 +
   6.100 +Changes from Tobias:
   6.101 +Pure/Thy/parse: now list_of admits the empty phrase, while listof_1 does not
   6.102 +Pure/Thy/syntax: uses new list_of, list_of1
   6.103 +
   6.104 +9 February
   6.105 +
   6.106 +HOL/ex/arith: moved to main HOL directory
   6.107 +HOL/prod: now define the type "unit" and constant "(): unit"
   6.108 +
   6.109 +11 February
   6.110 +
   6.111 +HOL/arith: eliminated redefinitions of nat_ss and arith_ss
   6.112 +
   6.113 +12 February
   6.114 +
   6.115 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:50 hours.
   6.116 +
   6.117 +Pure/Thy/scan/string: now correctly recognizes ML-style strings.
   6.118 +
   6.119 +15 February
   6.120 +
   6.121 +MAKE-ALL (NJ 0.75) ran perfectly.  It took 1:37 hours (on albatross)
   6.122 +MAKE-ALL (NJ 0.75) ran perfectly.  It took 2:42 hours (on dunlin)
   6.123 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:53 hours (on dunlin)
   6.124 +
   6.125 +**** New tar file placed on /homes/lcp (480K) **** 
   6.126 +
   6.127 +18 February
   6.128 +
   6.129 +Pure/Syntax/earley0A/compile_xgram: Tobias deleted the third argument, as
   6.130 +it was unused.
   6.131 +
   6.132 +Pure/Syntax/earley0A: modified accordingly.
   6.133 +
   6.134 +19 February
   6.135 +
   6.136 +MAKE-ALL (NJ 0.75) ran perfectly.  It took 3:37 hours 
   6.137 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:52 hours
   6.138 +
   6.139 +**** New tar file placed on /homes/lcp (480K) **** 
   6.140 +
   6.141 +20 February
   6.142 +
   6.143 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:30 hours 
   6.144 +
   6.145 +10 March
   6.146 +
   6.147 +HOL/fun/image_eqI: fixed bad pattern
   6.148 +
   6.149 +11 March
   6.150 +
   6.151 +MAKE-ALL (Poly/ML) failed in HOL!
   6.152 +
   6.153 +HOL/fun: moved "mono" proofs to HOL/subset, since they rely on subset laws
   6.154 +of Int and Un.
   6.155 +
   6.156 +12 March
   6.157 +
   6.158 +ZF/ex/misc: new example from Bledsoe
   6.159 +
   6.160 +15 March
   6.161 +
   6.162 +ZF/perm: two new theorems inspired by Pastre
   6.163 +
   6.164 +16 March
   6.165 +
   6.166 +Weakened congruence rules for HOL: speeds simplification considerably by
   6.167 +NOT simplifying the body of a conditional or eliminator.
   6.168 +
   6.169 +HOL/simpdata/mk_weak_congs: new, to make weakened congruence rules
   6.170 +
   6.171 +HOL/simpdata/congs: renamed HOL_congs and weakened the "if" rule
   6.172 +
   6.173 +HOL/simpdata/HOL_congs: now contains polymorphic rules for the overloaded
   6.174 +operators < and <=
   6.175 +
   6.176 +HOL/prod: weakened the congruence rule for split
   6.177 +HOL/sum: weakened the congruence rule for case
   6.178 +HOL/nat: weakened the congruence rule for nat_case and nat_rec
   6.179 +HOL/list: weakened the congruence rule for List_rec and list_rec
   6.180 +
   6.181 +HOL & test rebuilt perfectly
   6.182 +
   6.183 +Pure/goals/prepare_proof/mkresult: fixed bug in signature check.  Now
   6.184 +compares the FINAL signature with that from the original theory.
   6.185 +
   6.186 +Pure/goals/prepare_proof: ensures that [prove_]goalw checks that the
   6.187 +definitions do not update the proof state.
   6.188 +
   6.189 +17 March
   6.190 +
   6.191 +MAKE-ALL (Poly/ML) ran perfectly.
   6.192 +
   6.193 +18 March
   6.194 +
   6.195 +MAKE-ALL (Poly/ML) failed in HOL/ex/Substitutions
   6.196 +
   6.197 +HOL/ex/Subst/setplus: changed Set.thy to Setplus.thy where
   6.198 +necessary
   6.199 +
   6.200 +ZF/perm: proved some rules about inj and surj
   6.201 +
   6.202 +ZF/ex/misc: did some of Pastre's examples
   6.203 +
   6.204 +Pure/library/gen_ins,gen_union: new
   6.205 +
   6.206 +HOL/ex/Subst/subst: renamed rangeE to srangeE
   6.207 +
   6.208 +18 March
   6.209 +
   6.210 +MAKE-ALL (Poly/ML) failed in HOL/ex/term due to renaming of list_ss in
   6.211 +ex/Subst/alist
   6.212 +
   6.213 +HOL/list/list_congs: new; re-organized simpsets a bit
   6.214 +
   6.215 +Pure/goals/sign_error: new
   6.216 +
   6.217 +Pure/goals/prepare_proof,by_com: now print the list of new theories when
   6.218 +the signature of the proof state changes 
   6.219 +
   6.220 +HOL/prod,sexp: renamed fst, snd to fst_conv, snd_conv to avoid over-writing
   6.221 +the library functions fst, snd
   6.222 +
   6.223 +HOL/fun/image_compose: new
   6.224 +
   6.225 +21 March
   6.226 +
   6.227 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:50 hours 
   6.228 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:21 hours
   6.229 +Much slower now (about 30 minutes!) because of HOL/ex/Subst
   6.230 +
   6.231 +**** New tar file placed on /homes/lcp (504K) **** 
   6.232 +
   6.233 +ZF/pair,simpdata: renamed fst, snd to fst_conv, snd_conv to avoid over-writing
   6.234 +the library functions fst, snd
   6.235 +
   6.236 +HOL/prod/prod_fun_imageI,E: new
   6.237 +
   6.238 +HOL/ex/Subst/Unify: renamed to Unifier to avoid clobbering structure Unify
   6.239 +of Pure
   6.240 +
   6.241 +24 March
   6.242 +
   6.243 +HOL/trancl/comp_subset_Sigma: new
   6.244 +HOL/wf/wfI: new
   6.245 +
   6.246 +HOL/Subst: moved from HOL/ex/Subst to shorten pathnames
   6.247 +HOL/Makefile: target 'test' now loads Subst/ROOT separately
   6.248 +
   6.249 +*** Installation of gfp, coinduction, ... to HOL ***
   6.250 +
   6.251 +HOL/gfp,llist: new
   6.252 +HOL/univ,sexp,list: replaced with new version
   6.253 +
   6.254 +Sexp is now the set of all well-founded trees, each of type 'a node set.
   6.255 +There is no longer a type 'sexp'.  Initial algebras require more explicit
   6.256 +type checking than before.  Defining a type 'sexp' would eliminate this,
   6.257 +but would also require a whole new set of primitives, similar to those
   6.258 +defined in univ.thy but restricted to well-founded trees.
   6.259 +
   6.260 +25 March
   6.261 +
   6.262 +Pure/thm: renamed 'bires' to 'eres' in many places (not exported) --
   6.263 +biresolution now refers to resolution with (flag,rule) pairs.
   6.264 +
   6.265 +Pure/thm/bicompose_aux: SOUNDNESS BUG concerning variable renaming.  A Var in
   6.266 +a premise was getting renamed when its occurrence in the flexflex pairs was
   6.267 +not.  Martin Coen supplied the following proof of True=False in HOL:
   6.268 +
   6.269 +    val [prem] = goal Set.thy "EX a:{c}.p=a ==> p=c";
   6.270 +    br (prem RS bexE) 1; be ssubst 1; be singletonD 1;
   6.271 +    val l1 = result();
   6.272 +
   6.273 +    val rls = [refl] RL [bexI] RL [l1];
   6.274 +
   6.275 +    goal Set.thy "True = False";
   6.276 +    brs rls 1; br singletonI 1;
   6.277 +    result();
   6.278 +
   6.279 +Marcus Moore noted that the error only occurred with
   6.280 +Logic.auto_rename:=false.  Elements of the fix:
   6.281 +
   6.282 +1.  rename_bvs, rename_bvars and bicompose_aux/newAs take tpairs (the
   6.283 +existing flex-flex pairs) as an extra argument.  rename_bvs preserves all
   6.284 +Vars in tpairs.
   6.285 +
   6.286 +2.  bicompose_aux/tryasms and res now unpack the "cell" and supply its tpairs
   6.287 +to newAs.
   6.288 +
   6.289 +HOL/lfp,gfp,ex/set: renamed Tarski to lfp_Tarski
   6.290 +
   6.291 +HOL/lfp,list,llist,nat,sexp,trancl,Subst/uterm,ex/simult,ex/term: renamed
   6.292 +def_Tarski to def_lfp_Tarski 
   6.293 +
   6.294 +26 March
   6.295 +
   6.296 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:25 hours!
   6.297 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:54 hours! (jobs overlapped)
   6.298 +
   6.299 +Pure/Thy/scan/is_digit,is_letter: deleted.  They are already in
   6.300 +Pure/library, and these versions used non-Standard string comparisons!
   6.301 +
   6.302 +Repairing a fault reported by David Aspinall:
   6.303 +  show_types := true;  read "a";  (* followed by  'prin it' for NJ *)
   6.304 +Raises exception  LIST "hd".   Also has the side effect of leaving
   6.305 +show_types set at false. 
   6.306 +
   6.307 +Pure/goals/read: no longer creates a null TVar
   6.308 +Pure/Syntax/lexicon/string_of_vname: now handles null names
   6.309 +Pure/Syntax/printer/string_of_typ: tidied
   6.310 +
   6.311 +/usr/groups/theory/isabelle/92/Pure/thm: replaced by new version to fix bug
   6.312 +MAKE-ALL on this directory ran perfectly
   6.313 +/usr/groups/theory/ml-aftp/Isabelle92.tar.Z: replaced by new version
   6.314 +
   6.315 +29 March
   6.316 +
   6.317 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:14 hours!
   6.318 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:43 hours!
   6.319 +
   6.320 +**** New tar file placed on /homes/lcp (518K) **** 
   6.321 +
   6.322 +30 March
   6.323 +
   6.324 +ZF/univ/cons_in_Vfrom: deleted "[| a: Vfrom(A,i);  b<=Vfrom(A,i) |] ==>
   6.325 +cons(a,b) : Vfrom(A,succ(i))" since it was useless.
   6.326 +
   6.327 +8 April
   6.328 +
   6.329 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:49 hours!
   6.330 +
   6.331 +**** New tar file placed on /homes/lcp (520K) **** 
   6.332 +
   6.333 +**** Updates for pattern unification (Tobias Nipkow) ****
   6.334 +
   6.335 +Pure/pattern.ML: new, pattern unification
   6.336 +
   6.337 +Pure/Makefile and ROOT.ML: included pattern.ML
   6.338 +
   6.339 +Pure/library.ML: added predicate downto0
   6.340 +
   6.341 +Pure/unify.ML: call pattern unification first. Removed call to could_unify.
   6.342 +
   6.343 +FOL/Makefile/FILES: now mentions ifol.ML (previously repeated fol.ML instead)
   6.344 +
   6.345 +**** Installation of Martin Coen's FOLP (FOL + proof objects) ****
   6.346 +
   6.347 +renamed PFOL, PIFOL to FOLP, IFOLP, etc.
   6.348 +
   6.349 +9 April
   6.350 +
   6.351 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:05 hours!
   6.352 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:31 hours!
   6.353 +
   6.354 +**** New tar file placed on /homes/lcp (576K) **** 
   6.355 +
   6.356 +**** Installation of Discrimination Nets ****
   6.357 +
   6.358 +*Affected files (those mentioning Stringtree, compat_thms or rtr_resolve_tac)
   6.359 +Pure/ROOT.ML,goals.ML,stringtree.ML,tactic.ML
   6.360 +Provers/simp.ML
   6.361 +HOL/ex/meson.ML
   6.362 +
   6.363 +*Affected files (those mentioning compat_resolve_tac)
   6.364 +Pure/tactic.ML
   6.365 +Provers/typedsimp.ML
   6.366 +CTT/ctt.ML
   6.367 +
   6.368 +Pure/stringtree: saved on Isabelle/old
   6.369 +Pure/net: new
   6.370 +Pure/Makefile/FILES: now mentions net.ML, not stringtree.ML
   6.371 +Pure/ROOT: now mentions net.ML, not stringtree.ML
   6.372 +
   6.373 +Pure/goals/compat_goal: DELETED
   6.374 +
   6.375 +Pure/tactic/compat_thms,rtr_resolve_tac,compat_resolve_tac,insert_thm,
   6.376 +delete_thm,head_string: DELETED
   6.377 +
   6.378 +Pure/tactic/biresolve_from_nets_tac, bimatch_from_nets_tac,
   6.379 +net_biresolve_tac, net_bimatch_tac, resolve_from_net_tac, match_from_net_tac,
   6.380 +net_resolve_tac, net_match_tac: NEW
   6.381 +
   6.382 +Pure/tactic/filt_resolve_tac: new implementation using nets!
   6.383 +
   6.384 +Provers/simp: replaced by new version
   6.385 +
   6.386 +Provers/typedsimp: changed compat_resolve_tac to filt_resolve_tac and
   6.387 +updated comments
   6.388 +
   6.389 +CTT/ctt.ML: changed compat_resolve_tac to filt_resolve_tac 
   6.390 +ZF/simpdata/typechk_step_tac: changed compat_resolve_tac to filt_resolve_tac
   6.391 +
   6.392 +CTT tested
   6.393 +
   6.394 +HOL/ex/meson/ins_term,has_reps: replaced Stringtree by Net
   6.395 +
   6.396 +FOL tested
   6.397 +
   6.398 +Provers/simp/cong_const: new, replaces head_string call in cong_consts
   6.399 +Provers/simp: renamed variables: atomic to at and cong_consts to ccs
   6.400 +
   6.401 +ZF/ex/bin/integ_of_bin_type: proof required reordering of rules --
   6.402 +typechk_tac now respects this ordering!
   6.403 +
   6.404 +ZF tested
   6.405 +
   6.406 +DOCUMENTATION
   6.407 +
   6.408 +Logics/CTT: Removed mention of compat_resolve_tac 
   6.409 +Ref/goals: deleted compat_goal's entry
   6.410 +
   6.411 +Provers/hypsubst/lasthyp_subst_tac: deleted
   6.412 +
   6.413 +FOLP/ROOT/dest_eq: corrected; now hyp_subst_tac works!
   6.414 +
   6.415 +12 April
   6.416 +
   6.417 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:03 hours!
   6.418 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:28 hours!
   6.419 +
   6.420 +FOLP/{int-prover,classical}/safe_step_tac: uses eq_assume_tac, not assume_tac
   6.421 +FOLP/{int-prover,classical}/inst_step_tac: restored, calls assume and mp_tac
   6.422 +FOLP/{int-prover,classical}/step_tac: calls inst_step_tac 
   6.423 +
   6.424 +{FOL,FOLP}/int-prover/safe_brls: removed (asm_rl,true) since assume_tac is
   6.425 +used explicitly!!
   6.426 +
   6.427 +FOLP/ifolp/uniq_assume_tac: new, since eq_assume_tac is almost useless
   6.428 +
   6.429 +FOLP/{int-prover,classical}/uniq_mp_tac: replace eq_mp_tac and call
   6.430 +uniq_assume_tac
   6.431 +
   6.432 +Provers/classical: REPLACED BY 'NET' VERSION!
   6.433 +
   6.434 +13 April
   6.435 +
   6.436 +MAKE-ALL (Poly/ML) failed in ZF and ran out of quota for Cube.
   6.437 +
   6.438 +Unification bug (nothing to do with pattern unification)
   6.439 +Cleaning of flex-flex pairs attempts to remove all occurrences of bound
   6.440 +variables not common to both sides.  Arguments containing "banned" bound
   6.441 +variables are deleted -- but this should ONLY be done if the occurrence is
   6.442 +rigid!
   6.443 +
   6.444 +unify/CHANGE_FAIL: new, for flexible occurrence of bound variable
   6.445 +unify/change_bnos: now takes "flex" as argument, indicating path status
   6.446 +
   6.447 +14 April
   6.448 +
   6.449 +MAKE-ALL (Poly/ML) failed in HOL (ASM_SIMP_TAC redefined!) and LK
   6.450 +
   6.451 +LK/ex/hard-quant/37: added "by flexflex_tac" to compensate for flexflex
   6.452 +changes
   6.453 +
   6.454 +Pure/goals/gethyps: now calls METAHYPS directly
   6.455 +
   6.456 +rm-logfiles: no longer mentions directories.  WAS
   6.457 +    rm log {Pure,FOL,ZF,LCF,CTT,LK,Modal,HOL,Cube}/make*.log
   6.458 +    rm {FOL,ZF,LCF,CTT,LK,Modal,HOL,Cube}/test
   6.459 +    rm {FOL,ZF,LCF,CTT,LK,Modal,HOL,Cube}/.*.thy.ML
   6.460 +    rm {FOL,ZF,HOL}/ex/.*.thy.ML
   6.461 +
   6.462 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:39 hours! (albatross)
   6.463 +
   6.464 +New version of simp on Isabelle/new -- instantiates unknowns provided only
   6.465 +one rule may do so [SINCE REJECTED DUE TO UNPREDICTABLE BEHAVIOR]
   6.466 +
   6.467 +works with FOLP/ex/nat, but in general could fail in the event of
   6.468 +overlapping rewrite rules, since FOLP always instantiates unknowns during
   6.469 +rewriting.
   6.470 +
   6.471 +ZF: tested with new version
   6.472 +
   6.473 +HOL: tested with new version, appeared to loop in llist/Lmap_ident
   6.474 +
   6.475 +**** NEW VERSION OF ASM_SIMP_TAC, WITH METAHYPS ****
   6.476 +
   6.477 +ZF: failed in perm/comp_mem_injD1: the rule anti_refl_rew is too ambiguous!
   6.478 +ZF/wfrec: all uses of wf_ss' require
   6.479 +by (METAHYPS (fn hyps => cut_facts_tac hyps 1 THEN
   6.480 +                         SIMP_TAC (wf_ss' addrews (hyps)) 1) 1);
   6.481 +
   6.482 +ZF/epsilon/eclose_least: changed ASM_SIMP_TAC to SIMP_TAC; this makes
   6.483 +METAHYPS version work
   6.484 +
   6.485 +ZF/arith/add_not_less_self: adds anti_refl_rew
   6.486 +
   6.487 +ZF/ex/prop-log/hyps_finite: the use of UN_I is very bad -- too undirected.
   6.488 +Swapping the premises of UN_I would probably allow instantiation.
   6.489 +
   6.490 +ZF otherwise seems to work!
   6.491 +
   6.492 +HOL/llist/llistE: loops! due to rewriting by Rep_LList_LCons of Vars
   6.493 +
   6.494 +HOL/ex/prop-log/comp_lemma: failed due to uninstantiated Var in 
   6.495 +(CCONTR_rule RS allI)
   6.496 +
   6.497 +*** REJECTED
   6.498 +
   6.499 +15 April
   6.500 +
   6.501 +These overnight runs involve Provers/simp.ML with old treatment of rules
   6.502 +(match_tac) and no METAHYPS; they test the new flexflex pairs and
   6.503 +discrimination nets, to see whether it runs faster.
   6.504 +
   6.505 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:39 hours (4 mins faster)
   6.506 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:23 hours (5 mins faster)
   6.507 +
   6.508 +ZF/simpdata/ZF_ss: deleted anti_refl_rew; non-linear patterns slow down
   6.509 +discrimination nets (and this rewrite used only ONCE)
   6.510 +
   6.511 +ZF/mem_not_refl: new; replaces obsolete anti_refl_rew
   6.512 +
   6.513 +**Timing experiments**
   6.514 +
   6.515 +fun HYP_SIMP_TAC ss = METAHYPS (fn hyps => HOL_SIMP_TAC (ss addrews hyps) 1);
   6.516 +
   6.517 +On large examples such as ...
   6.518 +HOL/arith/mod_quo_equality 
   6.519 +HOL/llist/LListD_implies_ntrunc_equality
   6.520 +ZF/ex/bin/integ_of_bin_succ
   6.521 +... it is 1.5 to 3 times faster than ASM_SIMP_TAC.  But cannot replace
   6.522 +ASM_SIMP_TAC since the auto_tac sometimes fails due to lack of assumptions.
   6.523 +If there are few assumptions then HYP_SIMP_TAC is no better.
   6.524 +
   6.525 +Pure/Makefile: now copies $(ML_DBASE) to $(BIN)/Pure instead of calling
   6.526 +make_database, so that users can call make_database for their object-logics.
   6.527 +
   6.528 +Pure/tctical/SELECT_GOAL: now does nothing if i=1 and there is
   6.529 +only one subgoal.
   6.530 +
   6.531 +19 April
   6.532 +
   6.533 +MAKE-ALL (NJ 0.93) failed in HOL due to lack of disc space.
   6.534 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:23 hours 
   6.535 +
   6.536 +**** Installation of new simplifier ****
   6.537 +
   6.538 +Provers/simp/EXEC: now calls METAHYPS and passes the hyps as an extra arg
   6.539 +to the auto_tac.
   6.540 +
   6.541 +FOL,HOL/simpdata: auto_tac now handles the hyps argument
   6.542 +
   6.543 +ZF/simpdata/standard_auto_tac: deleted
   6.544 +ZF/simpdata/auto_tac: added hyps argument
   6.545 +ZF/epsilon/eclose_least_lemma: no special auto_tac 
   6.546 +
   6.547 +*/ex/ROOT: no longer use 'cd' commands; instead pathnames contain "ex/..."
   6.548 +
   6.549 +20 April
   6.550 +
   6.551 +MAKE-ALL failed in HOL/Subst
   6.552 +
   6.553 +HOL/Subst/setplus/cla_case: renamed imp_excluded_middle and simplified.
   6.554 +Old version caused ambiguity in rewriting:
   6.555 +     "[| P ==> P-->Q;  ~P ==> ~P-->Q |] ==> Q";
   6.556 +
   6.557 +**** New tar file placed on /homes/lcp (????) **** 
   6.558 +
   6.559 +Pure/Syntax: improvements to the printing of syntaxes
   6.560 +Pure/Syntax/lexicon.ML: added name_of_token
   6.561 +Pure/Syntax/earley0A.ML: updated print_gram
   6.562 +
   6.563 +21 April
   6.564 +
   6.565 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:44 hours
   6.566 +MAKE-ALL (Poly/ML) failed in HOL due to lack of disc space
   6.567 +
   6.568 +HOL/list,llist: now share NIL, CONS, List_Fun and List_case
   6.569 +
   6.570 +make-all: now compresses the log files, which were taking up 4M; this
   6.571 +reduces their space by more than 1/3
   6.572 +
   6.573 +rm-logfiles: now deletes compressed log files.
   6.574 +
   6.575 +** Patrick Meche has noted that if the goal is stated with a leading !!
   6.576 +quantifier, then the list of premises is always empty -- this gives the
   6.577 +effect of an initial (cut_facts_tac prems 1).  The final theorem is the
   6.578 +same as it would be without the quantifier.
   6.579 +
   6.580 +ZF: used the point above to simplify many proofs
   6.581 +ZF/domrange/cfast_tac: deleted, it simply called cut_facts_tac
   6.582 +
   6.583 +22 April
   6.584 +
   6.585 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:52 hours??
   6.586 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:16 hours
   6.587 +
   6.588 +30 April
   6.589 +
   6.590 +HOL: installation of finite set notation: {x1,...,xn} (by Tobias Nipkow)
   6.591 +
   6.592 +HOL/set.thy,set.ML,fun.ML,equalities.ML: addition of rules for "insert",
   6.593 +new derivations for "singleton"
   6.594 +
   6.595 +HOL/llist.thy,llist.ML: changed {x.False} to {}
   6.596 +
   6.597 +**** New tar file placed on /homes/lcp (584K) **** 
   6.598 +
   6.599 +4 May
   6.600 +
   6.601 +MAKE-ALL (NJ 0.93) ran out of space in LK.
   6.602 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:14 hours
   6.603 +
   6.604 +Pure/Makefile: inserted "chmod u+w $(BIN)/Pure;" in case $(ML_DBASE) is
   6.605 +write-protected
   6.606 +
   6.607 +5 May
   6.608 +
   6.609 +HOL/list/not_Cons_self: renamed from l_not_Cons_l
   6.610 +HOL/list/not_CONS_self: new
   6.611 +
   6.612 +HOL/llist.thy/Lconst: changed type and def to remove Leaf
   6.613 +HOL/llist.ML: changed Lconst theorems
   6.614 +
   6.615 +6 May
   6.616 +
   6.617 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:18 hours
   6.618 +
   6.619 +** Installation of new HOL from Tobias **
   6.620 +
   6.621 +HOL/ex/{finite,prop-log} made like the ZF versions
   6.622 +HOL/hol.thy: type classes plus, minus, times; overloaded operators + - *
   6.623 +HOL/set: set enumeration via "insert"
   6.624 +         additions to set_cs and set_ss
   6.625 +HOL/set,subset,equalities: various lemmas to do with {}, insert and -
   6.626 +HOL/llist: One of the proofs needs one fewer commands
   6.627 +HOL/arith: many proofs require type constraints due to overloading
   6.628 +
   6.629 +** end Installation **
   6.630 +
   6.631 +ZF/ex/misc: added new lemmas from Abrial's paper
   6.632 +
   6.633 +7 May 
   6.634 +
   6.635 +HOL/llist.ML/LList_corec_subset1: deleted a fast_tac call; the previous
   6.636 +simplification now proves the subgoal.
   6.637 +
   6.638 +**** New tar file placed on /homes/lcp (584K) **** 
   6.639 +
   6.640 +** Installation of new simplifier from Tobias **
   6.641 +
   6.642 +The "case_splits" parameter of SimpFun is moved from the signature to the
   6.643 +simpset.  SIMP_CASE_TAC and ASM_SIMP_CASE_TAC are removed.  The ordinary
   6.644 +simplification tactics perform case splits if present in the simpset.
   6.645 +
   6.646 +The simplifier finds out for itself what constant is affected.  Instead of
   6.647 +supplying the pair (expand_if,"if"), supply just the rule expand_if.
   6.648 +
   6.649 +This change affects all calls to SIMP_CASE_TAC and all applications of SimpFun.
   6.650 +
   6.651 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:18 hours
   6.652 +
   6.653 +Cube/ex: UNTIL1, UNTIL_THM: replaced by standard tactics DEPTH_SOLVE_1 and
   6.654 +DEPTH_SOLVE
   6.655 +
   6.656 +HOL: installation of NORM tag for simplication.  How was it forgotten??
   6.657 +
   6.658 +HOL/hol.thy: declaration of NORM
   6.659 +HOL/simpdata: NORM_def supplied to SimpFun
   6.660 +
   6.661 +10 May
   6.662 +
   6.663 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:33 hours??
   6.664 +
   6.665 +11 May
   6.666 +
   6.667 +HOL/prod/Prod_eq: renamed Pair_eq
   6.668 +HOL/ex/lex-prod: wf_lex_prod: simplified proof
   6.669 +
   6.670 +HOL/fun/inj_eq: new
   6.671 +
   6.672 +HOL/llist/sumPairE: deleted, thanks to new simplifier's case splits!
   6.673 +
   6.674 +12 May
   6.675 +
   6.676 +MAKE-ALL (NJ 0.93) ran out of space in HOL.
   6.677 +MAKE-ALL (Poly/ML) failed in HOL.
   6.678 +HOL/Subst/utermlemmas/utlemmas_ss: deleted Prod_eq from the congruence rules
   6.679 +
   6.680 +13 May
   6.681 +
   6.682 +Pure/logic/flexpair: moved to term, with "equals" etc.  Now pervasive
   6.683 +Pure/logic/mk_flexpair: now exported
   6.684 +Pure/logic/dest_flexpair: new
   6.685 +Pure/goals/print_exn: now prints the error message for TERM and TYPE
   6.686 +
   6.687 +Pure/Syntax/sextension: now =?= has type ['a::{}, 'a] => prop because
   6.688 +flexflex pairs can have any type at all.  Thus == must have the same type.
   6.689 +
   6.690 +Pure/thm/flexpair_def: now =?= and == are equated for all 'a::{}.
   6.691 +
   6.692 +Pure/tctical/equal_abs_elim,equal_abs_elim_list: new (for METAHYPS fix)
   6.693 +Pure/tctical/METAHYPS: now works if new proof state has flexflex pairs
   6.694 +
   6.695 +Pure/Syntax/earley0A,syntax,lexicon: Tokens are represented by strings now,
   6.696 +not by integers.  (Changed by Tobias)
   6.697 +
   6.698 +*** Installation of more printing functions ***
   6.699 +
   6.700 +Pure/sign/sg: changed from a type abbrev to a datatype
   6.701 +Pure/type/type_sig: changed from a type abbrev to a datatype
   6.702 +These changes needed for abstract type printing in NJ
   6.703 +
   6.704 +Pure/tctical/print_sg,print_theory: new
   6.705 +
   6.706 +Pure/drule: new file containing derived rules and printing functions.
   6.707 +Mostly from tctical.ML, but includes rewriting rules from tactic.ML.
   6.708 +
   6.709 +Pure/ROOT: loads drule before tctical; TacticalFun,TacticFun,GoalsFun now
   6.710 +depend on Drule and have sharing constraints.
   6.711 +
   6.712 +14 May
   6.713 +
   6.714 +Installing new print functions for New Jersey: incompatible with Poly/ML!
   6.715 +
   6.716 +Pure/NJ/install_pp_nj: new (requires datatypes as above)
   6.717 +Pure/POLY/install_pp_nj: a dummy version
   6.718 +
   6.719 +Pure/ROOT: calls install_pp_nj to install printing for NJ
   6.720 +
   6.721 +*/ROOT: added extra install_pp calls (sg, theory, cterm, typ, ctyp) for
   6.722 +Poly/ML [ZF,LCF,Modal do not need them since they inherit them from another
   6.723 +logic -- make_database is not used]
   6.724 +
   6.725 +17 May
   6.726 +
   6.727 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 3:57 hours??
   6.728 +
   6.729 +Pure/Syntax/lexicon: Yet another leaner and faster version ... (from Tobias)
   6.730 +
   6.731 +18 May
   6.732 +
   6.733 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:36 hours
   6.734 +
   6.735 +19 May
   6.736 +
   6.737 +ZF/equalities/Union_singleton,Inter_singleton: now refer to {b} instead of
   6.738 +complex assumptions
   6.739 +
   6.740 +20 May
   6.741 +
   6.742 +HOL/list: Tobias added the [x1,...,xn] notation and the functions hd, tl,
   6.743 +null and list_case.
   6.744 +
   6.745 +1 June
   6.746 +
   6.747 +MAKE-ALL (Poly/ML) ran perfectly.  It took 3:39 hours
   6.748 +
   6.749 +**** New tar file 92.tar.z placed on /homes/lcp (376K) **** 
   6.750 +
   6.751 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 1:49 hours on albatross.
   6.752 +
   6.753 +Pure/tactic/dres_inst_tac,forw_inst_tac: now call the new
   6.754 +make_elim_preserve to preserve Var indexes when creating the elimination
   6.755 +rule.
   6.756 +
   6.757 +ZF/ex/ramsey: modified calls to dres_inst_tac
   6.758 +
   6.759 +2 June
   6.760 +
   6.761 +Pure/Thy/read/read_thy,use_thy: the .thy.ML file is now written to the
   6.762 +current directory, since the pathname may lead to a non-writeable area.
   6.763 +
   6.764 +HOL/arith: renamed / and // to div and mod
   6.765 +ZF/arith: renamed #/ and #// to div and mod
   6.766 +
   6.767 +MAKE-ALL (Poly/ML) ran perfectly.  It took 1:48 hours on albatross.
   6.768 +
   6.769 +**** New tar file 92.tar.z placed on /homes/lcp (376K) **** 
   6.770 +
   6.771 +Pure/NJ/commit: new dummy function
   6.772 +FOLP/ex/ROOT: inserted commit call to avoid Poly/ML problems
   6.773 +
   6.774 +make-all: now builds FOLP also!
   6.775 +
   6.776 +3 June
   6.777 +
   6.778 +ZF/zf.thy,HOL/list.thy,HOL/set.thy: now constructions involving {_}, [_],
   6.779 +<_,_> are formatted as {(_)}, [(_)], 
   6.780 +
   6.781 +MAKE-ALL (Poly/ML) ran perfectly.  It took 4:37 hours on muscovy (with FOLP).
   6.782 +
   6.783 +ZF/Makefile: removed obsolete target for .rules.ML
   6.784 +
   6.785 +All object-logic Makefiles: EXAMPLES ARE NO LONGER SAVED.  This saves disc
   6.786 +and avoids problems (in New Jersey ML) of writing to the currently
   6.787 +executing image.
   6.788 +
   6.789 +4 June
   6.790 +
   6.791 +Pure/logic/rewritec: now uses nets for greater speed.  Functor LogicFun now
   6.792 +takes Net as argument.
   6.793 +
   6.794 +Pure/ROOT: now loads net before logic.
   6.795 +
   6.796 +MAKE-ALL (Poly/ML) failed in ZF and HOL.
   6.797 +
   6.798 +LK/lk.thy: changed constant "not" to "Not" (for consistency with FOL)
   6.799 +
   6.800 +7 June
   6.801 +
   6.802 +Pure/tactic/is_letdig: moved to library
   6.803 +Pure/Syntax/lexicon/is_qld: deleted, was same as is_letdig
   6.804 +
   6.805 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:07 hours on albatross.
   6.806 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:41 hours on dunlin.
   6.807 +
   6.808 +HOL/set/UN1,INT1: new union/intersection operators.  Binders UN x.B(x),
   6.809 +INT x.B(x).
   6.810 +
   6.811 +HOL/univ,llist: now use UN x.B(x) instead of Union(range(B))
   6.812 +
   6.813 +HOL/subset: added lattice properties for INT, UN (both forms)
   6.814 +
   6.815 +8 June
   6.816 +
   6.817 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 4:45 hours on dunlin.
   6.818 +
   6.819 +**** New tar file 92.tar.z placed on /homes/lcp (384K) **** 
   6.820 +
   6.821 +14 June
   6.822 +
   6.823 +HOL/list.thy/List_rec_def: changed pred_sexp (a variable!) to pred_Sexp.
   6.824 +Using def_wfrec hides such errors!!
   6.825 +
   6.826 +**** New tar file 92.tar.gz placed on /homes/lcp (384K) **** 
   6.827 +
   6.828 +** NEW VERSION FROM MUNICH WITH ==-REWRITING **
   6.829 +
   6.830 +** The following changes are Toby's **
   6.831 +
   6.832 +type.ML:
   6.833 +
   6.834 +Renamed mark_free to freeze_vars and thaw_tvars to thaw_vars.
   6.835 +Added both functions to the signature.
   6.836 +
   6.837 +sign.ML:
   6.838 +
   6.839 +Added val subsig: sg * sg -> bool to signature.
   6.840 +Added trueprop :: prop and mark_prop : prop => prop to pure_sg.
   6.841 +
   6.842 +Added
   6.843 +
   6.844 +val freeze_vars: term -> term
   6.845 +val thaw_vars: term -> term
   6.846 +val strip_all_imp: term * int -> term list * term * int
   6.847 +
   6.848 +Moved rewritec_bottom and rewritec_top to thm.ML.
   6.849 +Only bottom-up rewriting supported any longer.
   6.850 +
   6.851 +thm.ML:
   6.852 +
   6.853 +Added
   6.854 +
   6.855 +(* internal form of conditional ==-rewrite rules *)
   6.856 +type meta_simpset
   6.857 +val add_mss: meta_simpset * thm list -> meta_simpset
   6.858 +val empty_mss: meta_simpset
   6.859 +val mk_mss: thm list -> meta_simpset
   6.860 +
   6.861 +val mark_prop_def: thm
   6.862 +val truepropI: thm
   6.863 +val trueprop_def: thm
   6.864 +
   6.865 +(* bottom-up conditional ==-rewriting with local ==>-assumptions *)
   6.866 +val rewrite_cterm: meta_simpset -> (thm -> thm list)
   6.867 +                   -> (meta_simpset -> thm list -> Sign.cterm -> thm)
   6.868 +                   -> Sign.cterm -> thm
   6.869 +val trace_simp: bool ref
   6.870 +
   6.871 +Simplified concl_of: call to Logic.skip_flexpairs redundant.
   6.872 +
   6.873 +drule.ML:
   6.874 +
   6.875 +Added
   6.876 +
   6.877 +(* rewriting *)
   6.878 +val asm_rewrite_rule: (thm -> thm list) -> thm list -> thm -> thm
   6.879 +val rewrite_goal_rule: (thm -> thm list) -> thm list -> int -> thm -> thm
   6.880 +val rewrite_goals_rule: (thm -> thm list) -> thm list -> thm -> thm
   6.881 +
   6.882 +(* derived concepts *)
   6.883 +val forall_trueprop_eq: thm
   6.884 +val implies_trueprop_eq: thm
   6.885 +val mk_trueprop_eq: thm -> thm
   6.886 +val reflexive_eq: thm
   6.887 +val reflexive_thm: thm
   6.888 +val trueprop_implies_eq: thm
   6.889 +val thm_implies: thm -> thm -> thm
   6.890 +val thm_equals: thm -> thm -> thm
   6.891 +
   6.892 +(*Moved here from tactic.ML:*)
   6.893 +val asm_rl: thm
   6.894 +val cut_rl: thm
   6.895 +val revcut_rl: thm
   6.896 +
   6.897 +tactic.ML:
   6.898 +
   6.899 +Added
   6.900 +
   6.901 +val asm_rewrite_goal_tac: (thm -> thm list) -> thm list -> int -> tactic
   6.902 +val asm_rewrite_goals_tac: (thm -> thm list) -> thm list -> tactic
   6.903 +val asm_rewrite_tac: (thm -> thm list) -> thm list -> tactic
   6.904 +val fold_goal_tac: thm list -> int -> tactic
   6.905 +val rewrite_goal_tac: thm list -> int -> tactic
   6.906 +
   6.907 +Moved to drule.ML:
   6.908 +val asm_rl: thm
   6.909 +val cut_rl: thm
   6.910 +val revcut_rl: thm
   6.911 +
   6.912 +goals.ML:
   6.913 +
   6.914 +Changed prepare_proof to make sure that rewriting with empty list of
   6.915 +meta-thms is identity.
   6.916 +
   6.917 +** End of Toby's changes **
   6.918 +
   6.919 +16 June
   6.920 +
   6.921 +Pure/sign/typ_of,read_ctyp: new
   6.922 +Pure/logic/dest_flexpair: now exported
   6.923 +
   6.924 +Pure/drule/flexpair_intr,flexpair_elim: new; fixes a bug in
   6.925 +flexpair_abs_elim_list
   6.926 +
   6.927 +HOL/equalities/image_empty,image_insert: new
   6.928 +HOL/ex/finite/Fin_imageI: new
   6.929 +
   6.930 +Installed Martin Coen's CCL as new object-logic
   6.931 +
   6.932 +17 June
   6.933 +
   6.934 +** More changes from Munich (Markus Wenzel) **
   6.935 +
   6.936 +Pure/library: added the, is_some, is_none, separate and improved space_implode
   6.937 +Pure/sign: Sign.extend now calls Syntax.extend with list of constants
   6.938 +Pure/symtab: added is_null
   6.939 +Pure/Syntax/sextension: added empty_sext
   6.940 +Pure/Syntax/syntax: changed Syntax.extend for compatibility with future version
   6.941 +
   6.942 +HOL now exceeds poly's default heap size. Hence HOL/Makefile needs to
   6.943 +specify -h 8000.
   6.944 +
   6.945 +HOL/univ/ntrunc_subsetD, etc: deleted the useless j<k assumption
   6.946 +
   6.947 +18 June
   6.948 +
   6.949 +MAKE-ALL (Poly/ML) ran perfectly.  It took 4:59 hours on dunlin (with CCL).
   6.950 +
   6.951 +Pure/sign/read_def_cterm: now prints the offending terms, as well as the
   6.952 +types, when exception TYPE is raised.
   6.953 +
   6.954 +HOL/llist: some tidying
   6.955 +
   6.956 +23 June
   6.957 +
   6.958 +HOL/llist/Lconst_type: generalized from Lconst(M): LList({M})
   6.959 +
   6.960 +24 June
   6.961 +
   6.962 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:23 hours on albatross (with CCL)
   6.963 +
   6.964 +MAKE-ALL (NJ 0.93) failed in CCL due to use of "abstraction" as an
   6.965 +identifier in CCL.ML
   6.966 +
   6.967 +**** New tar file 92.tar.gz placed on /homes/lcp (384K) **** (with CCL)
   6.968 +
   6.969 +CCL/ROOT: added ".ML" extension to use commands for NJ compatibility
   6.970 +
   6.971 +25 June
   6.972 +
   6.973 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:23 hours on albatross.
   6.974 +MAKE-ALL (NJ 0.93) failed in HOL due to lack of ".ML" extension
   6.975 +
   6.976 +HOL/fun/rangeE,imageE: eta-expanded f to get variable name preservation
   6.977 +
   6.978 +HOL/llist/iterates_equality,lmap_lappend_distrib: tidied
   6.979 +
   6.980 +28 June
   6.981 +
   6.982 +HOL/set/UN1_I: made the Var and Bound variables agree ("x") to get variable
   6.983 +name preservation 
   6.984 +
   6.985 +HOL/llist: co-induction rules applied with res_inst_tac to state the
   6.986 +bisimulation directly
   6.987 +
   6.988 +2 July
   6.989 +
   6.990 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 2:10 hours on albatross.
   6.991 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:23 hours on albatross.
   6.992 +
   6.993 +92/Makefile/$(BIN)/Pure: changed echo makefile= to echo database=
   6.994 +
   6.995 +**** New tar file 92.tar.gz placed on /homes/lcp (424K) **** (with CCL)
   6.996 +
   6.997 +
   6.998 +** NEW VERSION FROM MUNICH WITH ABSTRACT SYNTAX TREES & NEW PARSER **
   6.999 +
  6.1000 +I have merged in the changes shown above since 24 June
  6.1001 +
  6.1002 +CHANGES LOG OF Markus Wenzel (MMW)
  6.1003 +=======
  6.1004 +
  6.1005 +29-Jun-1993 MMW
  6.1006 +  *** Beta release of new syntax module ***
  6.1007 +  (should be 99% backwards compatible)
  6.1008 +
  6.1009 +  Pure/Thy/ROOT.ML
  6.1010 +    added keywords for "translations" section
  6.1011 +
  6.1012 +  Pure/Thy/syntax.ML
  6.1013 +    minor cleanup
  6.1014 +    added syntax for "translations" section
  6.1015 +    .*.thy.ML files now human readable
  6.1016 +    .*.thy.ML used to be generated incorrectly if no mixfix but "ML" section
  6.1017 +    "ML" section no longer demands any definitions (parse_translation, ...)
  6.1018 +
  6.1019 +  Pure/Thy/read.ML
  6.1020 +    read_thy: added close_in
  6.1021 +    added file_exists (not perfect)
  6.1022 +    use_thy: now uses file_exists
  6.1023 +
  6.1024 +  Pure/thm.ML
  6.1025 +    added syn_of: theory -> syntax
  6.1026 +
  6.1027 +  Pure/Makefile
  6.1028 +    SYNTAX_FILES: added Syntax/ast.ML
  6.1029 +
  6.1030 +  Pure/Syntax/pretty.ML
  6.1031 +    added str_of: T -> string
  6.1032 +
  6.1033 +  Pure/Syntax/ast.ML
  6.1034 +    added this file
  6.1035 +
  6.1036 +  Pure/Syntax/extension.ML
  6.1037 +  Pure/Syntax/parse_tree.ML
  6.1038 +  Pure/Syntax/printer.ML
  6.1039 +  Pure/Syntax/ROOT.ML
  6.1040 +  Pure/Syntax/sextension.ML
  6.1041 +  Pure/Syntax/syntax.ML
  6.1042 +  Pure/Syntax/type_ext.ML
  6.1043 +  Pure/Syntax/xgram.ML
  6.1044 +    These files have been completely rewritten, though the global structure
  6.1045 +    is similar to the old one.
  6.1046 +
  6.1047 +
  6.1048 +30-Jun-1993 MMW
  6.1049 +  New versions of HOL and Cube: use translation rules wherever possible;
  6.1050 +
  6.1051 +  HOL/hol.thy
  6.1052 +    cleaned up
  6.1053 +    removed alt_tr', mk_bindopt_tr'
  6.1054 +    alternative binders now implemented via translation rules and mk_alt_ast_tr'
  6.1055 +
  6.1056 +  HOL/set.thy
  6.1057 +    cleaned up
  6.1058 +    removed type "finset"
  6.1059 +    now uses category "args" for finite sets
  6.1060 +    junked "ML" section
  6.1061 +    added "translations" section
  6.1062 +
  6.1063 +  HOL/list.thy
  6.1064 +    cleaned up
  6.1065 +    removed type "listenum"
  6.1066 +    now uses category "args" for lists
  6.1067 +    junked "ML" section
  6.1068 +    added "translations" section
  6.1069 +
  6.1070 +  Cube/cube.thy
  6.1071 +    cleaned up
  6.1072 +    changed indentation of Lam and Pi from 2 to 3
  6.1073 +    removed qnt_tr, qnt_tr', no_asms_tr, no_asms_tr'
  6.1074 +    fixed fun_tr': all but one newly introduced frees will have type dummyT
  6.1075 +    added "translations" section
  6.1076 +
  6.1077 +
  6.1078 +30-Jun-1993, 05-Jul-1993 MMW
  6.1079 +  Improved toplevel pretty printers:
  6.1080 +    - unified interface for POLY and NJ;
  6.1081 +    - print functions now insert atomic string into the toplevel's pp stream,
  6.1082 +      rather than writing it to std_out (advantage: output appears at the
  6.1083 +      correct position, disadvantage: output cannot be broken);
  6.1084 +  (Is there anybody in this universe who exactly knows how Poly's install_pp
  6.1085 +  is supposed to work?);
  6.1086 +
  6.1087 +  Pure/NJ.ML
  6.1088 +    removed dummy install_pp
  6.1089 +    added make_pp, install_pp
  6.1090 +
  6.1091 +  Pure/POLY.ML
  6.1092 +    removed dummy install_pp_nj
  6.1093 +    added make_pp
  6.1094 +
  6.1095 +  Pure/ROOT.ML
  6.1096 +    removed install_pp_nj stuff
  6.1097 +
  6.1098 +  Pure/drule.ML
  6.1099 +    added str_of_sg, str_of_theory, str_of_thm
  6.1100 +
  6.1101 +  Pure/install_pp.ML
  6.1102 +    added this file
  6.1103 +
  6.1104 +  Pure/sign.ML
  6.1105 +    added str_of_term, str_of_typ, str_of_cterm, str_of_ctyp
  6.1106 +
  6.1107 +  Pure/goals.ML
  6.1108 +    added str_of_term, str_of_typ
  6.1109 +
  6.1110 +  CTT/ROOT.ML
  6.1111 +  Cube/ROOT.ML
  6.1112 +  FOL/ROOT.ML
  6.1113 +  FOLP/ROOT.ML
  6.1114 +  HOL/ROOT.ML
  6.1115 +  LK/ROOT.ML
  6.1116 +    replaced install_pp stuff by 'use "../Pure/install_pp.ML"'
  6.1117 +
  6.1118 +
  6.1119 +01-Jul-1993 MMW
  6.1120 +  Misc small fixes
  6.1121 +
  6.1122 +  CCL/ROOT.ML
  6.1123 +  HOL/ROOT.ML
  6.1124 +    added ".ML" suffix to some filenames
  6.1125 +
  6.1126 +  HOL/ex/unsolved.ML
  6.1127 +    replaced HOL_Rule.thy by HOL.thy
  6.1128 +
  6.1129 +  Pure/NJ.ML
  6.1130 +    quit was incorrectly int -> unit
  6.1131 +
  6.1132 +END MMW CHANGES
  6.1133 +
  6.1134 +Pure/Syntax/sextension/eta_contract: now initially false 
  6.1135 +
  6.1136 +Pure/library/cat_lines: no longer calls "distinct"
  6.1137 +Pure/sign: replaced to calls of implode (map (apr(op^,"\n") o ... by cat_lines
  6.1138 +NB This could cause duplicate error messages from Pure/sign and Pure/type
  6.1139 +
  6.1140 +Pure/goals/prove_goalw: now prints some of the information from print_exn
  6.1141 +
  6.1142 +9 July
  6.1143 +
  6.1144 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:26 hours on albatross.
  6.1145 +
  6.1146 +**** New tar file 93.tar.gz placed on /homes/lcp (480K) **** 
  6.1147 +
  6.1148 +12 July
  6.1149 +
  6.1150 +MAKE-ALL (NJ 0.93) ran perfectly.  It took 2:13 hours on albatross.
  6.1151 +MAKE-ALL (Poly/ML) ran perfectly.  It took 2:25 hours on albatross.
  6.1152 +
  6.1153 +22 July
  6.1154 +
  6.1155 +ZF/zf.thy: new version from Marcus Wenzel
  6.1156 +
  6.1157 +ZF: ** installation of inductive definitions **
  6.1158 +
  6.1159 +changing the argument order of "split"; affects fst/snd too
  6.1160 +sum.thy zf.thy ex/bin.thy ex/integ.thy ex/simult.thy ex/term.thy
  6.1161 +pair.ML  ex/integ.ML
  6.1162 +
  6.1163 +changing the argument order of "case" and adding "Part": sum.thy sum.ML
  6.1164 +
  6.1165 +ZF/zf.ML/rev_subsetD,rev_bspec: new
  6.1166 +
  6.1167 +ZF/mono: new rules for implication
  6.1168 +ZF/mono/Collect_mono: now for use with implication rules
  6.1169 +
  6.1170 +ZF/zf.ML/ballE': renamed rev_ballE
  6.1171 +
  6.1172 +ZF/list.thy,list.ML: files renamed list-fn.thy, list-fn.ML
  6.1173 +ZF/list.ML: new version simply holds the datatype definition
  6.1174 +NB THE LIST CONSTRUCTORS ARE NOW Nil/Cons, not 0/Pair.
  6.1175 +
  6.1176 +ZF/extend_ind.ML, datatype.ML: new files
  6.1177 +ZF/fin.ML: moved from ex/finite.ML
  6.1178 +
  6.1179 +23 July
  6.1180 +
  6.1181 +ZF/ex/sexp: deleted this example -- it seems hardly worth the trouble of
  6.1182 +porting.
  6.1183 +
  6.1184 +ZF/ex/bt.thy,bt.ML: files renamed bt-fn.thy, bt-fn.ML
  6.1185 +ZF/ex/bt.ML: new version simply holds the datatype definition
  6.1186 +
  6.1187 +ZF/ex/term.thy,term.ML: files renamed term-fn.thy, term-fn.ML
  6.1188 +ZF/ex/term.ML: new version simply holds the datatype definition
  6.1189 +
  6.1190 +ZF/sum/InlI,InrI: renamed from sum_InlI, sum_InlI
  6.1191 +
  6.1192 +26 July
  6.1193 +
  6.1194 +ZF/univ/rank_ss: new, for proving recursion equations
  6.1195 +
  6.1196 +ZF/domrange/image_iff,image_singleton_iff,vimage_iff,vimage_singleton_iff,
  6.1197 +field_of_prod:new
  6.1198 +
  6.1199 +ZF/domrange/field_subset: modified
  6.1200 +
  6.1201 +ZF/list/list_cases: no longer proved by induction!
  6.1202 +ZF/wf/wf_trancl: simplified proof
  6.1203 +
  6.1204 +ZF/equalities: new laws for field
  6.1205 +
  6.1206 +29 July
  6.1207 +
  6.1208 +ZF/trancl/trancl_induct: new
  6.1209 +ZF/trancl/rtrancl_induct,trancl_induct: now with more type information
  6.1210 +
  6.1211 +** More changes from Munich (Markus Wenzel) **
  6.1212 +
  6.1213 +Update of new syntax module (aka macro system): mostly internal cleanup and
  6.1214 +polishing;
  6.1215 +
  6.1216 +  Pure/Syntax/*
  6.1217 +    added Ast.stat_norm
  6.1218 +    added Syntax.print_gram, Syntax.print_trans, Syntax.print_syntax
  6.1219 +    cleaned type and Pure syntax: "_CLASSES" -> "classes", "_SORTS" -> "sorts",
  6.1220 +     "_==>" -> "==>", "_fun" -> "fun", added some space for printing
  6.1221 +    Printer: partial fix of the "PROP <aprop>" problem: print "PROP " before
  6.1222 +      any Var or Free of type propT
  6.1223 +    Syntax: added ndependent_tr, dependent_tr'
  6.1224 +
  6.1225 +  Pure/sign.ML: removed declaration of "==>" (now in Syntax.pure_sext)
  6.1226 +
  6.1227 +Changes to object logics: minor cleanups and replacement of most remaining ML
  6.1228 +translations by rewrite rules (see also file "Translations");
  6.1229 +
  6.1230 +  ZF/zf.thy
  6.1231 +    added "translations" section
  6.1232 +    removed all parse/print translations except ndependent_tr, dependent_tr'
  6.1233 +    fixed dependent_tr': all but one newly introduced frees have type dummyT
  6.1234 +    replaced id by idt in order to make terms rereadable if !show_types
  6.1235 +
  6.1236 +  Cube/cube.thy
  6.1237 +    removed necontext
  6.1238 +    replaced fun_tr/tr' by ndependent_tr/dependent_tr'
  6.1239 +
  6.1240 +  CTT/ctt.thy
  6.1241 +    added translations rules for PROD and SUM
  6.1242 +    removed dependent_tr
  6.1243 +    removed definitions of ndependent_tr, dependent_tr'
  6.1244 +
  6.1245 +  HOL/set.thy: replaced id by idt
  6.1246 +
  6.1247 +  CCL/ROOT.ML: Logtic -> Logic
  6.1248 +
  6.1249 +  CCL/set.thy
  6.1250 +    added "translations" section
  6.1251 +    removed "ML" section
  6.1252 +    replaced id by idt
  6.1253 +
  6.1254 +  CCL/types.thy
  6.1255 +    added "translations" section
  6.1256 +    removed definitions of ndependent_tr, dependent_tr'
  6.1257 +    replaced id by idt
  6.1258 +
  6.1259 +Yet another improvement of toplevel pretty printers: output now breakable;
  6.1260 +
  6.1261 +  Pure/NJ.ML Pure/POLY.ML improved make_pp
  6.1262 +
  6.1263 +  Pure/install_pp.ML: replaced str_of_* by pprint_*
  6.1264 +
  6.1265 +  Pure/drule.ML: replaced str_of_{sg,theory,thm} by pprint_*
  6.1266 +
  6.1267 +  Pure/sign.ML: replaced str_of_{term,typ,cterm,ctyp} by pprint_*
  6.1268 +
  6.1269 +  Pure/goals.ML: fixed and replaced str_of_{term,typ} by pprint_*
  6.1270 +
  6.1271 +  Pure/Syntax/pretty.ML: added pprint, quote
  6.1272 +
  6.1273 +Minor changes and additions;
  6.1274 +
  6.1275 +  Pure/sign.ML: renamed stamp "PURE" to "Pure"
  6.1276 +
  6.1277 +  Pure/library.ML
  6.1278 +    added quote: string -> string
  6.1279 +    added to_lower: string -> bool
  6.1280 +
  6.1281 +  Pure/NJ.ML,POLY.ML: added file_info of Carsten Clasohm
  6.1282 +
  6.1283 +30 July
  6.1284 +
  6.1285 +MAKE-ALL (Poly/ML) ran perfectly.
  6.1286 +
  6.1287 +Pure/goals/print_sign_exn: new, takes most code from print_exn
  6.1288 +Pure/goals/prove_goalw: displays exceptions using print_sign_exn
  6.1289 +
  6.1290 +Pure/drule/print_sg: now calls pretty_sg to agree with pprint_sg
  6.1291 +
  6.1292 +Pure/library,...: replaced front/nth_tail by take/drop.
  6.1293 +
  6.1294 +Pure/term/typ_tfrees,typ_tvars,term_tfrees,term_tvars: new
  6.1295 +thm/mk_rew_triple, drule/types_sorts, sign/zero_tvar_indices: now use the above
  6.1296 +
  6.1297 +Pure/logic/add_term_vars,add_term_frees,insert_aterm,atless:
  6.1298 +moved to term, joining similar functions for type variables;
  6.1299 +Logic.vars and Logic.frees are now term_vars and term_frees
  6.1300 +
  6.1301 +Pure/term/subst_free: new
  6.1302 +
  6.1303 +Pure/tactic/is_fact: newly exported
  6.1304 +
  6.1305 +Provers/simp/mk_congs: uses filter_out is_fact to delete trivial cong rules
  6.1306 +
  6.1307 +Pure/tactic/rename_last_tac: now uses Syntax.is_identifier instead of
  6.1308 +forall is_letdig
  6.1309 +
  6.1310 +**** New tar file 93.tar.gz placed on /homes/lcp (448K) **** 
  6.1311 +
  6.1312 +2 August
  6.1313 +
  6.1314 +MAKE-ALL (NJ 0.93) failed in ZF due to Compiler bug: elabDecl:open:FctBodyStr
  6.1315 +MAKE-ALL (Poly/ML) failed in ZF/enum.  It took 2:33 hours on albatross.
  6.1316 +
  6.1317 +Pure/drule/triv_forall_equality: new
  6.1318 +Pure/tactic/prune_params_tac: new
  6.1319 +
  6.1320 +Provers/hypsubst/bound_hyp_subst_tac: new, safer than hyp_subst_tac
  6.1321 +
  6.1322 +3 August
  6.1323 +
  6.1324 +Pure/tactic/rule_by_tactic: new
  6.1325 +
  6.1326 +ZF/perm/compEpair: now proved via rule_by_tactic
  6.1327 +
  6.1328 +ZF/extend_ind/cases,mk_cases: new
  6.1329 +ZF/datatype/mk_free: new
  6.1330 +ZF/list: now calls List.mk_cases
  6.1331 +
  6.1332 +4 August
  6.1333 +
  6.1334 +Provers/slow_tac,slow_best_tac: new
  6.1335 +
  6.1336 +5 August
  6.1337 +
  6.1338 +MAKE-ALL (Poly/ML) failed in ZF
  6.1339 +
  6.1340 +ZF/sum/sumE2: deleted since unused
  6.1341 +ZF/sum/sum_iff,sum_subset_iff,sum_equal_iff: new
  6.1342 +ZF/univ/Transset_Vfrom: new; used in proof of Transset_Vset
  6.1343 +
  6.1344 +6 August
  6.1345 +
  6.1346 +Pure/goals/prepare_proof: after "Additional hypotheses", now actually
  6.1347 +prints them!
  6.1348 +
  6.1349 +ZF/ordinal/Transset_Union_family, Transset_Inter_family: renamed from
  6.1350 +Transset_Union, Transset_Inter
  6.1351 +
  6.1352 +ZF/ordinal/Transset_Union: new 
  6.1353 +ZF/univ/pair_in_univ: renamed Pair_in_univ
  6.1354 +
  6.1355 +ZF/mono/product_mono: generalized to Sigma_mono; changed uses in trancl, univ
  6.1356 +
  6.1357 +ZF/lfp/lfp_Tarski,def_lfp_Tarski: renamed from Tarski,def_Tarski; changed
  6.1358 +uses in extend_ind.ML, nat.ML, trancl.ML.
  6.1359 +
  6.1360 +ZF/ex/misc: Schroeder-Bernstein Theorem moved here from lfp.ML
  6.1361 +
  6.1362 +ZF/fixedpt.thy,.ML: renamed from lfp.thy,.ML, and gfp added
  6.1363 +
  6.1364 +9 August
  6.1365 +
  6.1366 +ZF/zf.thy/ndependent_tr,dependent_tr': deleted, since they are now on
  6.1367 +Syntax/sextension. 
  6.1368 +
  6.1369 +11 August
  6.1370 +
  6.1371 +Pure/library.ML: added functions
  6.1372 +assocs: (''a * 'b list) list -> ''a -> 'b list
  6.1373 +transitive_closure: (''a * ''a list) list -> (''a * ''a list) list
  6.1374 +
  6.1375 +Pure/type.ML: deleted (inefficient) transitive_closure
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/expandshort	Thu Sep 16 12:20:38 1993 +0200
     7.3 @@ -0,0 +1,31 @@
     7.4 +#! /bin/sh
     7.5 +#
     7.6 +#expandshort - shell script to expand shorthand goal commands
     7.7 +#  ALSO contracts uses of resolve_tac, dresolve_tac, eresolve_tac,
     7.8 +#     rewrite_goals_tac on 1-element lists
     7.9 +#
    7.10 +# Usage:
    7.11 +#    expandshort FILE1 ... FILEn
    7.12 +#
    7.13 +#  leaves previous versions as XXX~~
    7.14 +#
    7.15 +for f in $*
    7.16 +do
    7.17 +echo Expanding shorthands in $f. \ Backup file is $f~~
    7.18 +mv $f $f~~; sed -e '
    7.19 +s/^ba \([0-9]*\); *$/by (assume_tac \1);/
    7.20 +s/^br \(.*\) \([0-9]*\); *$/by (rtac \1 \2);/
    7.21 +s/^brs \(.*\) \([0-9]*\); *$/by (resolve_tac \1 \2);/
    7.22 +s/^bd \(.*\) \([0-9]*\); *$/by (dtac \1 \2);/
    7.23 +s/^bds \(.*\) \([0-9]*\); *$/by (dresolve_tac \1 \2);/
    7.24 +s/^be \(.*\) \([0-9]*\); *$/by (etac \1 \2);/
    7.25 +s/^bes \(.*\) \([0-9]*\); *$/by (eresolve_tac \1 \2);/
    7.26 +s/^bw \(.*\); *$/by (rewtac \1);/
    7.27 +s/^bws \(.*\); *$/by (rewrite_goals_tac \1);/
    7.28 +s/dresolve_tac *\[\([a-zA-Z0-9_]*\)\] */dtac \1 /g
    7.29 +s/eresolve_tac *\[\([a-zA-Z0-9_]*\)\] */etac \1 /g
    7.30 +s/resolve_tac *\[\([a-zA-Z0-9_]*\)\] */rtac \1 /g
    7.31 +s/rewrite_goals_tac *\[\([a-zA-Z0-9_]*\)\]\( *\)/rewtac \1\2/g
    7.32 +' $f~~ > $f
    7.33 +done
    7.34 +echo Finished.
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/get-rulenames	Thu Sep 16 12:20:38 1993 +0200
     8.3 @@ -0,0 +1,20 @@
     8.4 +#!/bin/sh
     8.5 +#   Title: 	get-rulenames  (see also make-rulenames)
     8.6 +#   Author: 	Larry Paulson, Cambridge University Computer Laboratory
     8.7 +#   Copyright   1990  University of Cambridge
     8.8 +#
     8.9 +#shell script to generate "val" declarations for a theory's axioms 
    8.10 +#  also generates a comma-separated list of axiom names
    8.11 +#
    8.12 +#  usage:  make-rulenames  <file>
    8.13 +#
    8.14 +#Rule lines begin with a line containing the word "extend_theory"
    8.15 +#       and end   with a line containing the word "get_axiom"
    8.16 +#Each rule name xyz must appear on a line that begins
    8.17 +#        <spaces> ("xyz"
    8.18 +#Output lines have the form
    8.19 +#        val Eq_comp = ax"Eq_comp";
    8.20 +#
    8.21 +sed -n -e '/ext[end]*_theory/,/get_axiom/ s/^[ []*("\([^"]*\)".*$/val \1	= ax"\1";/p' $1
    8.22 +echo
    8.23 +echo `sed -n -e '/ext[end]*_theory/,/get_axiom/ s/^[ []*("\([^"]*\)".*$/\1/p' $1 | tr '\012' ','`
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/make-all	Thu Sep 16 12:20:38 1993 +0200
     9.3 @@ -0,0 +1,169 @@
     9.4 +#! /bin/sh
     9.5 +#
     9.6 +#make-all: make all systems afresh
     9.7 +
     9.8 +# Creates gzipped log files called makeNNNN.log.gz on each subdirectory and
     9.9 +# displays the last few lines of these files -- this indicates whether
    9.10 +# the "make" failed (whether it terminated due to an error)
    9.11 +
    9.12 +# switches are
    9.13 +#     -noforce	don't delete old databases/images first
    9.14 +#     -clean	delete databases/images after use (leaving Pure)
    9.15 +#     -notest	make databases/images w/o running the examples
    9.16 +#     -noexec	don't execute, just check settings and Makefiles
    9.17 +
    9.18 +#Environment variables required:
    9.19 +# ISABELLEBIN: the directory to hold Poly/ML databases or New Jersey ML images
    9.20 +# ISABELLECOMP: the ML compiler
    9.21 +
    9.22 +# A typical shell script for /bin/sh is...
    9.23 +# ML_DBASE=/usr/groups/theory/poly2.04/`arch`/ML_dbase
    9.24 +# ISABELLEBIN=/homes/`whoami`/bin
    9.25 +# ISABELLECOMP="poly -noDisplay"
    9.26 +# export ML_DBASE ISABELLEBIN ISABELLECOMP 
    9.27 +# nohup make-all $*
    9.28 +
    9.29 +set -e			#fail immediately upon errors
    9.30 +
    9.31 +# process command line switches
    9.32 +CLEAN="off";
    9.33 +FORCE="on";
    9.34 +TEST="test";
    9.35 +EXEC="on";
    9.36 +NO="";
    9.37 +for A in $*
    9.38 +do
    9.39 +	case $A in
    9.40 +	-clean) CLEAN="on" ;;
    9.41 +	-noforce) FORCE="off" ;;
    9.42 +	-notest) TEST="" ;;
    9.43 +	-noexec) EXEC="off"
    9.44 +                 NO="-n" ;;
    9.45 +	*)	echo "Bad flag for make-all: $A"
    9.46 +		echo "Usage: make-all [-noforce] [-clean] [-notest] [-noexec]"
    9.47 +		exit ;;
    9.48 +	esac
    9.49 +done
    9.50 +
    9.51 +echo Started at `date`
    9.52 +echo Source=`pwd`
    9.53 +echo Destination=${ISABELLEBIN?'No destination directory specified'}
    9.54 +echo force=$FORCE '    ' clean=$CLEAN '    '
    9.55 +echo Compiler=${ISABELLECOMP?'No compiler specified'} 
    9.56 +echo Running on `hostname`
    9.57 +echo Log files will be called make$$.log.gz
    9.58 +
    9.59 +case $FORCE.$EXEC in
    9.60 +    on.on) (cd $ISABELLEBIN; rm -f Pure FOL ZF CCL LCF CTT LK Modal HOL Cube FOLP)
    9.61 +esac
    9.62 +
    9.63 +echo
    9.64 +echo
    9.65 +echo '*****Pure Isabelle*****'
    9.66 +(cd Pure; make $NO > make$$.log)
    9.67 +tail Pure/make$$.log
    9.68 +gzip Pure/make$$.log
    9.69 +
    9.70 +echo
    9.71 +echo
    9.72 +echo '*****First-Order Logic (FOL)*****'
    9.73 +(cd FOL;  make $NO $TEST > make$$.log)
    9.74 +tail FOL/make$$.log
    9.75 +gzip FOL/make$$.log
    9.76 +#cannot delete FOL yet... it is needed for ZF, CCL and LCF!
    9.77 +
    9.78 +echo
    9.79 +echo
    9.80 +echo '*****Set theory (ZF)*****'
    9.81 +(cd ZF;  make $NO $TEST > make$$.log)
    9.82 +tail ZF/make$$.log
    9.83 +gzip ZF/make$$.log
    9.84 +case $CLEAN.$EXEC in
    9.85 +    on.on)	rm $ISABELLEBIN/ZF
    9.86 +esac
    9.87 +
    9.88 +echo
    9.89 +echo
    9.90 +echo '*****Classical Computational Logic (CCL)*****'
    9.91 +(cd CCL;  make $NO $TEST > make$$.log)
    9.92 +tail CCL/make$$.log
    9.93 +gzip CCL/make$$.log
    9.94 +case $CLEAN.$EXEC in
    9.95 +    on.on)	rm $ISABELLEBIN/CCL
    9.96 +esac
    9.97 +
    9.98 +echo
    9.99 +echo
   9.100 +echo '*****Domain Theory (LCF)*****'
   9.101 +(cd LCF;  make $NO $TEST > make$$.log)
   9.102 +tail LCF/make$$.log
   9.103 +gzip LCF/make$$.log
   9.104 +case $CLEAN.$EXEC in
   9.105 +    on.on)	rm $ISABELLEBIN/FOL $ISABELLEBIN/LCF
   9.106 +esac
   9.107 +
   9.108 +echo
   9.109 +echo
   9.110 +echo '*****Constructive Type Theory (CTT)*****'
   9.111 +(cd CTT;  make $NO $TEST > make$$.log)
   9.112 +tail CTT/make$$.log
   9.113 +gzip CTT/make$$.log
   9.114 +case $CLEAN.$EXEC in
   9.115 +    on.on)	rm $ISABELLEBIN/CTT
   9.116 +esac
   9.117 +
   9.118 +echo
   9.119 +echo
   9.120 +echo '*****Classical Sequent Calculus (LK)*****'
   9.121 +(cd LK;  make $NO $TEST > make$$.log)
   9.122 +tail LK/make$$.log
   9.123 +gzip LK/make$$.log
   9.124 +#cannot delete LK yet... it is needed for Modal!
   9.125 +
   9.126 +echo
   9.127 +echo
   9.128 +echo '*****Modal logic (Modal)*****'
   9.129 +(cd Modal;  make $NO $TEST > make$$.log)
   9.130 +tail Modal/make$$.log
   9.131 +gzip Modal/make$$.log
   9.132 +case $CLEAN.$EXEC in
   9.133 +    on.on)	rm $ISABELLEBIN/LK $ISABELLEBIN/Modal
   9.134 +esac
   9.135 +
   9.136 +echo
   9.137 +echo
   9.138 +echo '*****Higher-Order Logic (HOL)*****'
   9.139 +(cd HOL;  make $NO $TEST > make$$.log)
   9.140 +tail HOL/make$$.log
   9.141 +gzip HOL/make$$.log
   9.142 +case $CLEAN.$EXEC in
   9.143 +    on.on)	rm $ISABELLEBIN/HOL
   9.144 +esac
   9.145 +
   9.146 +echo
   9.147 +echo
   9.148 +echo '*****The Lambda-Cube (Cube)*****'
   9.149 +(cd Cube;  make $NO $TEST > make$$.log)
   9.150 +case $CLEAN.$EXEC in
   9.151 +    on.on)	rm $ISABELLEBIN/Cube
   9.152 +esac
   9.153 +tail Cube/make$$.log 
   9.154 +gzip Cube/make$$.log 
   9.155 +
   9.156 +echo
   9.157 +echo
   9.158 +echo '*****First-Order Logic with Proof Terms (FOLP)*****'
   9.159 +(cd FOLP;  make $NO $TEST > make$$.log)
   9.160 +case $CLEAN.$EXEC in
   9.161 +    on.on)	rm $ISABELLEBIN/FOLP
   9.162 +esac
   9.163 +tail FOLP/make$$.log 
   9.164 +gzip FOLP/make$$.log 
   9.165 +
   9.166 +case $TEST.$EXEC in
   9.167 +    test.on)	echo
   9.168 +	        echo '***** Now check the dates on the "test" files *****'
   9.169 +        	ls -lrt FOL/test ZF/test CCL/test LCF/test CTT/test\
   9.170 +              	        LK/test Modal/test HOL/test Cube/test FOLP/test
   9.171 +esac
   9.172 +echo Finished at `date`
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/make-dist	Thu Sep 16 12:20:38 1993 +0200
    10.3 @@ -0,0 +1,21 @@
    10.4 +#!/bin/sh
    10.5 +#make-dist <DIR> 
    10.6 +#make a distribution directory of Isabelle sources. Example:    
    10.7 +#    rm -r /usr/groups/theory/isabelle/91
    10.8 +#    make-dist /usr/groups/theory/isabelle/91
    10.9 +
   10.10 +#BEFORE MAKING A NEW DISTRIBUTION VERSION, CHECK...
   10.11 +#   * that make-all works perfectly
   10.12 +#   * that README files are up-to-date
   10.13 +#   * that the version number has been updated
   10.14 +
   10.15 +#This version copies EVERYTHING!!!!!!!!!!!!!!!!
   10.16 +
   10.17 +set -e		#terminate if error
   10.18 +
   10.19 +#Pure Isabelle
   10.20 +mkdir ${1?'No destination directory specified'}
   10.21 +cp -ipr . $1
   10.22 +
   10.23 +#TO WRITE POLY/ML AND ISABELLE TAPES, USE SHELL SCRIPT write-dist
   10.24 +#TO PACK FOR EMAIL, USE SHELL SCRIPTS make-emaildist, send-emaildist
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/make-rulenames	Thu Sep 16 12:20:38 1993 +0200
    11.3 @@ -0,0 +1,36 @@
    11.4 +#!/bin/sh
    11.5 +#   Title: 	make-rulenames
    11.6 +#   Author: 	Larry Paulson, Cambridge University Computer Laboratory
    11.7 +#   Copyright   1990  University of Cambridge
    11.8 +#
    11.9 +#shell script for adding signature and val declarations to a rules file
   11.10 +#  usage:  make-rulenames <directory>
   11.11 +#
   11.12 +#Input is the file ruleshell.ML, which defines a theory.
   11.13 +#Output is .rules.ML
   11.14 +#
   11.15 +#
   11.16 +#Rule lines begin with a line containing the word "extend_theory"
   11.17 +#       and end   with a line containing the word "get_axiom"
   11.18 +#
   11.19 +#Each rule name xyz must appear on a line that begins
   11.20 +#           <spaces> ("xyz"
   11.21 +# ENSURE THAT THE FIRST RULE LINE DOES NOT CONTAIN A "[" CHARACTER!
   11.22 +#The file RULESIG gets lines like	val Eq_comp: thm
   11.23 +#    These are inserted after the line containing the string INSERT-RULESIG
   11.24 +#
   11.25 +#The file RULENAMES gets lines like	val Eq_comp = ax"Eq_comp";
   11.26 +#    These are inserted after the line containing the string INSERT-RULENAMES
   11.27 +#The input file should define the function "ax" above this point.
   11.28 +#
   11.29 +set -eu		#terminate if error or unset variable
   11.30 +if [ ! '(' -d $1 -a -f $1/ruleshell.ML ')' ]; \
   11.31 +           then echo $1 is not a suitable directory; exit 1; \
   11.32 +           fi
   11.33 +sed -n -e '/extend_theory/,/get_axiom/ s/^ *("\([^"]*\)".*$/  val \1: thm/p' $1/ruleshell.ML > RULESIG
   11.34 +sed -n -e '/extend_theory/,/get_axiom/ s/^ *("\([^"]*\)".*$/val \1 = ax"\1";/p' $1/ruleshell.ML > RULENAMES
   11.35 +sed -e '/INSERT-RULESIG/ r RULESIG
   11.36 +/INSERT-RULENAMES/ r RULENAMES' $1/ruleshell.ML > $1/.rules.ML
   11.37 +#WARNING: there must be no spaces after the filename in the "r" command!!
   11.38 +rm RULESIG RULENAMES
   11.39 +
    12.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.2 +++ b/prove_goal.el	Thu Sep 16 12:20:38 1993 +0200
    12.3 @@ -0,0 +1,125 @@
    12.4 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    12.5 +;; special function for Isabelle
    12.6 +;;
    12.7 +;;
    12.8 +; goalify.el
    12.9 +;
   12.10 +; Emacs command to change "goal" proofs to "prove_goal" proofs 
   12.11 +; and reverse IN A REGION.
   12.12 +;    [would be difficult in "sed" since replacements involve multiple lines]
   12.13 +;
   12.14 +;; origin is prove_goalify.el
   12.15 +;; enhanced by Franz Regensburger
   12.16 +;;    corrected some errors in regular expressions
   12.17 +;;    changed name prove_goalify --> goalify
   12.18 +;;    added inverse functions        ungoalify
   12.19 +;
   12.20 +; function goalify:
   12.21 +; 
   12.22 +; val PAT = goalARGS;$
   12.23 +; COMMANDS;$
   12.24 +; val ID = result();
   12.25 +; 
   12.26 +; to
   12.27 +; 
   12.28 +; val ID = prove_goalARGS
   12.29 +;  (fn PAT=>
   12.30 +;  [
   12.31 +;  COMMANDS
   12.32 +;  ]);
   12.33 +;;
   12.34 +;; Note: PAT must be an identifier. _ as pattern is not supported.
   12.35 +;;
   12.36 +; function ungoalify:
   12.37 +; 
   12.38 +; val ID = prove_goalARGS
   12.39 +;  (fn PAT=>
   12.40 +;  [
   12.41 +;  COMMANDS
   12.42 +;  ]);
   12.43 +;
   12.44 +;
   12.45 +; to 
   12.46 +; val PAT = goalARGS;$
   12.47 +; COMMANDS;$
   12.48 +; val ID = result();
   12.49 +; 
   12.50 +
   12.51 +
   12.52 +(defun ungoalify (alpha omega)
   12.53 + "Change well-formed prove_goal proofs to goal...result"
   12.54 +  (interactive "r"
   12.55 +	       "*") 
   12.56 +  ; 0: restrict editing to region
   12.57 +  (narrow-to-region alpha omega)
   12.58 +
   12.59 +  ; 1: insert delimiter ID 
   12.60 +  (goto-char (point-min))
   12.61 +  (replace-regexp  
   12.62 +  "[ \t]*val[ \t]+\\([^ \t\n=]+\\)[ \t\n=]+prove_goal" "\\1")
   12.63 +
   12.64 +  ; 2: insertt delimiter ARGS  PAT  and  before first command   
   12.65 +  (goto-char (point-min))
   12.66 +  (replace-regexp  
   12.67 +  "[ \n\t]*(fn[ \t]+\\([^=]+\\)=>[^(]*" "\\1\n")
   12.68 +
   12.69 +  ; 3: shift  over all commands
   12.70 +  ; Note: only one line per command
   12.71 +  (goto-char (point-max))
   12.72 +  (while (not (equal (point) (point-min)))
   12.73 +    (goto-char (point-min))
   12.74 +    (replace-regexp  
   12.75 +    "[ \t]*\\(.*\\),[ \t]*\n" "by \\1;\n"))
   12.76 +    
   12.77 +  ; 4: fix last 
   12.78 +  (goto-char (point-min))
   12.79 +  (replace-regexp  
   12.80 +    "[ \t]*\\(.*\\)[ \t\n]*\][ \t\n]*)[ \t\n]*;" "by \\1;")
   12.81 +
   12.82 +  ; 5: arange new val Pat = goal .. 
   12.83 +  (goto-char (point-min))
   12.84 +  (replace-regexp  
   12.85 +  "\\([^]*\\)\\([^]*\\)\\([^]*\\)\n\\([^]*\\)"
   12.86 +  "val \\3= goal\\2;\n\\4\nval \\1 = result();")
   12.87 +
   12.88 +  ; widen again
   12.89 +  (widen)
   12.90 +)
   12.91 +
   12.92 +
   12.93 +(defun goalify (alpha omega)
   12.94 + "Change well-formed goal...result proofs to use prove_goal"
   12.95 +  (interactive "r"
   12.96 +               "*") 
   12.97 +
   12.98 +  ; 0: restrict editing to region
   12.99 +  (narrow-to-region alpha omega)
  12.100 +
  12.101 +  ; 1: delimit the identifier in "val ID = result()" using ^Q
  12.102 +  (goto-char (point-min))
  12.103 +  (replace-regexp  "val[ \t\n]+\\([^ \t\n=]+\\)[ \t\n=]+result();[ \t]*$"
  12.104 +   "\\1")
  12.105 +
  12.106 +  ; 2: replace terminal \";  by  
  12.107 +  (goto-char (point-min))
  12.108 +  (replace-regexp  "\";[ \t]*$" "")
  12.109 +
  12.110 +  ; 3: replace lines "by ...;" with "...,"
  12.111 +  (goto-char (point-min))
  12.112 +  (replace-regexp  "by[ \n\t]*\\([^;]*\\)[ \t\n]*;"  "\t\\1,")
  12.113 +
  12.114 +  ; 4: removing the extra commas, those followed by ^Q
  12.115 +  (goto-char (point-min))
  12.116 +  (replace-regexp  ",[ \n\t]*"  "")
  12.117 +
  12.118 +  ; 5: transforming goal... to prove_goal...
  12.119 +  (goto-char (point-min))
  12.120 +  (replace-regexp
  12.121 +  "val[ \t\n]+\\([^ \n\t=]+\\)[ \t\n=]+goal\\([^]*\\)
  12.122 +\\([^]*\\)\\([^]*\\)"  
  12.123 +  "val \\4 = prove_goal\\2\"\n (fn \\1 =>\n\t[\n\\3\n\t]);")
  12.124 +
  12.125 +  ; 6: widen again
  12.126 +  (widen)
  12.127 +)
  12.128 +
    13.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2 +++ b/rm-logfiles	Thu Sep 16 12:20:38 1993 +0200
    13.3 @@ -0,0 +1,7 @@
    13.4 +#! /bin/sh
    13.5 +#rm-logfiles: remove useless files from subdirectories
    13.6 +rm log */make*.log */make*.log.gz */make*.log.z
    13.7 +rm */test
    13.8 +rm */.*.thy.ML
    13.9 +rm */ex/.*.thy.ML
   13.10 +rm HOL/Subst/.*.thy.ML
    14.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.2 +++ b/src/CCL/CCL.ML	Thu Sep 16 12:20:38 1993 +0200
    14.3 @@ -0,0 +1,362 @@
    14.4 +(*  Title: 	CCL/ccl
    14.5 +    ID:         $Id$
    14.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    14.7 +    Copyright   1993  University of Cambridge
    14.8 +
    14.9 +For ccl.thy.
   14.10 +*)
   14.11 +
   14.12 +open CCL;
   14.13 +
   14.14 +val ccl_data_defs = [apply_def,fix_def];
   14.15 +
   14.16 +(*** Simplifier for pre-order and equality ***)
   14.17 +
   14.18 +structure CCL_SimpData : SIMP_DATA =
   14.19 +  struct
   14.20 +  val refl_thms		= [refl, po_refl, iff_refl]
   14.21 +  val trans_thms	= [trans, iff_trans, po_trans]
   14.22 +  val red1		= iffD1
   14.23 +  val red2		= iffD2
   14.24 +  val mk_rew_rules	= mk_rew_rules
   14.25 +  val case_splits	= []         (*NO IF'S!*)
   14.26 +  val norm_thms		= norm_thms
   14.27 +  val subst_thms	= [subst];
   14.28 +  val dest_red		= dest_red
   14.29 +  end;
   14.30 +
   14.31 +structure CCL_Simp = SimpFun(CCL_SimpData);
   14.32 +open CCL_Simp;
   14.33 +
   14.34 +val auto_ss = empty_ss setauto (fn hyps => ares_tac (TrueI::hyps));
   14.35 +
   14.36 +val po_refl_iff_T = make_iff_T po_refl;
   14.37 +
   14.38 +val CCL_ss = auto_ss addcongs (FOL_congs @ set_congs)
   14.39 +                     addrews  ([po_refl_iff_T] @ FOL_rews @ mem_rews);
   14.40 +
   14.41 +(*** Congruence Rules ***)
   14.42 +
   14.43 +(*similar to AP_THM in Gordon's HOL*)
   14.44 +val fun_cong = prove_goal CCL.thy "(f::'a=>'b) = g ==> f(x)=g(x)"
   14.45 +  (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
   14.46 +
   14.47 +(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
   14.48 +val arg_cong = prove_goal CCL.thy "x=y ==> f(x)=f(y)"
   14.49 + (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
   14.50 +
   14.51 +goal CCL.thy  "(ALL x. f(x) = g(x)) --> (%x.f(x)) = (%x.g(x))";
   14.52 +by (SIMP_TAC (CCL_ss addrews [eq_iff]) 1);
   14.53 +by (fast_tac (set_cs addIs [po_abstractn]) 1);
   14.54 +val abstractn = standard (allI RS (result() RS mp));
   14.55 +
   14.56 +fun type_of_terms (Const("Trueprop",_) $ 
   14.57 +                   (Const("op =",(Type ("fun", [t,_]))) $ _ $ _)) = t;
   14.58 +
   14.59 +fun abs_prems thm = 
   14.60 +   let fun do_abs n thm (Type ("fun", [_,t])) = do_abs n (abstractn RSN (n,thm)) t
   14.61 +         | do_abs n thm _                     = thm
   14.62 +       fun do_prems n      [] thm = thm
   14.63 +         | do_prems n (x::xs) thm = do_prems (n+1) xs (do_abs n thm (type_of_terms x));
   14.64 +   in do_prems 1 (prems_of thm) thm
   14.65 +   end;
   14.66 +
   14.67 +fun ccl_mk_congs thy cs = map abs_prems (mk_congs thy cs); 
   14.68 +
   14.69 +val ccl_congs = ccl_mk_congs CCL.thy 
   14.70 + ["op [=","SIM","POgen","EQgen","pair","lambda","case","op `","fix"];
   14.71 +
   14.72 +val caseBs = [caseBtrue,caseBfalse,caseBpair,caseBlam,caseBbot];
   14.73 +
   14.74 +(*** Termination and Divergence ***)
   14.75 +
   14.76 +goalw CCL.thy [Trm_def,Dvg_def] "Trm(t) <-> ~ t = bot";
   14.77 +br iff_refl 1;
   14.78 +val Trm_iff = result();
   14.79 +
   14.80 +goalw CCL.thy [Trm_def,Dvg_def] "Dvg(t) <-> t = bot";
   14.81 +br iff_refl 1;
   14.82 +val Dvg_iff = result();
   14.83 +
   14.84 +(*** Constructors are injective ***)
   14.85 +
   14.86 +val prems = goal CCL.thy
   14.87 +    "[| x=a;  y=b;  x=y |] ==> a=b";
   14.88 +by  (REPEAT (SOMEGOAL (ares_tac (prems@[box_equals]))));
   14.89 +val eq_lemma = result();
   14.90 +
   14.91 +fun mk_inj_rl thy rews congs s = 
   14.92 +      let fun mk_inj_lemmas r = ([arg_cong] RL [(r RS (r RS eq_lemma))]);
   14.93 +          val inj_lemmas = flat (map mk_inj_lemmas rews);
   14.94 +          val tac = REPEAT (ares_tac [iffI,allI,conjI] 1 ORELSE
   14.95 +                            eresolve_tac inj_lemmas 1 ORELSE
   14.96 +                            ASM_SIMP_TAC (CCL_ss addrews rews 
   14.97 +                                                 addcongs congs) 1)
   14.98 +      in prove_goal thy s (fn _ => [tac])
   14.99 +      end;
  14.100 +
  14.101 +val ccl_injs = map (mk_inj_rl CCL.thy caseBs ccl_congs)
  14.102 +               ["<a,b> = <a',b'> <-> (a=a' & b=b')",
  14.103 +                "(lam x.b(x) = lam x.b'(x)) <-> ((ALL z.b(z)=b'(z)))"];
  14.104 +
  14.105 +val pair_inject = ((hd ccl_injs) RS iffD1) RS conjE;
  14.106 +
  14.107 +(*** Constructors are distinct ***)
  14.108 +
  14.109 +local
  14.110 +  fun pairs_of f x [] = []
  14.111 +    | pairs_of f x (y::ys) = (f x y) :: (f y x) :: (pairs_of f x ys);
  14.112 +
  14.113 +  fun mk_combs ff [] = []
  14.114 +    | mk_combs ff (x::xs) = (pairs_of ff x xs) @ mk_combs ff xs;
  14.115 +
  14.116 +(* Doesn't handle binder types correctly *)
  14.117 +  fun saturate thy sy name = 
  14.118 +       let fun arg_str 0 a s = s
  14.119 +         | arg_str 1 a s = "(" ^ a ^ "a" ^ s ^ ")"
  14.120 +         | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s);
  14.121 +           val sg = sign_of thy;
  14.122 +           val T = case Sign.Symtab.lookup(#const_tab(Sign.rep_sg sg),sy) of
  14.123 +  		            None => error(sy^" not declared") | Some(T) => T;
  14.124 +           val arity = length (fst (strip_type T));
  14.125 +       in sy ^ (arg_str arity name "") end;
  14.126 +
  14.127 +  fun mk_thm_str thy a b = "~ " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b");
  14.128 +
  14.129 +  val lemma = prove_goal CCL.thy "t=t' --> case(t,b,c,d,e) = case(t',b,c,d,e)"
  14.130 +                   (fn _ => [SIMP_TAC (CCL_ss addcongs ccl_congs) 1]) RS mp;
  14.131 +  fun mk_lemma (ra,rb) = [lemma] RL [ra RS (rb RS eq_lemma)] RL 
  14.132 +                           [distinctness RS notE,sym RS (distinctness RS notE)];
  14.133 +in
  14.134 +  fun mk_lemmas rls = flat (map mk_lemma (mk_combs pair rls));
  14.135 +  fun mk_dstnct_rls thy xs = mk_combs (mk_thm_str thy) xs;
  14.136 +end;
  14.137 +
  14.138 +
  14.139 +val caseB_lemmas = mk_lemmas caseBs;
  14.140 +
  14.141 +val ccl_dstncts = 
  14.142 +        let fun mk_raw_dstnct_thm rls s = 
  14.143 +                  prove_goal CCL.thy s (fn _=> [rtac notI 1,eresolve_tac rls 1])
  14.144 +        in map (mk_raw_dstnct_thm caseB_lemmas) 
  14.145 +                (mk_dstnct_rls CCL.thy ["bot","true","false","pair","lambda"]) end;
  14.146 +
  14.147 +fun mk_dstnct_thms thy defs inj_rls xs = 
  14.148 +          let fun mk_dstnct_thm rls s = prove_goalw thy defs s 
  14.149 +                               (fn _ => [SIMP_TAC (CCL_ss addrews (rls@inj_rls)) 1])
  14.150 +          in map (mk_dstnct_thm ccl_dstncts) (mk_dstnct_rls thy xs) end;
  14.151 +
  14.152 +fun mkall_dstnct_thms thy defs i_rls xss = flat (map (mk_dstnct_thms thy defs i_rls) xss);
  14.153 +
  14.154 +(*** Rewriting and Proving ***)
  14.155 +
  14.156 +fun XH_to_I rl = rl RS iffD2;
  14.157 +fun XH_to_D rl = rl RS iffD1;
  14.158 +val XH_to_E = make_elim o XH_to_D;
  14.159 +val XH_to_Is = map XH_to_I;
  14.160 +val XH_to_Ds = map XH_to_D;
  14.161 +val XH_to_Es = map XH_to_E;
  14.162 +
  14.163 +val ccl_rews = caseBs @ ccl_injs @ ccl_dstncts;
  14.164 +val ccl_ss = CCL_ss addrews ccl_rews addcongs ccl_congs;
  14.165 +
  14.166 +val ccl_cs = set_cs addSEs (pair_inject::(ccl_dstncts RL [notE])) 
  14.167 +                    addSDs (XH_to_Ds ccl_injs);
  14.168 +
  14.169 +(****** Facts from gfp Definition of [= and = ******)
  14.170 +
  14.171 +val major::prems = goal Set.thy "[| A=B;  a:B <-> P |] ==> a:A <-> P";
  14.172 +brs (prems RL [major RS ssubst]) 1;
  14.173 +val XHlemma1 = result();
  14.174 +
  14.175 +goal CCL.thy "(P(t,t') <-> Q) --> (<t,t'> : {p.EX t t'.p=<t,t'> &  P(t,t')} <-> Q)";
  14.176 +by (fast_tac ccl_cs 1);
  14.177 +val XHlemma2 = result() RS mp;
  14.178 +
  14.179 +(*** Pre-Order ***)
  14.180 +
  14.181 +goalw CCL.thy [POgen_def,SIM_def]  "mono(%X.POgen(X))";
  14.182 +br monoI 1;
  14.183 +by (safe_tac ccl_cs);
  14.184 +by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
  14.185 +by (ALLGOALS (SIMP_TAC ccl_ss));
  14.186 +by (ALLGOALS (fast_tac set_cs));
  14.187 +val POgen_mono = result();
  14.188 +
  14.189 +goalw CCL.thy [POgen_def,SIM_def]
  14.190 +  "<t,t'> : POgen(R) <-> t= bot | (t=true & t'=true)  | (t=false & t'=false) | \
  14.191 +\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
  14.192 +\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
  14.193 +br (iff_refl RS XHlemma2) 1;
  14.194 +val POgenXH = result();
  14.195 +
  14.196 +goal CCL.thy
  14.197 +  "t [= t' <-> t=bot | (t=true & t'=true) | (t=false & t'=false) | \
  14.198 +\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a [= a' & b [= b') | \
  14.199 +\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x) [= f'(x)))";
  14.200 +by (SIMP_TAC (ccl_ss addrews [PO_iff]) 1);
  14.201 +br (rewrite_rule [POgen_def,SIM_def] 
  14.202 +                 (POgen_mono RS (PO_def RS def_gfp_Tarski) RS XHlemma1)) 1;
  14.203 +br (iff_refl RS XHlemma2) 1;
  14.204 +val poXH = result();
  14.205 +
  14.206 +goal CCL.thy "bot [= b";
  14.207 +br (poXH RS iffD2) 1;
  14.208 +by (SIMP_TAC ccl_ss 1);
  14.209 +val po_bot = result();
  14.210 +
  14.211 +goal CCL.thy "a [= bot --> a=bot";
  14.212 +br impI 1;
  14.213 +bd (poXH RS iffD1) 1;
  14.214 +be rev_mp 1;
  14.215 +by (SIMP_TAC ccl_ss 1);
  14.216 +val bot_poleast = result() RS mp;
  14.217 +
  14.218 +goal CCL.thy "<a,b> [= <a',b'> <->  a [= a' & b [= b'";
  14.219 +br (poXH RS iff_trans) 1;
  14.220 +by (SIMP_TAC ccl_ss 1);
  14.221 +by (fast_tac ccl_cs 1);
  14.222 +val po_pair = result();
  14.223 +
  14.224 +goal CCL.thy "lam x.f(x) [= lam x.f'(x) <-> (ALL x. f(x) [= f'(x))";
  14.225 +br (poXH RS iff_trans) 1;
  14.226 +by (SIMP_TAC ccl_ss 1);
  14.227 +by (REPEAT (ares_tac [iffI,allI] 1 ORELSE eresolve_tac [exE,conjE] 1));
  14.228 +by (ASM_SIMP_TAC ccl_ss 1);
  14.229 +by (fast_tac ccl_cs 1);
  14.230 +val po_lam = result();
  14.231 +
  14.232 +val ccl_porews = [po_bot,po_pair,po_lam];
  14.233 +
  14.234 +val [p1,p2,p3,p4,p5] = goal CCL.thy
  14.235 +    "[| t [= t';  a [= a';  b [= b';  !!x y.c(x,y) [= c'(x,y); \
  14.236 +\       !!u.d(u) [= d'(u) |] ==> case(t,a,b,c,d) [= case(t',a',b',c',d')";
  14.237 +br (p1 RS po_cong RS po_trans) 1;
  14.238 +br (p2 RS po_cong RS po_trans) 1;
  14.239 +br (p3 RS po_cong RS po_trans) 1;
  14.240 +br (p4 RS po_abstractn RS po_abstractn RS po_cong RS po_trans) 1;
  14.241 +by (res_inst_tac [("f1","%d.case(t',a',b',c',d)")] 
  14.242 +               (p5 RS po_abstractn RS po_cong RS po_trans) 1);
  14.243 +br po_refl 1;
  14.244 +val case_pocong = result();
  14.245 +
  14.246 +val [p1,p2] = goalw CCL.thy ccl_data_defs
  14.247 +    "[| f [= f';  a [= a' |] ==> f ` a [= f' ` a'";
  14.248 +by (REPEAT (ares_tac [po_refl,case_pocong,p1,p2 RS po_cong] 1));
  14.249 +val apply_pocong = result();
  14.250 +
  14.251 +
  14.252 +val prems = goal CCL.thy "~ lam x.b(x) [= bot";
  14.253 +br notI 1;
  14.254 +bd bot_poleast 1;
  14.255 +be (distinctness RS notE) 1;
  14.256 +val npo_lam_bot = result();
  14.257 +
  14.258 +val eq1::eq2::prems = goal CCL.thy
  14.259 +    "[| x=a;  y=b;  x[=y |] ==> a[=b";
  14.260 +br (eq1 RS subst) 1;
  14.261 +br (eq2 RS subst) 1;
  14.262 +brs prems 1;
  14.263 +val po_lemma = result();
  14.264 +
  14.265 +goal CCL.thy "~ <a,b> [= lam x.f(x)";
  14.266 +br notI 1;
  14.267 +br (npo_lam_bot RS notE) 1;
  14.268 +be (case_pocong RS (caseBlam RS (caseBpair RS po_lemma))) 1;
  14.269 +by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
  14.270 +val npo_pair_lam = result();
  14.271 +
  14.272 +goal CCL.thy "~ lam x.f(x) [= <a,b>";
  14.273 +br notI 1;
  14.274 +br (npo_lam_bot RS notE) 1;
  14.275 +be (case_pocong RS (caseBpair RS (caseBlam RS po_lemma))) 1;
  14.276 +by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
  14.277 +val npo_lam_pair = result();
  14.278 +
  14.279 +fun mk_thm s = prove_goal CCL.thy s (fn _ => 
  14.280 +                          [rtac notI 1,dtac case_pocong 1,etac rev_mp 5,
  14.281 +                           ALLGOALS (SIMP_TAC ccl_ss),
  14.282 +                           REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)]);
  14.283 +
  14.284 +val npo_rls = [npo_pair_lam,npo_lam_pair] @ map mk_thm
  14.285 +            ["~ true [= false",          "~ false [= true",
  14.286 +             "~ true [= <a,b>",          "~ <a,b> [= true",
  14.287 +             "~ true [= lam x.f(x)","~ lam x.f(x) [= true",
  14.288 +            "~ false [= <a,b>",          "~ <a,b> [= false",
  14.289 +            "~ false [= lam x.f(x)","~ lam x.f(x) [= false"];
  14.290 +
  14.291 +(* Coinduction for [= *)
  14.292 +
  14.293 +val prems = goal CCL.thy "[|  <t,u> : R;  R <= POgen(R) |] ==> t [= u";
  14.294 +br (PO_def RS def_coinduct RS (PO_iff RS iffD2)) 1;
  14.295 +by (REPEAT (ares_tac prems 1));
  14.296 +val po_coinduct = result();
  14.297 +
  14.298 +fun po_coinduct_tac s i = res_inst_tac [("R",s)] po_coinduct i;
  14.299 +
  14.300 +(*************** EQUALITY *******************)
  14.301 +
  14.302 +goalw CCL.thy [EQgen_def,SIM_def]  "mono(%X.EQgen(X))";
  14.303 +br monoI 1;
  14.304 +by (safe_tac set_cs);
  14.305 +by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
  14.306 +by (ALLGOALS (SIMP_TAC ccl_ss));
  14.307 +by (ALLGOALS (fast_tac set_cs));
  14.308 +val EQgen_mono = result();
  14.309 +
  14.310 +goalw CCL.thy [EQgen_def,SIM_def]
  14.311 +  "<t,t'> : EQgen(R) <-> (t=bot & t'=bot)  | (t=true & t'=true)  | \
  14.312 +\                                            (t=false & t'=false) | \
  14.313 +\                (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
  14.314 +\                (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
  14.315 +br (iff_refl RS XHlemma2) 1;
  14.316 +val EQgenXH = result();
  14.317 +
  14.318 +goal CCL.thy
  14.319 +  "t=t' <-> (t=bot & t'=bot)  | (t=true & t'=true)  | (t=false & t'=false) | \
  14.320 +\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a=a' & b=b') | \
  14.321 +\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x)=f'(x)))";
  14.322 +by (subgoal_tac
  14.323 +  "<t,t'> : EQ <-> (t=bot & t'=bot)  | (t=true & t'=true) | (t=false & t'=false) | \
  14.324 +\             (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : EQ & <b,b'> : EQ) | \
  14.325 +\             (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : EQ))" 1);
  14.326 +be rev_mp 1;
  14.327 +by (SIMP_TAC (CCL_ss addrews [EQ_iff RS iff_sym]) 1);
  14.328 +br (rewrite_rule [EQgen_def,SIM_def]
  14.329 +                 (EQgen_mono RS (EQ_def RS def_gfp_Tarski) RS XHlemma1)) 1;
  14.330 +br (iff_refl RS XHlemma2) 1;
  14.331 +val eqXH = result();
  14.332 +
  14.333 +val prems = goal CCL.thy "[|  <t,u> : R;  R <= EQgen(R) |] ==> t = u";
  14.334 +br (EQ_def RS def_coinduct RS (EQ_iff RS iffD2)) 1;
  14.335 +by (REPEAT (ares_tac prems 1));
  14.336 +val eq_coinduct = result();
  14.337 +
  14.338 +val prems = goal CCL.thy 
  14.339 +    "[|  <t,u> : R;  R <= EQgen(lfp(%x.EQgen(x) Un R Un EQ)) |] ==> t = u";
  14.340 +br (EQ_def RS def_coinduct3 RS (EQ_iff RS iffD2)) 1;
  14.341 +by (REPEAT (ares_tac (EQgen_mono::prems) 1));
  14.342 +val eq_coinduct3 = result();
  14.343 +
  14.344 +fun eq_coinduct_tac s i = res_inst_tac [("R",s)] eq_coinduct i;
  14.345 +fun eq_coinduct3_tac s i = res_inst_tac [("R",s)] eq_coinduct3 i;
  14.346 +
  14.347 +(*** Untyped Case Analysis and Other Facts ***)
  14.348 +
  14.349 +goalw CCL.thy [apply_def]  "(EX f.t=lam x.f(x)) --> t = lam x.(t ` x)";
  14.350 +by (safe_tac ccl_cs);
  14.351 +by (SIMP_TAC ccl_ss 1);
  14.352 +val cond_eta = result() RS mp;
  14.353 +
  14.354 +goal CCL.thy "(t=bot) | (t=true) | (t=false) | (EX a b.t=<a,b>) | (EX f.t=lam x.f(x))";
  14.355 +by (cut_facts_tac [refl RS (eqXH RS iffD1)] 1);
  14.356 +by (fast_tac set_cs 1);
  14.357 +val exhaustion = result();
  14.358 +
  14.359 +val prems = goal CCL.thy 
  14.360 +    "[| P(bot);  P(true);  P(false);  !!x y.P(<x,y>);  !!b.P(lam x.b(x)) |] ==> P(t)";
  14.361 +by (cut_facts_tac [exhaustion] 1);
  14.362 +by (REPEAT_SOME (ares_tac prems ORELSE' eresolve_tac [disjE,exE,ssubst]));
  14.363 +val term_case = result();
  14.364 +
  14.365 +fun term_case_tac a i = res_inst_tac [("t",a)] term_case i;
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/CCL/CCL.thy	Thu Sep 16 12:20:38 1993 +0200
    15.3 @@ -0,0 +1,148 @@
    15.4 +(*  Title: 	CCL/ccl.thy
    15.5 +    ID:         $Id$
    15.6 +    Author: 	Martin Coen
    15.7 +    Copyright   1993  University of Cambridge
    15.8 +
    15.9 +Classical Computational Logic for Untyped Lambda Calculus with reduction to 
   15.10 +weak head-normal form.
   15.11 +
   15.12 +Based on FOL extended with set collection, a primitive higher-order logic.
   15.13 +HOL is too strong - descriptions prevent a type of programs being defined
   15.14 +which contains only executable terms.
   15.15 +*)
   15.16 +
   15.17 +CCL = Gfp +
   15.18 +
   15.19 +classes prog < term
   15.20 +
   15.21 +default prog
   15.22 +
   15.23 +types i 0
   15.24 +
   15.25 +arities 
   15.26 +      i          :: prog
   15.27 +      fun        :: (prog,prog)prog
   15.28 +
   15.29 +consts
   15.30 +  (*** Evaluation Judgement ***)
   15.31 +  "--->"      ::       "[i,i]=>prop"          (infixl 20)
   15.32 +
   15.33 +  (*** Bisimulations for pre-order and equality ***)
   15.34 +  "[="        ::       "['a,'a]=>o"           (infixl 50)
   15.35 +  SIM         ::       "[i,i,i set]=>o"
   15.36 +  POgen,EQgen ::       "i set => i set"
   15.37 +  PO,EQ       ::       "i set"
   15.38 +
   15.39 +  (*** Term Formers ***)
   15.40 +  true,false  ::       "i"
   15.41 +  pair        ::       "[i,i]=>i"             ("(1<_,/_>)")
   15.42 +  lambda      ::       "(i=>i)=>i"            (binder "lam " 55)
   15.43 +  case        ::       "[i,i,i,[i,i]=>i,(i=>i)=>i]=>i"
   15.44 +  "`"         ::       "[i,i]=>i"             (infixl 56)
   15.45 +  bot         ::       "i"
   15.46 +  fix         ::       "(i=>i)=>i"
   15.47 +
   15.48 +  (*** Defined Predicates ***)
   15.49 +  Trm,Dvg     ::       "i => o"
   15.50 +
   15.51 +rules
   15.52 +
   15.53 +  (******* EVALUATION SEMANTICS *******)
   15.54 +
   15.55 +  (**  This is the evaluation semantics from which the axioms below were derived.  **)
   15.56 +  (**  It is included here just as an evaluator for FUN and has no influence on    **)
   15.57 +  (**  inference in the theory CCL.                                                **)
   15.58 +
   15.59 +  trueV       "true ---> true"
   15.60 +  falseV      "false ---> false"
   15.61 +  pairV       "<a,b> ---> <a,b>"
   15.62 +  lamV        "lam x.b(x) ---> lam x.b(x)"
   15.63 +  caseVtrue   "[| t ---> true;  d ---> c |] ==> case(t,d,e,f,g) ---> c"
   15.64 +  caseVfalse  "[| t ---> false;  e ---> c |] ==> case(t,d,e,f,g) ---> c"
   15.65 +  caseVpair   "[| t ---> <a,b>;  f(a,b) ---> c |] ==> case(t,d,e,f,g) ---> c"
   15.66 +  caseVlam    "[| t ---> lam x.b(x);  g(b) ---> c |] ==> case(t,d,e,f,g) ---> c"
   15.67 +
   15.68 +  (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***)
   15.69 +
   15.70 +  canonical  "[| t ---> c; c==true ==> u--->v; \
   15.71 +\                          c==false ==> u--->v; \
   15.72 +\                    !!a b.c==<a,b> ==> u--->v; \
   15.73 +\                      !!f.c==lam x.f(x) ==> u--->v |] ==> \
   15.74 +\             u--->v"
   15.75 +
   15.76 +  (* Should be derivable - but probably a bitch! *)
   15.77 +  substitute "[| a==a'; t(a)--->c(a) |] ==> t(a')--->c(a')"
   15.78 +
   15.79 +  (************** LOGIC ***************)
   15.80 +
   15.81 +  (*** Definitions used in the following rules ***)
   15.82 +
   15.83 +  apply_def     "f ` t == case(f,bot,bot,%x y.bot,%u.u(t))"
   15.84 +  bot_def         "bot == (lam x.x`x)`(lam x.x`x)"
   15.85 +  fix_def      "fix(f) == (lam x.f(x`x))`(lam x.f(x`x))"
   15.86 +
   15.87 +  (*  The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *)
   15.88 +  (*  as a bisimulation.  They can both be expressed as (bi)simulations up to        *)
   15.89 +  (*  behavioural equivalence (ie the relations PO and EQ defined below).            *)
   15.90 +
   15.91 +  SIM_def
   15.92 +  "SIM(t,t',R) ==  (t=true & t'=true) | (t=false & t'=false) | \
   15.93 +\                  (EX a a' b b'.t=<a,b> & t'=<a',b'> & <a,a'> : R & <b,b'> : R) | \
   15.94 +\                  (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))"
   15.95 +
   15.96 +  POgen_def  "POgen(R) == {p. EX t t'. p=<t,t'> & (t = bot | SIM(t,t',R))}"
   15.97 +  EQgen_def  "EQgen(R) == {p. EX t t'. p=<t,t'> & (t = bot & t' = bot | SIM(t,t',R))}"
   15.98 +
   15.99 +  PO_def    "PO == gfp(POgen)"
  15.100 +  EQ_def    "EQ == gfp(EQgen)"
  15.101 +
  15.102 +  (*** Rules ***)
  15.103 +
  15.104 +  (** Partial Order **)
  15.105 +
  15.106 +  po_refl        "a [= a"
  15.107 +  po_trans       "[| a [= b;  b [= c |] ==> a [= c"
  15.108 +  po_cong        "a [= b ==> f(a) [= f(b)"
  15.109 +
  15.110 +  (* Extend definition of [= to program fragments of higher type *)
  15.111 +  po_abstractn   "(!!x. f(x) [= g(x)) ==> (%x.f(x)) [= (%x.g(x))"
  15.112 +
  15.113 +  (** Equality - equivalence axioms inherited from FOL.thy   **)
  15.114 +  (**          - congruence of "=" is axiomatised implicitly **)
  15.115 +
  15.116 +  eq_iff         "t = t' <-> t [= t' & t' [= t"
  15.117 +
  15.118 +  (** Properties of canonical values given by greatest fixed point definitions **)
  15.119 + 
  15.120 +  PO_iff         "t [= t' <-> <t,t'> : PO"
  15.121 +  EQ_iff         "t =  t' <-> <t,t'> : EQ"
  15.122 +
  15.123 +  (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **)
  15.124 +
  15.125 +  caseBtrue            "case(true,d,e,f,g) = d"
  15.126 +  caseBfalse          "case(false,d,e,f,g) = e"
  15.127 +  caseBpair           "case(<a,b>,d,e,f,g) = f(a,b)"
  15.128 +  caseBlam       "case(lam x.b(x),d,e,f,g) = g(b)"
  15.129 +  caseBbot              "case(bot,d,e,f,g) = bot"            (* strictness *)
  15.130 +
  15.131 +  (** The theory is non-trivial **)
  15.132 +  distinctness   "~ lam x.b(x) = bot"
  15.133 +
  15.134 +  (*** Definitions of Termination and Divergence ***)
  15.135 +
  15.136 +  Dvg_def  "Dvg(t) == t = bot"
  15.137 +  Trm_def  "Trm(t) == ~ Dvg(t)"
  15.138 +
  15.139 +end
  15.140 +
  15.141 +
  15.142 +(*
  15.143 +Would be interesting to build a similar theory for a typed programming language:
  15.144 +    ie.     true :: bool,      fix :: ('a=>'a)=>'a  etc......
  15.145 +
  15.146 +This is starting to look like LCF.
  15.147 +What are the advantages of this approach?   
  15.148 +        - less axiomatic                                            
  15.149 +        - wfd induction / coinduction and fixed point induction available
  15.150 +           
  15.151 +*)
    16.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.2 +++ b/src/CCL/Fix.ML	Thu Sep 16 12:20:38 1993 +0200
    16.3 @@ -0,0 +1,202 @@
    16.4 +(*  Title: 	CCL/fix
    16.5 +    ID:         $Id$
    16.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    16.7 +    Copyright   1993  University of Cambridge
    16.8 +
    16.9 +For fix.thy.
   16.10 +*)
   16.11 +
   16.12 +open Fix;
   16.13 +
   16.14 +val prems = goalw Fix.thy [INCL_def]
   16.15 +     "[| !!x.P(x) <-> Q(x) |] ==> INCL(%x.P(x)) <-> INCL(%x.Q(x))";
   16.16 +by (REPEAT (ares_tac ([refl] @ FOL_congs @ set_congs @ prems) 1));
   16.17 +val INCL_cong = result();
   16.18 +
   16.19 +val fix_congs = [INCL_cong] @ ccl_mk_congs Fix.thy ["napply"];
   16.20 +
   16.21 +(*** Fixed Point Induction ***)
   16.22 +
   16.23 +val [base,step,incl] = goalw Fix.thy [INCL_def]
   16.24 +    "[| P(bot);  !!x.P(x) ==> P(f(x));  INCL(P) |] ==> P(fix(f))";
   16.25 +br (incl RS spec RS mp) 1;
   16.26 +by (rtac (Nat_ind RS ballI) 1 THEN atac 1);
   16.27 +by (ALLGOALS (SIMP_TAC term_ss));
   16.28 +by (REPEAT (ares_tac [base,step] 1));
   16.29 +val fix_ind = result();
   16.30 +
   16.31 +(*** Inclusive Predicates ***)
   16.32 +
   16.33 +val prems = goalw Fix.thy [INCL_def]
   16.34 +     "INCL(P) <-> (ALL f. (ALL n:Nat. P(f ^ n ` bot)) --> P(fix(f)))";
   16.35 +br iff_refl 1;
   16.36 +val inclXH = result();
   16.37 +
   16.38 +val prems = goal Fix.thy
   16.39 +     "[| !!f.ALL n:Nat.P(f^n`bot) ==> P(fix(f)) |] ==> INCL(%x.P(x))";
   16.40 +by (fast_tac (term_cs addIs (prems @ [XH_to_I inclXH])) 1);
   16.41 +val inclI = result();
   16.42 +
   16.43 +val incl::prems = goal Fix.thy
   16.44 +     "[| INCL(P);  !!n.n:Nat ==> P(f^n`bot) |] ==> P(fix(f))";
   16.45 +by (fast_tac (term_cs addIs ([ballI RS (incl RS (XH_to_D inclXH) RS spec RS mp)] 
   16.46 +                       @ prems)) 1);
   16.47 +val inclD = result();
   16.48 +
   16.49 +val incl::prems = goal Fix.thy
   16.50 +     "[| INCL(P);  (ALL n:Nat.P(f^n`bot))-->P(fix(f)) ==> R |] ==> R";
   16.51 +by (fast_tac (term_cs addIs ([incl RS inclD] @ prems)) 1);
   16.52 +val inclE = result();
   16.53 +
   16.54 +val fix_ss = term_ss addcongs fix_congs;
   16.55 +
   16.56 +(*** Lemmas for Inclusive Predicates ***)
   16.57 +
   16.58 +goal Fix.thy "INCL(%x.~ a(x) [= t)";
   16.59 +br inclI 1;
   16.60 +bd bspec 1;
   16.61 +br zeroT 1;
   16.62 +be contrapos 1;
   16.63 +br po_trans 1;
   16.64 +ba 2;
   16.65 +br (napplyBzero RS ssubst) 1;
   16.66 +by (rtac po_cong 1 THEN rtac po_bot 1);
   16.67 +val npo_INCL = result();
   16.68 +
   16.69 +val prems = goal Fix.thy "[| INCL(P);  INCL(Q) |] ==> INCL(%x.P(x) & Q(x))";
   16.70 +by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
   16.71 +val conj_INCL = result();
   16.72 +
   16.73 +val prems = goal Fix.thy "[| !!a.INCL(P(a)) |] ==> INCL(%x.ALL a.P(a,x))";
   16.74 +by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
   16.75 +val all_INCL = result();
   16.76 +
   16.77 +val prems = goal Fix.thy "[| !!a.a:A ==> INCL(P(a)) |] ==> INCL(%x.ALL a:A.P(a,x))";
   16.78 +by (fast_tac (set_cs addSIs ([inclI] @ (prems RL [inclD]))) 1);;
   16.79 +val ball_INCL = result();
   16.80 +
   16.81 +goal Fix.thy "INCL(%x.a(x) = b(x)::'a::prog)";
   16.82 +by (SIMP_TAC (fix_ss addrews [eq_iff]) 1);
   16.83 +by (REPEAT (resolve_tac [conj_INCL,po_INCL] 1));
   16.84 +val eq_INCL = result();
   16.85 +
   16.86 +(*** Derivation of Reachability Condition ***)
   16.87 +
   16.88 +(* Fixed points of idgen *)
   16.89 +
   16.90 +goal Fix.thy "idgen(fix(idgen)) = fix(idgen)";
   16.91 +br (fixB RS sym) 1;
   16.92 +val fix_idgenfp = result();
   16.93 +
   16.94 +goalw Fix.thy [idgen_def] "idgen(lam x.x) = lam x.x";
   16.95 +by (SIMP_TAC term_ss 1);
   16.96 +br (term_case RS allI) 1;
   16.97 +by (ALLGOALS (SIMP_TAC term_ss));
   16.98 +val id_idgenfp = result();
   16.99 +
  16.100 +(* All fixed points are lam-expressions *)
  16.101 +
  16.102 +val [prem] = goal Fix.thy "idgen(d) = d ==> d = lam x.?f(x)";
  16.103 +br (prem RS subst) 1;
  16.104 +bw idgen_def;
  16.105 +br refl 1;
  16.106 +val idgenfp_lam = result();
  16.107 +
  16.108 +(* Lemmas for rewriting fixed points of idgen *)
  16.109 +
  16.110 +val prems = goalw Fix.thy [idgen_def] 
  16.111 +    "[| a = b;  a ` t = u |] ==> b ` t = u";
  16.112 +by (SIMP_TAC (term_ss addrews (prems RL [sym])) 1);
  16.113 +val l_lemma= result();
  16.114 +
  16.115 +val idgen_lemmas =
  16.116 +    let fun mk_thm s = prove_goalw Fix.thy [idgen_def] s
  16.117 +           (fn [prem] => [rtac (prem RS l_lemma) 1,SIMP_TAC term_ss 1])
  16.118 +    in map mk_thm
  16.119 +          [    "idgen(d) = d ==> d ` bot = bot",
  16.120 +               "idgen(d) = d ==> d ` true = true",
  16.121 +               "idgen(d) = d ==> d ` false = false",
  16.122 +               "idgen(d) = d ==> d ` <a,b> = <d ` a,d ` b>",
  16.123 +               "idgen(d) = d ==> d ` (lam x.f(x)) = lam x.d ` f(x)"]
  16.124 +    end;
  16.125 +
  16.126 +(* Proof of Reachability law - show that fix and lam x.x both give LEAST fixed points 
  16.127 +                               of idgen and hence are they same *)
  16.128 +
  16.129 +val [p1,p2,p3] = goal CCL.thy
  16.130 +    "[| ALL x.t ` x [= u ` x;  EX f.t=lam x.f(x);  EX f.u=lam x.f(x) |] ==> t [= u";
  16.131 +br (p2 RS cond_eta RS ssubst) 1;
  16.132 +br (p3 RS cond_eta RS ssubst) 1;
  16.133 +br (p1 RS (po_lam RS iffD2)) 1;
  16.134 +val po_eta = result();
  16.135 +
  16.136 +val [prem] = goalw Fix.thy [idgen_def] "idgen(d) = d ==> d = lam x.?f(x)";
  16.137 +br (prem RS subst) 1;
  16.138 +br refl 1;
  16.139 +val po_eta_lemma = result();
  16.140 +
  16.141 +val [prem] = goal Fix.thy
  16.142 +    "idgen(d) = d ==> \
  16.143 +\      {p.EX a b.p=<a,b> & (EX t.a=fix(idgen) ` t & b = d ` t)} <=   \
  16.144 +\      POgen({p.EX a b.p=<a,b> & (EX t.a=fix(idgen) ` t  & b = d ` t)})";
  16.145 +by (REPEAT (step_tac term_cs 1));
  16.146 +by (term_case_tac "t" 1);
  16.147 +by (ALLGOALS (SIMP_TAC (term_ss addrews (POgenXH::([prem,fix_idgenfp] RL idgen_lemmas)))));
  16.148 +by (ALLGOALS (fast_tac set_cs));
  16.149 +val lemma1 = result();
  16.150 +
  16.151 +val [prem] = goal Fix.thy
  16.152 +    "idgen(d) = d ==> fix(idgen) [= d";
  16.153 +br (allI RS po_eta) 1;
  16.154 +br (lemma1 RSN(2,po_coinduct)) 1;
  16.155 +by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp])));
  16.156 +val fix_least_idgen = result();
  16.157 +
  16.158 +val [prem] = goal Fix.thy
  16.159 +    "idgen(d) = d ==> \
  16.160 +\      {p.EX a b.p=<a,b> & b = d ` a} <= POgen({p.EX a b.p=<a,b> & b = d ` a})";
  16.161 +by (REPEAT (step_tac term_cs 1));
  16.162 +by (term_case_tac "a" 1);
  16.163 +by (ALLGOALS (SIMP_TAC (term_ss addrews (POgenXH::([prem] RL idgen_lemmas)))));
  16.164 +by (ALLGOALS (fast_tac set_cs));
  16.165 +val lemma2 = result();
  16.166 +
  16.167 +val [prem] = goal Fix.thy
  16.168 +    "idgen(d) = d ==> lam x.x [= d";
  16.169 +br (allI RS po_eta) 1;
  16.170 +br (lemma2 RSN(2,po_coinduct)) 1;
  16.171 +by (SIMP_TAC term_ss 1);
  16.172 +by (ALLGOALS (fast_tac (term_cs addIs [prem,po_eta_lemma,fix_idgenfp])));
  16.173 +val id_least_idgen = result();
  16.174 +
  16.175 +goal Fix.thy  "fix(idgen) = lam x.x";
  16.176 +by (fast_tac (term_cs addIs [eq_iff RS iffD2,
  16.177 +                             id_idgenfp RS fix_least_idgen,
  16.178 +                             fix_idgenfp RS id_least_idgen]) 1);
  16.179 +val reachability = result();
  16.180 +
  16.181 +(********)
  16.182 +
  16.183 +val [prem] = goal Fix.thy "f = lam x.x ==> f`t = t";
  16.184 +br (prem RS sym RS subst) 1;
  16.185 +br applyB 1;
  16.186 +val id_apply = result();
  16.187 +
  16.188 +val prems = goal Fix.thy
  16.189 +     "[| P(bot);  P(true);  P(false);  \
  16.190 +\        !!x y.[| P(x);  P(y) |] ==> P(<x,y>);  \
  16.191 +\        !!u.(!!x.P(u(x))) ==> P(lam x.u(x));  INCL(P) |] ==> \
  16.192 +\     P(t)";
  16.193 +br (reachability RS id_apply RS subst) 1;
  16.194 +by (res_inst_tac [("x","t")] spec 1);
  16.195 +br fix_ind 1;
  16.196 +bw idgen_def;
  16.197 +by (REPEAT_SOME (ares_tac [allI]));
  16.198 +br (applyBbot RS ssubst) 1;
  16.199 +brs prems 1;
  16.200 +br (applyB RS ssubst )1;
  16.201 +by (res_inst_tac [("t","xa")] term_case 1);
  16.202 +by (ALLGOALS (SIMP_TAC term_ss));
  16.203 +by (ALLGOALS (fast_tac (term_cs addIs ([all_INCL,INCL_subst] @ prems))));
  16.204 +val term_ind = result();
  16.205 +
    17.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    17.2 +++ b/src/CCL/Fix.thy	Thu Sep 16 12:20:38 1993 +0200
    17.3 @@ -0,0 +1,26 @@
    17.4 +(*  Title: 	CCL/Lazy/fix.thy
    17.5 +    ID:         $Id$
    17.6 +    Author: 	Martin Coen
    17.7 +    Copyright   1993  University of Cambridge
    17.8 +
    17.9 +Tentative attempt at including fixed point induction.
   17.10 +Justified by Smith.
   17.11 +*)
   17.12 +
   17.13 +Fix = Type + 
   17.14 +
   17.15 +consts
   17.16 +
   17.17 +  idgen      ::	      "[i]=>i"
   17.18 +  INCL      :: "[i=>o]=>o"
   17.19 +
   17.20 +rules
   17.21 +
   17.22 +  idgen_def
   17.23 +  "idgen(f) == lam t.case(t,true,false,%x y.<f`x, f`y>,%u.lam x.f ` u(x))"
   17.24 +
   17.25 +  INCL_def   "INCL(%x.P(x)) == (ALL f.(ALL n:Nat.P(f^n`bot)) --> P(fix(f)))"
   17.26 +  po_INCL    "INCL(%x.a(x) [= b(x))"
   17.27 +  INCL_subst "INCL(P) ==> INCL(%x.P((g::i=>i)(x)))"
   17.28 +
   17.29 +end
    18.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.2 +++ b/src/CCL/Gfp.ML	Thu Sep 16 12:20:38 1993 +0200
    18.3 @@ -0,0 +1,133 @@
    18.4 +(*  Title: 	CCL/gfp
    18.5 +    ID:         $Id$
    18.6 +
    18.7 +Modified version of
    18.8 +    Title: 	HOL/gfp
    18.9 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
   18.10 +    Copyright   1993  University of Cambridge
   18.11 +
   18.12 +For gfp.thy.  The Knaster-Tarski Theorem for greatest fixed points.
   18.13 +*)
   18.14 +
   18.15 +open Gfp;
   18.16 +
   18.17 +(*** Proof of Knaster-Tarski Theorem using gfp ***)
   18.18 +
   18.19 +(* gfp(f) is the least upper bound of {u. u <= f(u)} *)
   18.20 +
   18.21 +val prems = goalw Gfp.thy [gfp_def] "[| A <= f(A) |] ==> A <= gfp(f)";
   18.22 +by (rtac (CollectI RS Union_upper) 1);
   18.23 +by (resolve_tac prems 1);
   18.24 +val gfp_upperbound = result();
   18.25 +
   18.26 +val prems = goalw Gfp.thy [gfp_def]
   18.27 +    "[| !!u. u <= f(u) ==> u<=A |] ==> gfp(f) <= A";
   18.28 +by (REPEAT (ares_tac ([Union_least]@prems) 1));
   18.29 +by (etac CollectD 1);
   18.30 +val gfp_least = result();
   18.31 +
   18.32 +val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) <= f(gfp(f))";
   18.33 +by (EVERY1 [rtac gfp_least, rtac subset_trans, atac,
   18.34 +	    rtac (mono RS monoD), rtac gfp_upperbound, atac]);
   18.35 +val gfp_lemma2 = result();
   18.36 +
   18.37 +val [mono] = goal Gfp.thy "mono(f) ==> f(gfp(f)) <= gfp(f)";
   18.38 +by (EVERY1 [rtac gfp_upperbound, rtac (mono RS monoD), 
   18.39 +	    rtac gfp_lemma2, rtac mono]);
   18.40 +val gfp_lemma3 = result();
   18.41 +
   18.42 +val [mono] = goal Gfp.thy "mono(f) ==> gfp(f) = f(gfp(f))";
   18.43 +by (REPEAT (resolve_tac [equalityI,gfp_lemma2,gfp_lemma3,mono] 1));
   18.44 +val gfp_Tarski = result();
   18.45 +
   18.46 +(*** Coinduction rules for greatest fixed points ***)
   18.47 +
   18.48 +(*weak version*)
   18.49 +val prems = goal Gfp.thy
   18.50 +    "[| a: A;  A <= f(A) |] ==> a : gfp(f)";
   18.51 +by (rtac (gfp_upperbound RS subsetD) 1);
   18.52 +by (REPEAT (ares_tac prems 1));
   18.53 +val coinduct = result();
   18.54 +
   18.55 +val [prem,mono] = goal Gfp.thy
   18.56 +    "[| A <= f(A) Un gfp(f);  mono(f) |] ==>  \
   18.57 +\    A Un gfp(f) <= f(A Un gfp(f))";
   18.58 +by (rtac subset_trans 1);
   18.59 +by (rtac (mono RS mono_Un) 2);
   18.60 +by (rtac (mono RS gfp_Tarski RS subst) 1);
   18.61 +by (rtac (prem RS Un_least) 1);
   18.62 +by (rtac Un_upper2 1);
   18.63 +val coinduct2_lemma = result();
   18.64 +
   18.65 +(*strong version, thanks to Martin Coen*)
   18.66 +val prems = goal Gfp.thy
   18.67 +    "[| a: A;  A <= f(A) Un gfp(f);  mono(f) |] ==> a : gfp(f)";
   18.68 +by (rtac (coinduct2_lemma RSN (2,coinduct)) 1);
   18.69 +by (REPEAT (resolve_tac (prems@[UnI1]) 1));
   18.70 +val coinduct2 = result();
   18.71 +
   18.72 +(***  Even Stronger version of coinduct  [by Martin Coen]
   18.73 +         - instead of the condition  A <= f(A)
   18.74 +                           consider  A <= (f(A) Un f(f(A)) ...) Un gfp(A) ***)
   18.75 +
   18.76 +val [prem] = goal Gfp.thy "mono(f) ==> mono(%x.f(x) Un A Un B)";
   18.77 +by (REPEAT (ares_tac [subset_refl, monoI, Un_mono, prem RS monoD] 1));
   18.78 +val coinduct3_mono_lemma= result();
   18.79 +
   18.80 +val [prem,mono] = goal Gfp.thy
   18.81 +    "[| A <= f(lfp(%x.f(x) Un A Un gfp(f)));  mono(f) |] ==> \
   18.82 +\    lfp(%x.f(x) Un A Un gfp(f)) <= f(lfp(%x.f(x) Un A Un gfp(f)))";
   18.83 +by (rtac subset_trans 1);
   18.84 +br (mono RS coinduct3_mono_lemma RS lfp_lemma3) 1;
   18.85 +by (rtac (Un_least RS Un_least) 1);
   18.86 +br subset_refl 1;
   18.87 +br prem 1;
   18.88 +br (mono RS gfp_Tarski RS equalityD1 RS subset_trans) 1;
   18.89 +by (rtac (mono RS monoD) 1);
   18.90 +by (rtac (mono RS coinduct3_mono_lemma RS lfp_Tarski RS ssubst) 1);
   18.91 +by (rtac Un_upper2 1);
   18.92 +val coinduct3_lemma = result();
   18.93 +
   18.94 +val prems = goal Gfp.thy
   18.95 +    "[| a:A;  A <= f(lfp(%x.f(x) Un A Un gfp(f))); mono(f) |] ==> a : gfp(f)";
   18.96 +by (rtac (coinduct3_lemma RSN (2,coinduct)) 1);
   18.97 +brs (prems RL [coinduct3_mono_lemma RS lfp_Tarski RS ssubst]) 1;
   18.98 +br (UnI2 RS UnI1) 1;
   18.99 +by (REPEAT (resolve_tac prems 1));
  18.100 +val coinduct3 = result();
  18.101 +
  18.102 +
  18.103 +(** Definition forms of gfp_Tarski, to control unfolding **)
  18.104 +
  18.105 +val [rew,mono] = goal Gfp.thy "[| h==gfp(f);  mono(f) |] ==> h = f(h)";
  18.106 +by (rewtac rew);
  18.107 +by (rtac (mono RS gfp_Tarski) 1);
  18.108 +val def_gfp_Tarski = result();
  18.109 +
  18.110 +val rew::prems = goal Gfp.thy
  18.111 +    "[| h==gfp(f);  a:A;  A <= f(A) |] ==> a: h";
  18.112 +by (rewtac rew);
  18.113 +by (REPEAT (ares_tac (prems @ [coinduct]) 1));
  18.114 +val def_coinduct = result();
  18.115 +
  18.116 +val rew::prems = goal Gfp.thy
  18.117 +    "[| h==gfp(f);  a:A;  A <= f(A) Un h; mono(f) |] ==> a: h";
  18.118 +by (rewtac rew);
  18.119 +by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct2]) 1));
  18.120 +val def_coinduct2 = result();
  18.121 +
  18.122 +val rew::prems = goal Gfp.thy
  18.123 +    "[| h==gfp(f);  a:A;  A <= f(lfp(%x.f(x) Un A Un h)); mono(f) |] ==> a: h";
  18.124 +by (rewtac rew);
  18.125 +by (REPEAT (ares_tac (map (rewrite_rule [rew]) prems @ [coinduct3]) 1));
  18.126 +val def_coinduct3 = result();
  18.127 +
  18.128 +(*Monotonicity of gfp!*)
  18.129 +val prems = goal Gfp.thy
  18.130 +    "[| mono(f);  !!Z. f(Z)<=g(Z) |] ==> gfp(f) <= gfp(g)";
  18.131 +by (rtac gfp_upperbound 1);
  18.132 +by (rtac subset_trans 1);
  18.133 +by (rtac gfp_lemma2 1);
  18.134 +by (resolve_tac prems 1);
  18.135 +by (resolve_tac prems 1);
  18.136 +val gfp_mono = result();
    19.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.2 +++ b/src/CCL/Gfp.thy	Thu Sep 16 12:20:38 1993 +0200
    19.3 @@ -0,0 +1,14 @@
    19.4 +(*  Title: 	HOL/gfp.thy
    19.5 +    ID:         $Id$
    19.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    19.7 +    Copyright   1992  University of Cambridge
    19.8 +
    19.9 +Greatest fixed points
   19.10 +*)
   19.11 +
   19.12 +Gfp = Lfp +
   19.13 +consts gfp :: "['a set=>'a set] => 'a set"
   19.14 +rules
   19.15 + (*greatest fixed point*)
   19.16 + gfp_def "gfp(f) == Union({u. u <= f(u)})"
   19.17 +end
    20.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.2 +++ b/src/CCL/Hered.ML	Thu Sep 16 12:20:38 1993 +0200
    20.3 @@ -0,0 +1,196 @@
    20.4 +(*  Title: 	CCL/hered
    20.5 +    ID:         $Id$
    20.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    20.7 +    Copyright   1993  University of Cambridge
    20.8 +
    20.9 +For hered.thy.
   20.10 +*)
   20.11 +
   20.12 +open Hered;
   20.13 +
   20.14 +fun type_of_terms (Const("Trueprop",_) $ (Const("op =",(Type ("fun", [t,_])))$_$_)) = t;
   20.15 +
   20.16 +val cong_rls = ccl_mk_congs Hered.thy  ["HTTgen"];
   20.17 +
   20.18 +(*** Hereditary Termination ***)
   20.19 +
   20.20 +goalw Hered.thy [HTTgen_def]  "mono(%X.HTTgen(X))";
   20.21 +br monoI 1;
   20.22 +by (fast_tac set_cs 1);
   20.23 +val HTTgen_mono = result();
   20.24 +
   20.25 +goalw Hered.thy [HTTgen_def]
   20.26 +  "t : HTTgen(A) <-> t=true | t=false | (EX a b.t=<a,b> & a : A & b : A) | \
   20.27 +\                                       (EX f.t=lam x.f(x) & (ALL x.f(x) : A))";
   20.28 +by (fast_tac set_cs 1);
   20.29 +val HTTgenXH = result();
   20.30 +
   20.31 +goal Hered.thy
   20.32 +  "t : HTT <-> t=true | t=false | (EX a b.t=<a,b> & a : HTT & b : HTT) | \
   20.33 +\                                  (EX f.t=lam x.f(x) & (ALL x.f(x) : HTT))";
   20.34 +br (rewrite_rule [HTTgen_def] 
   20.35 +                 (HTTgen_mono RS (HTT_def RS def_gfp_Tarski) RS XHlemma1)) 1;
   20.36 +by (fast_tac set_cs 1);
   20.37 +val HTTXH = result();
   20.38 +
   20.39 +(*** Introduction Rules for HTT ***)
   20.40 +
   20.41 +goal Hered.thy "~ bot : HTT";
   20.42 +by (fast_tac (term_cs addDs [XH_to_D HTTXH]) 1);
   20.43 +val HTT_bot = result();
   20.44 +
   20.45 +goal Hered.thy "true : HTT";
   20.46 +by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1);
   20.47 +val HTT_true = result();
   20.48 +
   20.49 +goal Hered.thy "false : HTT";
   20.50 +by (fast_tac (term_cs addIs [XH_to_I HTTXH]) 1);
   20.51 +val HTT_false = result();
   20.52 +
   20.53 +goal Hered.thy "<a,b> : HTT <->  a : HTT  & b : HTT";
   20.54 +br (HTTXH RS iff_trans) 1;
   20.55 +by (fast_tac term_cs 1);
   20.56 +val HTT_pair = result();
   20.57 +
   20.58 +goal Hered.thy "lam x.f(x) : HTT <-> (ALL x. f(x) : HTT)";
   20.59 +br (HTTXH RS iff_trans) 1;
   20.60 +by (SIMP_TAC term_ss 1);
   20.61 +by (safe_tac term_cs);
   20.62 +by (ASM_SIMP_TAC term_ss 1);
   20.63 +by (fast_tac term_cs 1);
   20.64 +val HTT_lam = result();
   20.65 +
   20.66 +local
   20.67 +  val raw_HTTrews = [HTT_bot,HTT_true,HTT_false,HTT_pair,HTT_lam];
   20.68 +  fun mk_thm s = prove_goalw Hered.thy data_defs s (fn _ => 
   20.69 +                  [SIMP_TAC (term_ss addrews raw_HTTrews) 1]);
   20.70 +in
   20.71 +  val HTT_rews = raw_HTTrews @
   20.72 +               map mk_thm ["one : HTT",
   20.73 +                           "inl(a) : HTT <-> a : HTT",
   20.74 +                           "inr(b) : HTT <-> b : HTT",
   20.75 +                           "zero : HTT",
   20.76 +                           "succ(n) : HTT <-> n : HTT",
   20.77 +                           "[] : HTT",
   20.78 +                           "x.xs : HTT <-> x : HTT & xs : HTT"];
   20.79 +end;
   20.80 +
   20.81 +val HTT_Is = HTT_rews @ (HTT_rews RL [iffD2]);
   20.82 +
   20.83 +(*** Coinduction for HTT ***)
   20.84 +
   20.85 +val prems = goal Hered.thy "[|  t : R;  R <= HTTgen(R) |] ==> t : HTT";
   20.86 +br (HTT_def RS def_coinduct) 1;
   20.87 +by (REPEAT (ares_tac prems 1));
   20.88 +val HTT_coinduct = result();
   20.89 +
   20.90 +fun HTT_coinduct_tac s i = res_inst_tac [("R",s)] HTT_coinduct i;
   20.91 +
   20.92 +val prems = goal Hered.thy 
   20.93 +    "[|  t : R;   R <= HTTgen(lfp(%x. HTTgen(x) Un R Un HTT)) |] ==> t : HTT";
   20.94 +br (HTTgen_mono RSN(3,HTT_def RS def_coinduct3)) 1;
   20.95 +by (REPEAT (ares_tac prems 1));
   20.96 +val HTT_coinduct3 = result();
   20.97 +val HTT_coinduct3_raw = rewrite_rule [HTTgen_def] HTT_coinduct3;
   20.98 +
   20.99 +fun HTT_coinduct3_tac s i = res_inst_tac [("R",s)] HTT_coinduct3 i;
  20.100 +
  20.101 +val HTTgenIs = map (mk_genIs Hered.thy data_defs HTTgenXH HTTgen_mono)
  20.102 +       ["true : HTTgen(R)",
  20.103 +        "false : HTTgen(R)",
  20.104 +        "[| a : R;  b : R |] ==> <a,b> : HTTgen(R)",
  20.105 +        "[| !!x. b(x) : R |] ==> lam x.b(x) : HTTgen(R)",
  20.106 +        "one : HTTgen(R)",
  20.107 +        "a : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
  20.108 +\                         inl(a) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
  20.109 +        "b : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
  20.110 +\                         inr(b) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
  20.111 +        "zero : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
  20.112 +        "n : lfp(%x. HTTgen(x) Un R Un HTT) ==> \
  20.113 +\                         succ(n) : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
  20.114 +        "[] : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))",
  20.115 +        "[| h : lfp(%x. HTTgen(x) Un R Un HTT); t : lfp(%x. HTTgen(x) Un R Un HTT) |] ==>\
  20.116 +\                         h.t : HTTgen(lfp(%x. HTTgen(x) Un R Un HTT))"];
  20.117 +
  20.118 +(*** Formation Rules for Types ***)
  20.119 +
  20.120 +goal Hered.thy "Unit <= HTT";
  20.121 +by (SIMP_TAC (CCL_ss addrews ([subsetXH,UnitXH] @ HTT_rews)) 1);
  20.122 +val UnitF = result();
  20.123 +
  20.124 +goal Hered.thy "Bool <= HTT";
  20.125 +by (SIMP_TAC (CCL_ss addrews ([subsetXH,BoolXH] @ HTT_rews)) 1);
  20.126 +by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
  20.127 +val BoolF = result();
  20.128 +
  20.129 +val prems = goal Hered.thy "[| A <= HTT;  B <= HTT |] ==> A + B  <= HTT";
  20.130 +by (SIMP_TAC (CCL_ss addrews ([subsetXH,PlusXH] @ HTT_rews)) 1);
  20.131 +by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
  20.132 +val PlusF = result();
  20.133 +
  20.134 +val prems = goal Hered.thy 
  20.135 +     "[| A <= HTT;  !!x.x:A ==> B(x) <= HTT |] ==> SUM x:A.B(x) <= HTT";
  20.136 +by (SIMP_TAC (CCL_ss addrews ([subsetXH,SgXH] @ HTT_rews)) 1);
  20.137 +by (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD])) 1);
  20.138 +val SigmaF = result();
  20.139 +
  20.140 +(*** Formation Rules for Recursive types - using coinduction these only need ***)
  20.141 +(***                                          exhaution rule for type-former ***)
  20.142 +
  20.143 +(*Proof by induction - needs induction rule for type*)
  20.144 +goal Hered.thy "Nat <= HTT";
  20.145 +by (SIMP_TAC (term_ss addrews [subsetXH]) 1);
  20.146 +by (safe_tac set_cs);
  20.147 +be Nat_ind 1;
  20.148 +by (ALLGOALS (fast_tac (set_cs addIs HTT_Is @ (prems RL [subsetD]))));
  20.149 +val NatF = result();
  20.150 +
  20.151 +goal Hered.thy "Nat <= HTT";
  20.152 +by (safe_tac set_cs);
  20.153 +be HTT_coinduct3 1;
  20.154 +by (fast_tac (set_cs addIs HTTgenIs 
  20.155 +                 addSEs [HTTgen_mono RS ci3_RI] addEs [XH_to_E NatXH]) 1);
  20.156 +val NatF = result();
  20.157 +
  20.158 +val [prem] = goal Hered.thy "A <= HTT ==> List(A) <= HTT";
  20.159 +by (safe_tac set_cs);
  20.160 +be HTT_coinduct3 1;
  20.161 +by (fast_tac (set_cs addSIs HTTgenIs 
  20.162 +                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
  20.163 +                 addEs [XH_to_E ListXH]) 1);
  20.164 +val ListF = result();
  20.165 +
  20.166 +val [prem] = goal Hered.thy "A <= HTT ==> Lists(A) <= HTT";
  20.167 +by (safe_tac set_cs);
  20.168 +be HTT_coinduct3 1;
  20.169 +by (fast_tac (set_cs addSIs HTTgenIs 
  20.170 +                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
  20.171 +                 addEs [XH_to_E ListsXH]) 1);
  20.172 +val ListsF = result();
  20.173 +
  20.174 +val [prem] = goal Hered.thy "A <= HTT ==> ILists(A) <= HTT";
  20.175 +by (safe_tac set_cs);
  20.176 +be HTT_coinduct3 1;
  20.177 +by (fast_tac (set_cs addSIs HTTgenIs 
  20.178 +                 addSEs [HTTgen_mono RS ci3_RI,prem RS subsetD RS (HTTgen_mono RS ci3_AI)] 
  20.179 +                 addEs [XH_to_E IListsXH]) 1);
  20.180 +val IListsF = result();
  20.181 +
  20.182 +(*** A possible use for this predicate is proving equality from pre-order       ***)
  20.183 +(*** but it seems as easy (and more general) to do this directly by coinduction ***)
  20.184 +(*
  20.185 +val prems = goal Hered.thy "[| t : HTT;  t [= u |] ==> u [= t";
  20.186 +by (po_coinduct_tac "{p. EX a b.p=<a,b> & b : HTT & b [= a}" 1);
  20.187 +by (fast_tac (ccl_cs addIs prems) 1);
  20.188 +by (safe_tac ccl_cs);
  20.189 +bd (poXH RS iffD1) 1;
  20.190 +by (safe_tac (set_cs addSEs [HTT_bot RS notE]));
  20.191 +by (REPEAT_SOME (rtac (POgenXH RS iffD2) ORELSE' etac rev_mp));
  20.192 +by (ALLGOALS (SIMP_TAC (term_ss addrews HTT_rews)));
  20.193 +by (ALLGOALS (fast_tac ccl_cs));
  20.194 +val HTT_po_op = result();
  20.195 +
  20.196 +val prems = goal Hered.thy "[| t : HTT;  t [= u |] ==> t = u";
  20.197 +by (REPEAT (ares_tac (prems @ [conjI RS (eq_iff RS iffD2),HTT_po_op]) 1));
  20.198 +val HTT_po_eq = result();
  20.199 +*)
    21.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.2 +++ b/src/CCL/Hered.thy	Thu Sep 16 12:20:38 1993 +0200
    21.3 @@ -0,0 +1,30 @@
    21.4 +(*  Title: 	CCL/hered.thy
    21.5 +    ID:         $Id$
    21.6 +    Author: 	Martin Coen
    21.7 +    Copyright   1993  University of Cambridge
    21.8 +
    21.9 +Hereditary Termination - cf. Martin Lo\"f
   21.10 +
   21.11 +Note that this is based on an untyped equality and so lam x.b(x) is only 
   21.12 +hereditarily terminating if ALL x.b(x) is.  Not so useful for functions!
   21.13 +
   21.14 +*)
   21.15 +
   21.16 +Hered = Type +
   21.17 +
   21.18 +consts
   21.19 +      (*** Predicates ***)
   21.20 +  HTTgen     ::       "i set => i set"
   21.21 +  HTT        ::       "i set"
   21.22 +
   21.23 +
   21.24 +rules
   21.25 +
   21.26 +  (*** Definitions of Hereditary Termination ***)
   21.27 +
   21.28 +  HTTgen_def 
   21.29 +  "HTTgen(R) == {t. t=true | t=false | (EX a b.t=<a,b>      & a : R & b : R) | \
   21.30 +\                                      (EX f.  t=lam x.f(x) & (ALL x.f(x) : R))}"
   21.31 +  HTT_def       "HTT == gfp(HTTgen)"
   21.32 +
   21.33 +end
    22.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.2 +++ b/src/CCL/Lfp.ML	Thu Sep 16 12:20:38 1993 +0200
    22.3 @@ -0,0 +1,82 @@
    22.4 +(*  Title: 	CCL/lfp
    22.5 +    ID:         $Id$
    22.6 +
    22.7 +Modified version of
    22.8 +    Title: 	HOL/lfp.ML
    22.9 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
   22.10 +    Copyright   1992  University of Cambridge
   22.11 +
   22.12 +For lfp.thy.  The Knaster-Tarski Theorem
   22.13 +*)
   22.14 +
   22.15 +open Lfp;
   22.16 +
   22.17 +(*** Proof of Knaster-Tarski Theorem ***)
   22.18 +
   22.19 +(* lfp(f) is the greatest lower bound of {u. f(u) <= u} *)
   22.20 +
   22.21 +val prems = goalw Lfp.thy [lfp_def] "[| f(A) <= A |] ==> lfp(f) <= A";
   22.22 +by (rtac (CollectI RS Inter_lower) 1);
   22.23 +by (resolve_tac prems 1);
   22.24 +val lfp_lowerbound = result();
   22.25 +
   22.26 +val prems = goalw Lfp.thy [lfp_def]
   22.27 +    "[| !!u. f(u) <= u ==> A<=u |] ==> A <= lfp(f)";
   22.28 +by (REPEAT (ares_tac ([Inter_greatest]@prems) 1));
   22.29 +by (etac CollectD 1);
   22.30 +val lfp_greatest = result();
   22.31 +
   22.32 +val [mono] = goal Lfp.thy "mono(f) ==> f(lfp(f)) <= lfp(f)";
   22.33 +by (EVERY1 [rtac lfp_greatest, rtac subset_trans,
   22.34 +	    rtac (mono RS monoD), rtac lfp_lowerbound, atac, atac]);
   22.35 +val lfp_lemma2 = result();
   22.36 +
   22.37 +val [mono] = goal Lfp.thy "mono(f) ==> lfp(f) <= f(lfp(f))";
   22.38 +by (EVERY1 [rtac lfp_lowerbound, rtac (mono RS monoD), 
   22.39 +	    rtac lfp_lemma2, rtac mono]);
   22.40 +val lfp_lemma3 = result();
   22.41 +
   22.42 +val [mono] = goal Lfp.thy "mono(f) ==> lfp(f) = f(lfp(f))";
   22.43 +by (REPEAT (resolve_tac [equalityI,lfp_lemma2,lfp_lemma3,mono] 1));
   22.44 +val lfp_Tarski = result();
   22.45 +
   22.46 +
   22.47 +(*** General induction rule for least fixed points ***)
   22.48 +
   22.49 +val [lfp,mono,indhyp] = goal Lfp.thy
   22.50 +    "[| a: lfp(f);  mono(f);  				\
   22.51 +\       !!x. [| x: f(lfp(f) Int {x.P(x)}) |] ==> P(x) 	\
   22.52 +\    |] ==> P(a)";
   22.53 +by (res_inst_tac [("a","a")] (Int_lower2 RS subsetD RS CollectD) 1);
   22.54 +by (rtac (lfp RSN (2, lfp_lowerbound RS subsetD)) 1);
   22.55 +by (EVERY1 [rtac Int_greatest, rtac subset_trans, 
   22.56 +	    rtac (Int_lower1 RS (mono RS monoD)),
   22.57 +	    rtac (mono RS lfp_lemma2),
   22.58 +	    rtac (CollectI RS subsetI), rtac indhyp, atac]);
   22.59 +val induct = result();
   22.60 +
   22.61 +(** Definition forms of lfp_Tarski and induct, to control unfolding **)
   22.62 +
   22.63 +val [rew,mono] = goal Lfp.thy "[| h==lfp(f);  mono(f) |] ==> h = f(h)";
   22.64 +by (rewtac rew);
   22.65 +by (rtac (mono RS lfp_Tarski) 1);
   22.66 +val def_lfp_Tarski = result();
   22.67 +
   22.68 +val rew::prems = goal Lfp.thy
   22.69 +    "[| A == lfp(f);  a:A;  mono(f);   			\
   22.70 +\       !!x. [| x: f(A Int {x.P(x)}) |] ==> P(x) 	\
   22.71 +\    |] ==> P(a)";
   22.72 +by (EVERY1 [rtac induct,	(*backtracking to force correct induction*)
   22.73 +	    REPEAT1 o (ares_tac (map (rewrite_rule [rew]) prems))]);
   22.74 +val def_induct = result();
   22.75 +
   22.76 +(*Monotonicity of lfp!*)
   22.77 +val prems = goal Lfp.thy
   22.78 +    "[| mono(g);  !!Z. f(Z)<=g(Z) |] ==> lfp(f) <= lfp(g)";
   22.79 +by (rtac lfp_lowerbound 1);
   22.80 +by (rtac subset_trans 1);
   22.81 +by (resolve_tac prems 1);
   22.82 +by (rtac lfp_lemma2 1);
   22.83 +by (resolve_tac prems 1);
   22.84 +val lfp_mono = result();
   22.85 +
    23.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.2 +++ b/src/CCL/Lfp.thy	Thu Sep 16 12:20:38 1993 +0200
    23.3 @@ -0,0 +1,14 @@
    23.4 +(*  Title: 	HOL/lfp.thy
    23.5 +    ID:         $Id$
    23.6 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
    23.7 +    Copyright   1992  University of Cambridge
    23.8 +
    23.9 +The Knaster-Tarski Theorem
   23.10 +*)
   23.11 +
   23.12 +Lfp = Set +
   23.13 +consts lfp :: "['a set=>'a set] => 'a set"
   23.14 +rules
   23.15 + (*least fixed point*)
   23.16 + lfp_def "lfp(f) == Inter({u. f(u) <= u})"
   23.17 +end
    24.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.2 +++ b/src/CCL/Makefile	Thu Sep 16 12:20:38 1993 +0200
    24.3 @@ -0,0 +1,48 @@
    24.4 +#########################################################################
    24.5 +#									#
    24.6 +# 			Makefile for Isabelle (CCL)			#
    24.7 +#									#
    24.8 +#########################################################################
    24.9 +
   24.10 +#To make the system, cd to this directory and type
   24.11 +#	make -f Makefile 
   24.12 +#To make the system and test it on standard examples, type 
   24.13 +#	make -f Makefile test
   24.14 +
   24.15 +#Environment variable ISABELLECOMP specifies the compiler.
   24.16 +#Environment variable ISABELLEBIN specifies the destination directory.
   24.17 +#For Poly/ML, ISABELLEBIN must begin with a /
   24.18 +
   24.19 +#Makes FOL if this file is ABSENT -- but not 
   24.20 +#if it is out of date, since this Makefile does not know its dependencies!
   24.21 +
   24.22 +BIN = $(ISABELLEBIN)
   24.23 +COMP = $(ISABELLECOMP)
   24.24 +
   24.25 +SET_FILES = ROOT.ML set.thy set.ML subset.ML equalities.ML mono.ML \
   24.26 +	    gfp.thy gfp.ML lfp.thy lfp.ML
   24.27 +
   24.28 +CCL_FILES = ccl.thy ccl.ML terms.thy terms.ML types.thy types.ML \
   24.29 +            coinduction.ML hered.thy hered.ML trancl.thy trancl.ML\
   24.30 +            wf.thy wf.ML genrec.ML typecheck.ML eval.ML fix.thy fix.ML
   24.31 +
   24.32 +#Uses cp rather than make_database because Poly/ML allows only 3 levels
   24.33 +$(BIN)/CCL:   $(BIN)/FOL  $(SET_FILES)  $(CCL_FILES) 
   24.34 +	case "$(COMP)" in \
   24.35 +	poly*)	cp $(BIN)/FOL $(BIN)/CCL;\
   24.36 +		echo 'open PolyML; use"ROOT";' | $(COMP) $(BIN)/CCL ;;\
   24.37 +	sml*)	echo 'use"ROOT.ML"; xML"$(BIN)/CCL" banner;' | $(BIN)/FOL;;\
   24.38 +	*)	echo Bad value for ISABELLECOMP;;\
   24.39 +	esac
   24.40 +
   24.41 +$(BIN)/FOL:
   24.42 +	cd ../FOL;  $(MAKE)
   24.43 +
   24.44 +test:   ex/ROOT.ML  $(BIN)/CCL
   24.45 +	case "$(COMP)" in \
   24.46 +	poly*)	echo 'use"ex/ROOT.ML"; quit();' | $(COMP) $(BIN)/CCL ;;\
   24.47 +	sml*)	echo 'use"ex/ROOT.ML";' | $(BIN)/CCL;;\
   24.48 +	*)	echo Bad value for ISABELLECOMP;;\
   24.49 +	esac
   24.50 +
   24.51 +.PRECIOUS:  $(BIN)/FOL $(BIN)/CCL 
    25.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    25.2 +++ b/src/CCL/ROOT.ML	Thu Sep 16 12:20:38 1993 +0200
    25.3 @@ -0,0 +1,37 @@
    25.4 +(*  Title:      CCL/ROOT
    25.5 +    ID:         $Id$
    25.6 +    Author:     Martin Coen, Cambridge University Computer Laboratory
    25.7 +    Copyright   1993  University of Cambridge
    25.8 +
    25.9 +Adds Classical Computational Logic to a database containing First-Order Logic.
   25.10 +*)
   25.11 +
   25.12 +val banner = "Classical Computational Logic (in FOL)";
   25.13 +
   25.14 +(* Higher-Order Set Theory Extension to FOL *)
   25.15 +(*      used as basis for CCL               *)
   25.16 +
   25.17 +use_thy "set";
   25.18 +use     "subset.ML";
   25.19 +use     "equalities.ML";
   25.20 +use     "mono.ML";
   25.21 +use_thy "lfp";
   25.22 +use_thy "gfp";
   25.23 +
   25.24 +(* CCL - a computational logic for an untyped functional language *)
   25.25 +(*                       with evaluation to weak head-normal form *)
   25.26 +
   25.27 +use_thy "ccl";
   25.28 +use_thy "terms";
   25.29 +use_thy "types";
   25.30 +use     "coinduction.ML";
   25.31 +use_thy "hered";
   25.32 +
   25.33 +use_thy "trancl";
   25.34 +use_thy "wf";
   25.35 +use     "genrec.ML";
   25.36 +use     "typecheck.ML";
   25.37 +use     "eval.ML";
   25.38 +use_thy "fix";
   25.39 +
   25.40 +val CCL_build_completed = ();   (*indicate successful build*)
    26.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.2 +++ b/src/CCL/Set.ML	Thu Sep 16 12:20:38 1993 +0200
    26.3 @@ -0,0 +1,355 @@
    26.4 +(*  Title: 	set/set
    26.5 +    ID:         $Id$
    26.6 +
    26.7 +For set.thy.
    26.8 +
    26.9 +Modified version of
   26.10 +    Title: 	HOL/set
   26.11 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
   26.12 +    Copyright   1991  University of Cambridge
   26.13 +
   26.14 +For set.thy.  Set theory for higher-order logic.  A set is simply a predicate.
   26.15 +*)
   26.16 +
   26.17 +open Set;
   26.18 +
   26.19 +val [prem] = goal Set.thy "[| P(a) |] ==> a : {x.P(x)}";
   26.20 +by (rtac (mem_Collect_iff RS iffD2) 1);
   26.21 +by (rtac prem 1);
   26.22 +val CollectI = result();
   26.23 +
   26.24 +val prems = goal Set.thy "[| a : {x.P(x)} |] ==> P(a)";
   26.25 +by (resolve_tac (prems RL [mem_Collect_iff  RS iffD1]) 1);
   26.26 +val CollectD = result();
   26.27 +
   26.28 +val [prem] = goal Set.thy "[| !!x. x:A <-> x:B |] ==> A = B";
   26.29 +by (rtac (set_extension RS iffD2) 1);
   26.30 +by (rtac (prem RS allI) 1);
   26.31 +val set_ext = result();
   26.32 +
   26.33 +val prems = goal Set.thy "[| !!x. P(x) <-> Q(x) |] ==> {x. P(x)} = {x. Q(x)}";
   26.34 +by (REPEAT (ares_tac [set_ext,iffI,CollectI] 1 ORELSE
   26.35 +            eresolve_tac ([CollectD] RL (prems RL [iffD1,iffD2])) 1));
   26.36 +val Collect_cong = result();
   26.37 +
   26.38 +val CollectE = make_elim CollectD;
   26.39 +
   26.40 +(*** Bounded quantifiers ***)
   26.41 +
   26.42 +val prems = goalw Set.thy [Ball_def]
   26.43 +    "[| !!x. x:A ==> P(x) |] ==> ALL x:A. P(x)";
   26.44 +by (REPEAT (ares_tac (prems @ [allI,impI]) 1));
   26.45 +val ballI = result();
   26.46 +
   26.47 +val [major,minor] = goalw Set.thy [Ball_def]
   26.48 +    "[| ALL x:A. P(x);  x:A |] ==> P(x)";
   26.49 +by (rtac (minor RS (major RS spec RS mp)) 1);
   26.50 +val bspec = result();
   26.51 +
   26.52 +val major::prems = goalw Set.thy [Ball_def]
   26.53 +    "[| ALL x:A. P(x);  P(x) ==> Q;  ~ x:A ==> Q |] ==> Q";
   26.54 +by (rtac (major RS spec RS impCE) 1);
   26.55 +by (REPEAT (eresolve_tac prems 1));
   26.56 +val ballE = result();
   26.57 +
   26.58 +(*Takes assumptions ALL x:A.P(x) and a:A; creates assumption P(a)*)
   26.59 +fun ball_tac i = etac ballE i THEN contr_tac (i+1);
   26.60 +
   26.61 +val prems = goalw Set.thy [Bex_def]
   26.62 +    "[| P(x);  x:A |] ==> EX x:A. P(x)";
   26.63 +by (REPEAT (ares_tac (prems @ [exI,conjI]) 1));
   26.64 +val bexI = result();
   26.65 +
   26.66 +val bexCI = prove_goal Set.thy 
   26.67 +   "[| EX x:A. ~P(x) ==> P(a);  a:A |] ==> EX x:A.P(x)"
   26.68 + (fn prems=>
   26.69 +  [ (rtac classical 1),
   26.70 +    (REPEAT (ares_tac (prems@[bexI,ballI,notI,notE]) 1))  ]);
   26.71 +
   26.72 +val major::prems = goalw Set.thy [Bex_def]
   26.73 +    "[| EX x:A. P(x);  !!x. [| x:A; P(x) |] ==> Q  |] ==> Q";
   26.74 +by (rtac (major RS exE) 1);
   26.75 +by (REPEAT (eresolve_tac (prems @ [asm_rl,conjE]) 1));
   26.76 +val bexE = result();
   26.77 +
   26.78 +(*Trival rewrite rule;   (! x:A.P)=P holds only if A is nonempty!*)
   26.79 +val prems = goal Set.thy
   26.80 +    "(ALL x:A. True) <-> True";
   26.81 +by (REPEAT (ares_tac [TrueI,ballI,iffI] 1));
   26.82 +val ball_rew = result();
   26.83 +
   26.84 +(** Congruence rules **)
   26.85 +
   26.86 +val prems = goal Set.thy
   26.87 +    "[| A=A';  !!x. x:A' ==> P(x) <-> P'(x) |] ==> \
   26.88 +\    (ALL x:A. P(x)) <-> (ALL x:A'. P'(x))";
   26.89 +by (resolve_tac (prems RL [ssubst,iffD2]) 1);
   26.90 +by (REPEAT (ares_tac [ballI,iffI] 1
   26.91 +     ORELSE eresolve_tac ([make_elim bspec, mp] @ (prems RL [iffE])) 1));
   26.92 +val ball_cong = result();
   26.93 +
   26.94 +val prems = goal Set.thy
   26.95 +    "[| A=A';  !!x. x:A' ==> P(x) <-> P'(x) |] ==> \
   26.96 +\    (EX x:A. P(x)) <-> (EX x:A'. P'(x))";
   26.97 +by (resolve_tac (prems RL [ssubst,iffD2]) 1);
   26.98 +by (REPEAT (etac bexE 1
   26.99 +     ORELSE ares_tac ([bexI,iffI] @ (prems RL [iffD1,iffD2])) 1));
  26.100 +val bex_cong = result();
  26.101 +
  26.102 +(*** Rules for subsets ***)
  26.103 +
  26.104 +val prems = goalw Set.thy [subset_def] "(!!x.x:A ==> x:B) ==> A <= B";
  26.105 +by (REPEAT (ares_tac (prems @ [ballI]) 1));
  26.106 +val subsetI = result();
  26.107 +
  26.108 +(*Rule in Modus Ponens style*)
  26.109 +val major::prems = goalw Set.thy [subset_def] "[| A <= B;  c:A |] ==> c:B";
  26.110 +by (rtac (major RS bspec) 1);
  26.111 +by (resolve_tac prems 1);
  26.112 +val subsetD = result();
  26.113 +
  26.114 +(*Classical elimination rule*)
  26.115 +val major::prems = goalw Set.thy [subset_def] 
  26.116 +    "[| A <= B;  ~(c:A) ==> P;  c:B ==> P |] ==> P";
  26.117 +by (rtac (major RS ballE) 1);
  26.118 +by (REPEAT (eresolve_tac prems 1));
  26.119 +val subsetCE = result();
  26.120 +
  26.121 +(*Takes assumptions A<=B; c:A and creates the assumption c:B *)
  26.122 +fun set_mp_tac i = etac subsetCE i  THEN  mp_tac i;
  26.123 +
  26.124 +val subset_refl = prove_goal Set.thy "A <= A"
  26.125 + (fn _=> [ (REPEAT (ares_tac [subsetI] 1)) ]);
  26.126 +
  26.127 +goal Set.thy "!!A B C. [| A<=B;  B<=C |] ==> A<=C";
  26.128 +br subsetI 1;
  26.129 +by (REPEAT (eresolve_tac [asm_rl, subsetD] 1));
  26.130 +val subset_trans = result();
  26.131 +
  26.132 +
  26.133 +(*** Rules for equality ***)
  26.134 +
  26.135 +(*Anti-symmetry of the subset relation*)
  26.136 +val prems = goal Set.thy "[| A <= B;  B <= A |] ==> A = B";
  26.137 +by (rtac (iffI RS set_ext) 1);
  26.138 +by (REPEAT (ares_tac (prems RL [subsetD]) 1));
  26.139 +val subset_antisym = result();
  26.140 +val equalityI = subset_antisym;
  26.141 +
  26.142 +(* Equality rules from ZF set theory -- are they appropriate here? *)
  26.143 +val prems = goal Set.thy "A = B ==> A<=B";
  26.144 +by (resolve_tac (prems RL [subst]) 1);
  26.145 +by (rtac subset_refl 1);
  26.146 +val equalityD1 = result();
  26.147 +
  26.148 +val prems = goal Set.thy "A = B ==> B<=A";
  26.149 +by (resolve_tac (prems RL [subst]) 1);
  26.150 +by (rtac subset_refl 1);
  26.151 +val equalityD2 = result();
  26.152 +
  26.153 +val prems = goal Set.thy
  26.154 +    "[| A = B;  [| A<=B; B<=A |] ==> P |]  ==>  P";
  26.155 +by (resolve_tac prems 1);
  26.156 +by (REPEAT (resolve_tac (prems RL [equalityD1,equalityD2]) 1));
  26.157 +val equalityE = result();
  26.158 +
  26.159 +val major::prems = goal Set.thy
  26.160 +    "[| A = B;  [| c:A; c:B |] ==> P;  [| ~ c:A; ~ c:B |] ==> P |]  ==>  P";
  26.161 +by (rtac (major RS equalityE) 1);
  26.162 +by (REPEAT (contr_tac 1 ORELSE eresolve_tac ([asm_rl,subsetCE]@prems) 1));
  26.163 +val equalityCE = result();
  26.164 +
  26.165 +(*Lemma for creating induction formulae -- for "pattern matching" on p
  26.166 +  To make the induction hypotheses usable, apply "spec" or "bspec" to
  26.167 +  put universal quantifiers over the free variables in p. *)
  26.168 +val prems = goal Set.thy 
  26.169 +    "[| p:A;  !!z. z:A ==> p=z --> R |] ==> R";
  26.170 +by (rtac mp 1);
  26.171 +by (REPEAT (resolve_tac (refl::prems) 1));
  26.172 +val setup_induction = result();
  26.173 +
  26.174 +goal Set.thy "{x.x:A} = A";
  26.175 +by (REPEAT (ares_tac [equalityI,subsetI,CollectI] 1  ORELSE eresolve_tac [CollectD] 1));
  26.176 +val trivial_set = result();
  26.177 +
  26.178 +(*** Rules for binary union -- Un ***)
  26.179 +
  26.180 +val prems = goalw Set.thy [Un_def] "c:A ==> c : A Un B";
  26.181 +by (REPEAT (resolve_tac (prems @ [CollectI,disjI1]) 1));
  26.182 +val UnI1 = result();
  26.183 +
  26.184 +val prems = goalw Set.thy [Un_def] "c:B ==> c : A Un B";
  26.185 +by (REPEAT (resolve_tac (prems @ [CollectI,disjI2]) 1));
  26.186 +val UnI2 = result();
  26.187 +
  26.188 +(*Classical introduction rule: no commitment to A vs B*)
  26.189 +val UnCI = prove_goal Set.thy "(~c:B ==> c:A) ==> c : A Un B"
  26.190 + (fn prems=>
  26.191 +  [ (rtac classical 1),
  26.192 +    (REPEAT (ares_tac (prems@[UnI1,notI]) 1)),
  26.193 +    (REPEAT (ares_tac (prems@[UnI2,notE]) 1)) ]);
  26.194 +
  26.195 +val major::prems = goalw Set.thy [Un_def]
  26.196 +    "[| c : A Un B;  c:A ==> P;  c:B ==> P |] ==> P";
  26.197 +by (rtac (major RS CollectD RS disjE) 1);
  26.198 +by (REPEAT (eresolve_tac prems 1));
  26.199 +val UnE = result();
  26.200 +
  26.201 +
  26.202 +(*** Rules for small intersection -- Int ***)
  26.203 +
  26.204 +val prems = goalw Set.thy [Int_def]
  26.205 +    "[| c:A;  c:B |] ==> c : A Int B";
  26.206 +by (REPEAT (resolve_tac (prems @ [CollectI,conjI]) 1));
  26.207 +val IntI = result();
  26.208 +
  26.209 +val [major] = goalw Set.thy [Int_def] "c : A Int B ==> c:A";
  26.210 +by (rtac (major RS CollectD RS conjunct1) 1);
  26.211 +val IntD1 = result();
  26.212 +
  26.213 +val [major] = goalw Set.thy [Int_def] "c : A Int B ==> c:B";
  26.214 +by (rtac (major RS CollectD RS conjunct2) 1);
  26.215 +val IntD2 = result();
  26.216 +
  26.217 +val [major,minor] = goal Set.thy
  26.218 +    "[| c : A Int B;  [| c:A; c:B |] ==> P |] ==> P";
  26.219 +by (rtac minor 1);
  26.220 +by (rtac (major RS IntD1) 1);
  26.221 +by (rtac (major RS IntD2) 1);
  26.222 +val IntE = result();
  26.223 +
  26.224 +
  26.225 +(*** Rules for set complement -- Compl ***)
  26.226 +
  26.227 +val prems = goalw Set.thy [Compl_def]
  26.228 +    "[| c:A ==> False |] ==> c : Compl(A)";
  26.229 +by (REPEAT (ares_tac (prems @ [CollectI,notI]) 1));
  26.230 +val ComplI = result();
  26.231 +
  26.232 +(*This form, with negated conclusion, works well with the Classical prover.
  26.233 +  Negated assumptions behave like formulae on the right side of the notional
  26.234 +  turnstile...*)
  26.235 +val major::prems = goalw Set.thy [Compl_def]
  26.236 +    "[| c : Compl(A) |] ==> ~c:A";
  26.237 +by (rtac (major RS CollectD) 1);
  26.238 +val ComplD = result();
  26.239 +
  26.240 +val ComplE = make_elim ComplD;
  26.241 +
  26.242 +
  26.243 +(*** Empty sets ***)
  26.244 +
  26.245 +goalw Set.thy [empty_def] "{x.False} = {}";
  26.246 +br refl 1;
  26.247 +val empty_eq = result();
  26.248 +
  26.249 +val [prem] = goalw Set.thy [empty_def] "a : {} ==> P";
  26.250 +by (rtac (prem RS CollectD RS FalseE) 1);
  26.251 +val emptyD = result();
  26.252 +
  26.253 +val emptyE = make_elim emptyD;
  26.254 +
  26.255 +val [prem] = goal Set.thy "~ A={} ==> (EX x.x:A)";
  26.256 +br (prem RS swap) 1;
  26.257 +br equalityI 1;
  26.258 +by (ALLGOALS (fast_tac (FOL_cs addSIs [subsetI] addSEs [emptyD])));
  26.259 +val not_emptyD = result();
  26.260 +
  26.261 +(*** Singleton sets ***)
  26.262 +
  26.263 +goalw Set.thy [singleton_def] "a : {a}";
  26.264 +by (rtac CollectI 1);
  26.265 +by (rtac refl 1);
  26.266 +val singletonI = result();
  26.267 +
  26.268 +val [major] = goalw Set.thy [singleton_def] "b : {a} ==> b=a"; 
  26.269 +by (rtac (major RS CollectD) 1);
  26.270 +val singletonD = result();
  26.271 +
  26.272 +val singletonE = make_elim singletonD;
  26.273 +
  26.274 +(*** Unions of families ***)
  26.275 +
  26.276 +(*The order of the premises presupposes that A is rigid; b may be flexible*)
  26.277 +val prems = goalw Set.thy [UNION_def]
  26.278 +    "[| a:A;  b: B(a) |] ==> b: (UN x:A. B(x))";
  26.279 +by (REPEAT (resolve_tac (prems @ [bexI,CollectI]) 1));
  26.280 +val UN_I = result();
  26.281 +
  26.282 +val major::prems = goalw Set.thy [UNION_def]
  26.283 +    "[| b : (UN x:A. B(x));  !!x.[| x:A;  b: B(x) |] ==> R |] ==> R";
  26.284 +by (rtac (major RS CollectD RS bexE) 1);
  26.285 +by (REPEAT (ares_tac prems 1));
  26.286 +val UN_E = result();
  26.287 +
  26.288 +val prems = goal Set.thy
  26.289 +    "[| A=B;  !!x. x:B ==> C(x) = D(x) |] ==> \
  26.290 +\    (UN x:A. C(x)) = (UN x:B. D(x))";
  26.291 +by (REPEAT (etac UN_E 1
  26.292 +     ORELSE ares_tac ([UN_I,equalityI,subsetI] @ 
  26.293 +		      (prems RL [equalityD1,equalityD2] RL [subsetD])) 1));
  26.294 +val UN_cong = result();
  26.295 +
  26.296 +(*** Intersections of families -- INTER x:A. B(x) is Inter(B)``A ) *)
  26.297 +
  26.298 +val prems = goalw Set.thy [INTER_def]
  26.299 +    "(!!x. x:A ==> b: B(x)) ==> b : (INT x:A. B(x))";
  26.300 +by (REPEAT (ares_tac ([CollectI,ballI] @ prems) 1));
  26.301 +val INT_I = result();
  26.302 +
  26.303 +val major::prems = goalw Set.thy [INTER_def]
  26.304 +    "[| b : (INT x:A. B(x));  a:A |] ==> b: B(a)";
  26.305 +by (rtac (major RS CollectD RS bspec) 1);
  26.306 +by (resolve_tac prems 1);
  26.307 +val INT_D = result();
  26.308 +
  26.309 +(*"Classical" elimination rule -- does not require proving X:C *)
  26.310 +val major::prems = goalw Set.thy [INTER_def]
  26.311 +    "[| b : (INT x:A. B(x));  b: B(a) ==> R;  ~ a:A ==> R |] ==> R";
  26.312 +by (rtac (major RS CollectD RS ballE) 1);
  26.313 +by (REPEAT (eresolve_tac prems 1));
  26.314 +val INT_E = result();
  26.315 +
  26.316 +val prems = goal Set.thy
  26.317 +    "[| A=B;  !!x. x:B ==> C(x) = D(x) |] ==> \
  26.318 +\    (INT x:A. C(x)) = (INT x:B. D(x))";
  26.319 +by (REPEAT_FIRST (resolve_tac [INT_I,equalityI,subsetI]));
  26.320 +by (REPEAT (dtac INT_D 1
  26.321 +     ORELSE ares_tac (prems RL [equalityD1,equalityD2] RL [subsetD]) 1));
  26.322 +val INT_cong = result();
  26.323 +
  26.324 +(*** Rules for Unions ***)
  26.325 +
  26.326 +(*The order of the premises presupposes that C is rigid; A may be flexible*)
  26.327 +val prems = goalw Set.thy [Union_def]
  26.328 +    "[| X:C;  A:X |] ==> A : Union(C)";
  26.329 +by (REPEAT (resolve_tac (prems @ [UN_I]) 1));
  26.330 +val UnionI = result();
  26.331 +
  26.332 +val major::prems = goalw Set.thy [Union_def]
  26.333 +    "[| A : Union(C);  !!X.[| A:X;  X:C |] ==> R |] ==> R";
  26.334 +by (rtac (major RS UN_E) 1);
  26.335 +by (REPEAT (ares_tac prems 1));
  26.336 +val UnionE = result();
  26.337 +
  26.338 +(*** Rules for Inter ***)
  26.339 +
  26.340 +val prems = goalw Set.thy [Inter_def]
  26.341 +    "[| !!X. X:C ==> A:X |] ==> A : Inter(C)";
  26.342 +by (REPEAT (ares_tac ([INT_I] @ prems) 1));
  26.343 +val InterI = result();
  26.344 +
  26.345 +(*A "destruct" rule -- every X in C contains A as an element, but
  26.346 +  A:X can hold when X:C does not!  This rule is analogous to "spec". *)
  26.347 +val major::prems = goalw Set.thy [Inter_def]
  26.348 +    "[| A : Inter(C);  X:C |] ==> A:X";
  26.349 +by (rtac (major RS INT_D) 1);
  26.350 +by (resolve_tac prems 1);
  26.351 +val InterD = result();
  26.352 +
  26.353 +(*"Classical" elimination rule -- does not require proving X:C *)
  26.354 +val major::prems = goalw Set.thy [Inter_def]
  26.355 +    "[| A : Inter(C);  A:X ==> R;  ~ X:C ==> R |] ==> R";
  26.356 +by (rtac (major RS INT_E) 1);
  26.357 +by (REPEAT (eresolve_tac prems 1));
  26.358 +val InterE = result();
    27.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    27.2 +++ b/src/CCL/Set.thy	Thu Sep 16 12:20:38 1993 +0200
    27.3 @@ -0,0 +1,71 @@
    27.4 +(*  Title:      CCL/set.thy
    27.5 +    ID:         $Id$
    27.6 +
    27.7 +Modified version of HOL/set.thy that extends FOL
    27.8 +
    27.9 +*)
   27.10 +
   27.11 +Set = FOL +
   27.12 +
   27.13 +types
   27.14 +  set 1
   27.15 +
   27.16 +arities
   27.17 +  set :: (term) term
   27.18 +
   27.19 +consts
   27.20 +  Collect       :: "['a => o] => 'a set"                    (*comprehension*)
   27.21 +  Compl         :: "('a set) => 'a set"                     (*complement*)
   27.22 +  Int           :: "['a set, 'a set] => 'a set"         (infixl 70)
   27.23 +  Un            :: "['a set, 'a set] => 'a set"         (infixl 65)
   27.24 +  Union, Inter  :: "(('a set)set) => 'a set"                (*...of a set*)
   27.25 +  UNION, INTER  :: "['a set, 'a => 'b set] => 'b set"       (*general*)
   27.26 +  Ball, Bex     :: "['a set, 'a => o] => o"                 (*bounded quants*)
   27.27 +  mono          :: "['a set => 'b set] => o"                (*monotonicity*)
   27.28 +  ":"           :: "['a, 'a set] => o"                  (infixl 50) (*membership*)
   27.29 +  "<="          :: "['a set, 'a set] => o"              (infixl 50)
   27.30 +  singleton     :: "'a => 'a set"                       ("{_}")
   27.31 +  empty         :: "'a set"                             ("{}")
   27.32 +  "oo"          :: "['b => 'c, 'a => 'b, 'a] => 'c"     (infixr 50) (*composition*)
   27.33 +
   27.34 +  "@Coll"       :: "[idt, o] => 'a set"                 ("(1{_./ _})") (*collection*)
   27.35 +
   27.36 +  (* Big Intersection / Union *)
   27.37 +
   27.38 +  "@INTER"      :: "[idt, 'a set, 'b set] => 'b set"    ("(INT _:_./ _)" [0, 0, 0] 10)
   27.39 +  "@UNION"      :: "[idt, 'a set, 'b set] => 'b set"    ("(UN _:_./ _)" [0, 0, 0] 10)
   27.40 +
   27.41 +  (* Bounded Quantifiers *)
   27.42 +
   27.43 +  "@Ball"       :: "[idt, 'a set, o] => o"              ("(ALL _:_./ _)" [0, 0, 0] 10)
   27.44 +  "@Bex"        :: "[idt, 'a set, o] => o"              ("(EX _:_./ _)" [0, 0, 0] 10)
   27.45 +
   27.46 +
   27.47 +translations
   27.48 +  "{x. P}"      == "Collect(%x. P)"
   27.49 +  "INT x:A. B"  == "INTER(A, %x. B)"
   27.50 +  "UN x:A. B"   == "UNION(A, %x. B)"
   27.51 +  "ALL x:A. P"  == "Ball(A, %x. P)"
   27.52 +  "EX x:A. P"   == "Bex(A, %x. P)"
   27.53 +
   27.54 +
   27.55 +rules
   27.56 +  mem_Collect_iff       "(a : {x.P(x)}) <-> P(a)"
   27.57 +  set_extension         "A=B <-> (ALL x.x:A <-> x:B)"
   27.58 +
   27.59 +  Ball_def      "Ball(A, P)  == ALL x. x:A --> P(x)"
   27.60 +  Bex_def       "Bex(A, P)   == EX x. x:A & P(x)"
   27.61 +  mono_def      "mono(f)     == (ALL A B. A <= B --> f(A) <= f(B))"
   27.62 +  subset_def    "A <= B      == ALL x:A. x:B"
   27.63 +  singleton_def "{a}         == {x.x=a}"
   27.64 +  empty_def     "{}          == {x.False}"
   27.65 +  Un_def        "A Un B      == {x.x:A | x:B}"
   27.66 +  Int_def       "A Int B     == {x.x:A & x:B}"
   27.67 +  Compl_def     "Compl(A)    == {x. ~x:A}"
   27.68 +  INTER_def     "INTER(A, B) == {y. ALL x:A. y: B(x)}"
   27.69 +  UNION_def     "UNION(A, B) == {y. EX x:A. y: B(x)}"
   27.70 +  Inter_def     "Inter(S)    == (INT x:S. x)"
   27.71 +  Union_def     "Union(S)    == (UN x:S. x)"
   27.72 +
   27.73 +end
   27.74 +
    28.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    28.2 +++ b/src/CCL/Term.ML	Thu Sep 16 12:20:38 1993 +0200
    28.3 @@ -0,0 +1,146 @@
    28.4 +(*  Title: 	CCL/terms
    28.5 +    ID:         $Id$
    28.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    28.7 +    Copyright   1993  University of Cambridge
    28.8 +
    28.9 +For terms.thy.
   28.10 +*)
   28.11 +
   28.12 +open Term;
   28.13 +
   28.14 +val simp_can_defs = [one_def,inl_def,inr_def];
   28.15 +val simp_ncan_defs = [if_def,when_def,split_def,fst_def,snd_def,thd_def];
   28.16 +val simp_defs = simp_can_defs @ simp_ncan_defs;
   28.17 +
   28.18 +val ind_can_defs = [zero_def,succ_def,nil_def,cons_def];
   28.19 +val ind_ncan_defs = [ncase_def,nrec_def,lcase_def,lrec_def];
   28.20 +val ind_defs = ind_can_defs @ ind_ncan_defs;
   28.21 +
   28.22 +val data_defs = simp_defs @ ind_defs @ [napply_def];
   28.23 +val genrec_defs = [letrec_def,letrec2_def,letrec3_def];
   28.24 +
   28.25 +val term_congs = ccl_mk_congs Term.thy 
   28.26 +    ["inl","inr","succ","op .","split","if","when","ncase","nrec","lcase","lrec",
   28.27 +     "fst","snd","thd","let","letrec","letrec2","letrec3","napply"];
   28.28 +
   28.29 +(*** Beta Rules, including strictness ***)
   28.30 +
   28.31 +goalw Term.thy [let_def] "~ t=bot--> let x be t in f(x) = f(t)";
   28.32 +by (res_inst_tac [("t","t")] term_case 1);
   28.33 +by (ALLGOALS(SIMP_TAC(CCL_ss addrews [caseBtrue,caseBfalse,caseBpair,caseBlam])));
   28.34 +val letB = result() RS mp;
   28.35 +
   28.36 +goalw Term.thy [let_def] "let x be bot in f(x) = bot";
   28.37 +br caseBbot 1;
   28.38 +val letBabot = result();
   28.39 +
   28.40 +goalw Term.thy [let_def] "let x be t in bot = bot";
   28.41 +brs ([caseBbot] RL [term_case]) 1;
   28.42 +by (ALLGOALS(SIMP_TAC(CCL_ss addrews [caseBtrue,caseBfalse,caseBpair,caseBlam])));
   28.43 +val letBbbot = result();
   28.44 +
   28.45 +goalw Term.thy [apply_def] "(lam x.b(x)) ` a = b(a)";
   28.46 +by (ALLGOALS(SIMP_TAC(CCL_ss addrews [caseBtrue,caseBfalse,caseBpair,caseBlam])));
   28.47 +val applyB = result();
   28.48 +
   28.49 +goalw Term.thy [apply_def] "bot ` a = bot";
   28.50 +br caseBbot 1;
   28.51 +val applyBbot = result();
   28.52 +
   28.53 +goalw Term.thy [fix_def] "fix(f) = f(fix(f))";
   28.54 +by (resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1);
   28.55 +val fixB = result();
   28.56 +
   28.57 +goalw Term.thy [letrec_def]
   28.58 +      "letrec g x be h(x,g) in g(a) = h(a,%y.letrec g x be h(x,g) in g(y))";
   28.59 +by (resolve_tac [fixB RS ssubst] 1 THEN 
   28.60 +    resolve_tac [applyB RS ssubst] 1 THEN resolve_tac [refl] 1);
   28.61 +val letrecB = result();
   28.62 +
   28.63 +val rawBs = caseBs @ [applyB,applyBbot,letrecB];
   28.64 +
   28.65 +fun raw_mk_beta_rl defs s = prove_goalw Term.thy defs s
   28.66 +           (fn _ => [SIMP_TAC (CCL_ss addrews rawBs  addcongs term_congs) 1]);
   28.67 +fun mk_beta_rl s = raw_mk_beta_rl data_defs s;
   28.68 +
   28.69 +val ifBtrue    = mk_beta_rl "if true then t else u = t";
   28.70 +val ifBfalse   = mk_beta_rl "if false then t else u = u";
   28.71 +val ifBbot     = mk_beta_rl "if bot then t else u = bot";
   28.72 +
   28.73 +val whenBinl   = mk_beta_rl "when(inl(a),t,u) = t(a)";
   28.74 +val whenBinr   = mk_beta_rl "when(inr(a),t,u) = u(a)";
   28.75 +val whenBbot   = mk_beta_rl "when(bot,t,u) = bot";
   28.76 +
   28.77 +val splitB     = mk_beta_rl "split(<a,b>,h) = h(a,b)";
   28.78 +val splitBbot  = mk_beta_rl "split(bot,h) = bot";
   28.79 +val fstB       = mk_beta_rl "fst(<a,b>) = a";
   28.80 +val fstBbot    = mk_beta_rl "fst(bot) = bot";
   28.81 +val sndB       = mk_beta_rl "snd(<a,b>) = b";
   28.82 +val sndBbot    = mk_beta_rl "snd(bot) = bot";
   28.83 +val thdB       = mk_beta_rl "thd(<a,<b,c>>) = c";
   28.84 +val thdBbot    = mk_beta_rl "thd(bot) = bot";
   28.85 +
   28.86 +val ncaseBzero = mk_beta_rl "ncase(zero,t,u) = t";
   28.87 +val ncaseBsucc = mk_beta_rl "ncase(succ(n),t,u) = u(n)";
   28.88 +val ncaseBbot  = mk_beta_rl "ncase(bot,t,u) = bot";
   28.89 +val nrecBzero  = mk_beta_rl "nrec(zero,t,u) = t";
   28.90 +val nrecBsucc  = mk_beta_rl "nrec(succ(n),t,u) = u(n,nrec(n,t,u))";
   28.91 +val nrecBbot   = mk_beta_rl "nrec(bot,t,u) = bot";
   28.92 +
   28.93 +val lcaseBnil  = mk_beta_rl "lcase([],t,u) = t";
   28.94 +val lcaseBcons = mk_beta_rl "lcase(x.xs,t,u) = u(x,xs)";
   28.95 +val lcaseBbot  = mk_beta_rl "lcase(bot,t,u) = bot";
   28.96 +val lrecBnil   = mk_beta_rl "lrec([],t,u) = t";
   28.97 +val lrecBcons  = mk_beta_rl "lrec(x.xs,t,u) = u(x,xs,lrec(xs,t,u))";
   28.98 +val lrecBbot   = mk_beta_rl "lrec(bot,t,u) = bot";
   28.99 +
  28.100 +val letrec2B = raw_mk_beta_rl (data_defs @ [letrec2_def])
  28.101 +       "letrec g x y be h(x,y,g) in g(p,q) = \
  28.102 +\                     h(p,q,%u v.letrec g x y be h(x,y,g) in g(u,v))";
  28.103 +val letrec3B = raw_mk_beta_rl (data_defs @ [letrec3_def])
  28.104 +       "letrec g x y z be h(x,y,z,g) in g(p,q,r) = \
  28.105 +\                     h(p,q,r,%u v w.letrec g x y z be h(x,y,z,g) in g(u,v,w))";
  28.106 +
  28.107 +val napplyBzero   = mk_beta_rl "f^zero`a = a";
  28.108 +val napplyBsucc   = mk_beta_rl "f^succ(n)`a = f(f^n`a)";
  28.109 +
  28.110 +val termBs = [letB,applyB,applyBbot,splitB,splitBbot,
  28.111 +              fstB,fstBbot,sndB,sndBbot,thdB,thdBbot,
  28.112 +              ifBtrue,ifBfalse,ifBbot,whenBinl,whenBinr,whenBbot,
  28.113 +              ncaseBzero,ncaseBsucc,ncaseBbot,nrecBzero,nrecBsucc,nrecBbot,
  28.114 +              lcaseBnil,lcaseBcons,lcaseBbot,lrecBnil,lrecBcons,lrecBbot,
  28.115 +              napplyBzero,napplyBsucc];
  28.116 +
  28.117 +(*** Constructors are injective ***)
  28.118 +
  28.119 +val term_injs = map (mk_inj_rl Term.thy 
  28.120 +                             [applyB,splitB,whenBinl,whenBinr,ncaseBsucc,lcaseBcons] 
  28.121 +                             (ccl_congs @ term_congs))
  28.122 +               ["(inl(a) = inl(a')) <-> (a=a')",
  28.123 +                "(inr(a) = inr(a')) <-> (a=a')",
  28.124 +                "(succ(a) = succ(a')) <-> (a=a')",
  28.125 +                "(a.b = a'.b') <-> (a=a' & b=b')"];
  28.126 +
  28.127 +(*** Constructors are distinct ***)
  28.128 +
  28.129 +val term_dstncts = mkall_dstnct_thms Term.thy data_defs (ccl_injs @ term_injs)
  28.130 +                    [["bot","inl","inr"],["bot","zero","succ"],["bot","nil","op ."]];
  28.131 +
  28.132 +(*** Rules for pre-order [= ***)
  28.133 +
  28.134 +local
  28.135 +  fun mk_thm s = prove_goalw Term.thy data_defs s (fn _ => 
  28.136 +                  [SIMP_TAC (ccl_ss addrews (ccl_porews)) 1]);
  28.137 +in
  28.138 +  val term_porews = map mk_thm ["inl(a) [= inl(a') <-> a [= a'",
  28.139 +                                "inr(b) [= inr(b') <-> b [= b'",
  28.140 +                                "succ(n) [= succ(n') <-> n [= n'",
  28.141 +                                "x.xs [= x'.xs' <-> x [= x'  & xs [= xs'"];
  28.142 +end;
  28.143 +
  28.144 +(*** Rewriting and Proving ***)
  28.145 +
  28.146 +val term_rews = termBs @ term_injs @ term_dstncts @ ccl_porews @ term_porews;
  28.147 +val term_ss = ccl_ss addrews term_rews addcongs term_congs;
  28.148 +
  28.149 +val term_cs = ccl_cs addSEs (term_dstncts RL [notE]) addSDs (XH_to_Ds term_injs);
    29.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    29.2 +++ b/src/CCL/Term.thy	Thu Sep 16 12:20:38 1993 +0200
    29.3 @@ -0,0 +1,131 @@
    29.4 +(*  Title: 	CCL/terms.thy
    29.5 +    ID:         $Id$
    29.6 +    Author: 	Martin Coen
    29.7 +    Copyright   1993  University of Cambridge
    29.8 +
    29.9 +Definitions of usual program constructs in CCL.
   29.10 +
   29.11 +*)
   29.12 +
   29.13 +Term = CCL +
   29.14 +
   29.15 +consts
   29.16 +
   29.17 +  one        ::	      "i"
   29.18 +
   29.19 +  if         ::       "[i,i,i]=>i"           ("(3if _/ then _/ else _)" [] 60)
   29.20 +
   29.21 +  inl,inr    ::	      "i=>i"
   29.22 +  when       ::	      "[i,i=>i,i=>i]=>i" 
   29.23 +
   29.24 +  split      ::	      "[i,[i,i]=>i]=>i"
   29.25 +  fst,snd,   
   29.26 +  thd        ::       "i=>i"
   29.27 +
   29.28 +  zero       ::	      "i"
   29.29 +  succ       ::	      "i=>i"
   29.30 +  ncase      ::	      "[i,i,i=>i]=>i"
   29.31 +  nrec       ::	      "[i,i,[i,i]=>i]=>i"
   29.32 +
   29.33 +  nil        ::       "i"                    ("([])")
   29.34 +  "."        ::       "[i,i]=>i"             (infixr 80)
   29.35 +  lcase      ::	      "[i,i,[i,i]=>i]=>i"
   29.36 +  lrec       ::	      "[i,i,[i,i,i]=>i]=>i"
   29.37 +
   29.38 +  let        ::       "[i,i=>i]=>i"
   29.39 +  letrec     ::       "[[i,i=>i]=>i,(i=>i)=>i]=>i"
   29.40 +  letrec2    ::       "[[i,i,i=>i=>i]=>i,(i=>i=>i)=>i]=>i"
   29.41 +  letrec3    ::       "[[i,i,i,i=>i=>i=>i]=>i,(i=>i=>i=>i)=>i]=>i"  
   29.42 +
   29.43 +  "@let"     ::       "[id,i,i]=>i"             ("(3let _ be _/ in _)" [] 60)
   29.44 +  "@letrec"  ::       "[id,id,i,i]=>i"          ("(3letrec _ _ be _/ in _)"  [] 60)
   29.45 +  "@letrec2" ::       "[id,id,id,i,i]=>i"       ("(3letrec _ _ _ be _/ in _)"  [] 60)
   29.46 +  "@letrec3" ::       "[id,id,id,id,i,i]=>i"    ("(3letrec _ _ _ _ be _/ in _)"  [] 60)
   29.47 +
   29.48 +  napply    :: "[i=>i,i,i]=>i"      ("(_ ^ _ ` _)")
   29.49 +
   29.50 +rules
   29.51 +
   29.52 +  one_def                    "one == true"
   29.53 +  if_def     "if b then t else u  == case(b,t,u,% x y.bot,%v.bot)"
   29.54 +  inl_def                 "inl(a) == <true,a>"
   29.55 +  inr_def                 "inr(b) == <false,b>"
   29.56 +  when_def           "when(t,f,g) == split(t,%b x.if b then f(x) else g(x))"
   29.57 +  split_def           "split(t,f) == case(t,bot,bot,f,%u.bot)"
   29.58 +  fst_def                 "fst(t) == split(t,%x y.x)"
   29.59 +  snd_def                 "snd(t) == split(t,%x y.y)"
   29.60 +  thd_def                 "thd(t) == split(t,%x p.split(p,%y z.z))"
   29.61 +  zero_def                  "zero == inl(one)"
   29.62 +  succ_def               "succ(n) == inr(n)"
   29.63 +  ncase_def         "ncase(n,b,c) == when(n,%x.b,%y.c(y))"
   29.64 +  nrec_def          " nrec(n,b,c) == letrec g x be ncase(x,b,%y.c(y,g(y))) in g(n)"
   29.65 +  nil_def	              "[] == inl(one)"
   29.66 +  cons_def                   "h.t == inr(<h,t>)"
   29.67 +  lcase_def         "lcase(l,b,c) == when(l,%x.b,%y.split(y,c))"
   29.68 +  lrec_def           "lrec(l,b,c) == letrec g x be lcase(x,b,%h t.c(h,t,g(t))) in g(l)"
   29.69 +
   29.70 +  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)))"
   29.71 +  letrec_def    
   29.72 +  "letrec g x be h(x,g) in b(g) == b(%x.fix(%f.lam x.h(x,%y.f`y))`x)"
   29.73 +
   29.74 +  letrec2_def  "letrec g x y be h(x,y,g) in f(g)== \
   29.75 +\               letrec g' p be split(p,%x y.h(x,y,%u v.g'(<u,v>))) \
   29.76 +\                          in f(%x y.g'(<x,y>))"
   29.77 +
   29.78 +  letrec3_def  "letrec g x y z be h(x,y,z,g) in f(g) == \
   29.79 +\             letrec g' p be split(p,%x xs.split(xs,%y z.h(x,y,z,%u v w.g'(<u,<v,w>>)))) \
   29.80 +\                          in f(%x y z.g'(<x,<y,z>>))"
   29.81 +
   29.82 +  napply_def "f ^n` a == nrec(n,a,%x g.f(g))"
   29.83 +
   29.84 +end
   29.85 +
   29.86 +ML
   29.87 +
   29.88 +(** Quantifier translations: variable binding **)
   29.89 +
   29.90 +fun let_tr [Free(id,T),a,b] = Const("let",dummyT) $ a $ absfree(id,T,b);
   29.91 +fun let_tr' [a,Abs(id,T,b)] =
   29.92 +     let val (id',b') = variant_abs(id,T,b)
   29.93 +     in Const("@let",dummyT) $ Free(id',T) $ a $ b' end;
   29.94 +
   29.95 +fun letrec_tr [Free(f,S),Free(x,T),a,b] = 
   29.96 +      Const("letrec",dummyT) $ absfree(x,T,absfree(f,S,a)) $ absfree(f,S,b);
   29.97 +fun letrec2_tr [Free(f,S),Free(x,T),Free(y,U),a,b] = 
   29.98 +      Const("letrec2",dummyT) $ absfree(x,T,absfree(y,U,absfree(f,S,a))) $ absfree(f,S,b);
   29.99 +fun letrec3_tr [Free(f,S),Free(x,T),Free(y,U),Free(z,V),a,b] = 
  29.100 +      Const("letrec3",dummyT) $ absfree(x,T,absfree(y,U,absfree(z,U,absfree(f,S,a)))) $ absfree(f,S,b);
  29.101 +
  29.102 +fun letrec_tr' [Abs(x,T,Abs(f,S,a)),Abs(ff,SS,b)] =
  29.103 +     let val (f',b')  = variant_abs(ff,SS,b)
  29.104 +         val (_,a'') = variant_abs(f,S,a)
  29.105 +         val (x',a')  = variant_abs(x,T,a'')
  29.106 +     in Const("@letrec",dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end;
  29.107 +fun letrec2_tr' [Abs(x,T,Abs(y,U,Abs(f,S,a))),Abs(ff,SS,b)] =
  29.108 +     let val (f',b') = variant_abs(ff,SS,b)
  29.109 +         val ( _,a1) = variant_abs(f,S,a)
  29.110 +         val (y',a2) = variant_abs(y,U,a1)
  29.111 +         val (x',a') = variant_abs(x,T,a2)
  29.112 +     in Const("@letrec2",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b'
  29.113 +      end;
  29.114 +fun letrec3_tr' [Abs(x,T,Abs(y,U,Abs(z,V,Abs(f,S,a)))),Abs(ff,SS,b)] =
  29.115 +     let val (f',b') = variant_abs(ff,SS,b)
  29.116 +         val ( _,a1) = variant_abs(f,S,a)
  29.117 +         val (z',a2) = variant_abs(z,V,a1)
  29.118 +         val (y',a3) = variant_abs(y,U,a2)
  29.119 +         val (x',a') = variant_abs(x,T,a3)
  29.120 +     in Const("@letrec3",dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b'
  29.121 +      end;
  29.122 +
  29.123 +val  parse_translation=
  29.124 +    [("@let",       let_tr),
  29.125 +     ("@letrec",    letrec_tr),
  29.126 +     ("@letrec2",   letrec2_tr),
  29.127 +     ("@letrec3",   letrec3_tr)
  29.128 +    ];
  29.129 +val print_translation=
  29.130 +    [("let",       let_tr'),
  29.131 +     ("letrec",    letrec_tr'),
  29.132 +     ("letrec2",   letrec2_tr'),
  29.133 +     ("letrec3",   letrec3_tr')
  29.134 +    ];
    30.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    30.2 +++ b/src/CCL/Trancl.ML	Thu Sep 16 12:20:38 1993 +0200
    30.3 @@ -0,0 +1,215 @@
    30.4 +(*  Title: 	CCL/trancl
    30.5 +    ID:         $Id$
    30.6 +
    30.7 +For trancl.thy.
    30.8 +
    30.9 +Modified version of
   30.10 +    Title: 	HOL/trancl.ML
   30.11 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
   30.12 +    Copyright   1992  University of Cambridge
   30.13 +
   30.14 +*)
   30.15 +
   30.16 +open Trancl;
   30.17 +
   30.18 +(** Natural deduction for trans(r) **)
   30.19 +
   30.20 +val prems = goalw Trancl.thy [trans_def]
   30.21 +    "(!! x y z. [| <x,y>:r;  <y,z>:r |] ==> <x,z>:r) ==> trans(r)";
   30.22 +by (REPEAT (ares_tac (prems@[allI,impI]) 1));
   30.23 +val transI = result();
   30.24 +
   30.25 +val major::prems = goalw Trancl.thy [trans_def]
   30.26 +    "[| trans(r);  <a,b>:r;  <b,c>:r |] ==> <a,c>:r";
   30.27 +by (cut_facts_tac [major] 1);
   30.28 +by (fast_tac (FOL_cs addIs prems) 1);
   30.29 +val transD = result();
   30.30 +
   30.31 +(** Identity relation **)
   30.32 +
   30.33 +goalw Trancl.thy [id_def] "<a,a> : id";  
   30.34 +by (rtac CollectI 1);
   30.35 +by (rtac exI 1);
   30.36 +by (rtac refl 1);
   30.37 +val idI = result();
   30.38 +
   30.39 +val major::prems = goalw Trancl.thy [id_def]
   30.40 +    "[| p: id;  !!x.[| p = <x,x> |] ==> P  \
   30.41 +\    |] ==>  P";  
   30.42 +by (rtac (major RS CollectE) 1);
   30.43 +by (etac exE 1);
   30.44 +by (eresolve_tac prems 1);
   30.45 +val idE = result();
   30.46 +
   30.47 +(** Composition of two relations **)
   30.48 +
   30.49 +val prems = goalw Trancl.thy [comp_def]
   30.50 +    "[| <a,b>:s; <b,c>:r |] ==> <a,c> : r O s";
   30.51 +by (fast_tac (set_cs addIs prems) 1);
   30.52 +val compI = result();
   30.53 +
   30.54 +(*proof requires higher-level assumptions or a delaying of hyp_subst_tac*)
   30.55 +val prems = goalw Trancl.thy [comp_def]
   30.56 +    "[| xz : r O s;  \
   30.57 +\       !!x y z. [| xz = <x,z>;  <x,y>:s;  <y,z>:r |] ==> P \
   30.58 +\    |] ==> P";
   30.59 +by (cut_facts_tac prems 1);
   30.60 +by (REPEAT (eresolve_tac [CollectE, exE, conjE] 1 ORELSE ares_tac prems 1));
   30.61 +val compE = result();
   30.62 +
   30.63 +val prems = goal Trancl.thy
   30.64 +    "[| <a,c> : r O s;  \
   30.65 +\       !!y. [| <a,y>:s;  <y,c>:r |] ==> P \
   30.66 +\    |] ==> P";
   30.67 +by (rtac compE 1);
   30.68 +by (REPEAT (ares_tac prems 1 ORELSE eresolve_tac [pair_inject,ssubst] 1));
   30.69 +val compEpair = result();
   30.70 +
   30.71 +val comp_cs = set_cs addIs [compI,idI] 
   30.72 +		       addEs [compE,idE] 
   30.73 +		       addSEs [pair_inject];
   30.74 +
   30.75 +val prems = goal Trancl.thy
   30.76 +    "[| r'<=r; s'<=s |] ==> (r' O s') <= (r O s)";
   30.77 +by (cut_facts_tac prems 1);
   30.78 +by (fast_tac comp_cs 1);
   30.79 +val comp_mono = result();
   30.80 +
   30.81 +(** The relation rtrancl **)
   30.82 +
   30.83 +goal Trancl.thy "mono(%s. id Un (r O s))";
   30.84 +by (rtac monoI 1);
   30.85 +by (REPEAT (ares_tac [monoI, subset_refl, comp_mono, Un_mono] 1));
   30.86 +val rtrancl_fun_mono = result();
   30.87 +
   30.88 +val rtrancl_unfold = rtrancl_fun_mono RS (rtrancl_def RS def_lfp_Tarski);
   30.89 +
   30.90 +(*Reflexivity of rtrancl*)
   30.91 +goal Trancl.thy "<a,a> : r^*";
   30.92 +br (rtrancl_unfold RS ssubst) 1;
   30.93 +by (fast_tac comp_cs 1);
   30.94 +val rtrancl_refl = result();
   30.95 +
   30.96 +(*Closure under composition with r*)
   30.97 +val prems = goal Trancl.thy
   30.98 +    "[| <a,b> : r^*;  <b,c> : r |] ==> <a,c> : r^*";
   30.99 +br (rtrancl_unfold RS ssubst) 1;
  30.100 +by (fast_tac (comp_cs addIs prems) 1);
  30.101 +val rtrancl_into_rtrancl = result();
  30.102 +
  30.103 +(*rtrancl of r contains r*)
  30.104 +val [prem] = goal Trancl.thy "[| <a,b> : r |] ==> <a,b> : r^*";
  30.105 +by (rtac (rtrancl_refl RS rtrancl_into_rtrancl) 1);
  30.106 +by (rtac prem 1);
  30.107 +val r_into_rtrancl = result();
  30.108 +
  30.109 +
  30.110 +(** standard induction rule **)
  30.111 +
  30.112 +val major::prems = goal Trancl.thy 
  30.113 +  "[| <a,b> : r^*; \
  30.114 +\     !!x. P(<x,x>); \
  30.115 +\     !!x y z.[| P(<x,y>); <x,y>: r^*; <y,z>: r |]  ==>  P(<x,z>) |] \
  30.116 +\  ==>  P(<a,b>)";
  30.117 +by (rtac (major RS (rtrancl_def RS def_induct)) 1);
  30.118 +by (rtac rtrancl_fun_mono 1);
  30.119 +by (fast_tac (comp_cs addIs prems) 1);
  30.120 +val rtrancl_full_induct = result();
  30.121 +
  30.122 +(*nice induction rule*)
  30.123 +val major::prems = goal Trancl.thy
  30.124 +    "[| <a,b> : r^*;    \
  30.125 +\       P(a); \
  30.126 +\	!!y z.[| <a,y> : r^*;  <y,z> : r;  P(y) |] ==> P(z) |]  \
  30.127 +\     ==> P(b)";
  30.128 +(*by induction on this formula*)
  30.129 +by (subgoal_tac "ALL y. <a,b> = <a,y> --> P(y)" 1);
  30.130 +(*now solve first subgoal: this formula is sufficient*)
  30.131 +by (fast_tac FOL_cs 1);
  30.132 +(*now do the induction*)
  30.133 +by (resolve_tac [major RS rtrancl_full_induct] 1);
  30.134 +by (fast_tac (comp_cs addIs prems) 1);
  30.135 +by (fast_tac (comp_cs addIs prems) 1);
  30.136 +val rtrancl_induct = result();
  30.137 +
  30.138 +(*transitivity of transitive closure!! -- by induction.*)
  30.139 +goal Trancl.thy "trans(r^*)";
  30.140 +by (rtac transI 1);
  30.141 +by (res_inst_tac [("b","z")] rtrancl_induct 1);
  30.142 +by (DEPTH_SOLVE (eresolve_tac [asm_rl, rtrancl_into_rtrancl] 1));
  30.143 +val trans_rtrancl = result();
  30.144 +
  30.145 +(*elimination of rtrancl -- by induction on a special formula*)
  30.146 +val major::prems = goal Trancl.thy
  30.147 +    "[| <a,b> : r^*;  (a = b) ==> P; \
  30.148 +\	!!y.[| <a,y> : r^*; <y,b> : r |] ==> P |] \
  30.149 +\    ==> P";
  30.150 +by (subgoal_tac "a = b  | (EX y. <a,y> : r^* & <y,b> : r)" 1);
  30.151 +by (rtac (major RS rtrancl_induct) 2);
  30.152 +by (fast_tac (set_cs addIs prems) 2);
  30.153 +by (fast_tac (set_cs addIs prems) 2);
  30.154 +by (REPEAT (eresolve_tac ([asm_rl,exE,disjE,conjE]@prems) 1));
  30.155 +val rtranclE = result();
  30.156 +
  30.157 +
  30.158 +(**** The relation trancl ****)
  30.159 +
  30.160 +(** Conversions between trancl and rtrancl **)
  30.161 +
  30.162 +val [major] = goalw Trancl.thy [trancl_def]
  30.163 +    "[| <a,b> : r^+ |] ==> <a,b> : r^*";
  30.164 +by (resolve_tac [major RS compEpair] 1);
  30.165 +by (REPEAT (ares_tac [rtrancl_into_rtrancl] 1));
  30.166 +val trancl_into_rtrancl = result();
  30.167 +
  30.168 +(*r^+ contains r*)
  30.169 +val [prem] = goalw Trancl.thy [trancl_def]
  30.170 +   "[| <a,b> : r |] ==> <a,b> : r^+";
  30.171 +by (REPEAT (ares_tac [prem,compI,rtrancl_refl] 1));
  30.172 +val r_into_trancl = result();
  30.173 +
  30.174 +(*intro rule by definition: from rtrancl and r*)
  30.175 +val prems = goalw Trancl.thy [trancl_def]
  30.176 +    "[| <a,b> : r^*;  <b,c> : r |]   ==>  <a,c> : r^+";
  30.177 +by (REPEAT (resolve_tac ([compI]@prems) 1));
  30.178 +val rtrancl_into_trancl1 = result();
  30.179 +
  30.180 +(*intro rule from r and rtrancl*)
  30.181 +val prems = goal Trancl.thy
  30.182 +    "[| <a,b> : r;  <b,c> : r^* |]   ==>  <a,c> : r^+";
  30.183 +by (resolve_tac (prems RL [rtranclE]) 1);
  30.184 +by (etac subst 1);
  30.185 +by (resolve_tac (prems RL [r_into_trancl]) 1);
  30.186 +by (rtac (trans_rtrancl RS transD RS rtrancl_into_trancl1) 1);
  30.187 +by (REPEAT (ares_tac (prems@[r_into_rtrancl]) 1));
  30.188 +val rtrancl_into_trancl2 = result();
  30.189 +
  30.190 +(*elimination of r^+ -- NOT an induction rule*)
  30.191 +val major::prems = goal Trancl.thy
  30.192 +    "[| <a,b> : r^+;  \
  30.193 +\       <a,b> : r ==> P; \
  30.194 +\	!!y.[| <a,y> : r^+;  <y,b> : r |] ==> P  \
  30.195 +\    |] ==> P";
  30.196 +by (subgoal_tac "<a,b> : r | (EX y. <a,y> : r^+  &  <y,b> : r)" 1);
  30.197 +by (REPEAT (eresolve_tac ([asm_rl,disjE,exE,conjE]@prems) 1));
  30.198 +by (rtac (rewrite_rule [trancl_def] major RS compEpair) 1);
  30.199 +by (etac rtranclE 1);
  30.200 +by (fast_tac comp_cs 1);
  30.201 +by (fast_tac (comp_cs addSIs [rtrancl_into_trancl1]) 1);
  30.202 +val tranclE = result();
  30.203 +
  30.204 +(*Transitivity of r^+.
  30.205 +  Proved by unfolding since it uses transitivity of rtrancl. *)
  30.206 +goalw Trancl.thy [trancl_def] "trans(r^+)";
  30.207 +by (rtac transI 1);
  30.208 +by (REPEAT (etac compEpair 1));
  30.209 +by (rtac (rtrancl_into_rtrancl RS (trans_rtrancl RS transD RS compI)) 1);
  30.210 +by (REPEAT (assume_tac 1));
  30.211 +val trans_trancl = result();
  30.212 +
  30.213 +val prems = goal Trancl.thy
  30.214 +    "[| <a,b> : r;  <b,c> : r^+ |]   ==>  <a,c> : r^+";
  30.215 +by (rtac (r_into_trancl RS (trans_trancl RS transD)) 1);
  30.216 +by (resolve_tac prems 1);
  30.217 +by (resolve_tac prems 1);
  30.218 +val trancl_into_trancl2 = result();
    31.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    31.2 +++ b/src/CCL/Trancl.thy	Thu Sep 16 12:20:38 1993 +0200
    31.3 @@ -0,0 +1,28 @@
    31.4 +(*  Title: 	CCL/trancl.thy
    31.5 +    ID:         $Id$
    31.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    31.7 +    Copyright   1993  University of Cambridge
    31.8 +
    31.9 +Transitive closure of a relation
   31.10 +*)
   31.11 +
   31.12 +Trancl = CCL +
   31.13 +
   31.14 +consts
   31.15 +    trans   :: "i set => o" 	              (*transitivity predicate*)
   31.16 +    id	    :: "i set"
   31.17 +    rtrancl :: "i set => i set"	              ("(_^*)" [100] 100)
   31.18 +    trancl  :: "i set => i set"	              ("(_^+)" [100] 100)  
   31.19 +    O	    :: "[i set,i set] => i set"       (infixr 60)
   31.20 +
   31.21 +rules   
   31.22 +
   31.23 +trans_def	"trans(r) == (ALL x y z. <x,y>:r --> <y,z>:r --> <x,z>:r)"
   31.24 +comp_def	(*composition of relations*)
   31.25 +		"r O s == {xz. EX x y z. xz = <x,z> & <x,y>:s & <y,z>:r}"
   31.26 +id_def		(*the identity relation*)
   31.27 +		"id == {p. EX x. p = <x,x>}"
   31.28 +rtrancl_def	"r^* == lfp(%s. id Un (r O s))"
   31.29 +trancl_def	"r^+ == r O rtrancl(r)"
   31.30 +
   31.31 +end
    32.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    32.2 +++ b/src/CCL/Type.ML	Thu Sep 16 12:20:38 1993 +0200
    32.3 @@ -0,0 +1,308 @@
    32.4 +(*  Title: 	CCL/types
    32.5 +    ID:         $Id$
    32.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    32.7 +    Copyright   1992  University of Cambridge
    32.8 +
    32.9 +For types.thy.
   32.10 +*)
   32.11 +
   32.12 +open Type;
   32.13 +
   32.14 +val simp_type_defs = [Subtype_def,Unit_def,Bool_def,Plus_def,Sigma_def,Pi_def,
   32.15 +                      Lift_def,Tall_def,Tex_def];
   32.16 +val ind_type_defs = [Nat_def,List_def];
   32.17 +
   32.18 +val simp_data_defs = [one_def,inl_def,inr_def];
   32.19 +val ind_data_defs = [zero_def,succ_def,nil_def,cons_def];
   32.20 +
   32.21 +goal Set.thy "A <= B <-> (ALL x.x:A --> x:B)";
   32.22 +by (fast_tac set_cs 1);
   32.23 +val subsetXH = result();
   32.24 +
   32.25 +(*** Exhaustion Rules ***)
   32.26 +
   32.27 +fun mk_XH_tac thy defs rls s = prove_goalw thy defs s (fn _ => [cfast_tac rls 1]);
   32.28 +val XH_tac = mk_XH_tac Type.thy simp_type_defs [];
   32.29 +
   32.30 +val EmptyXH = XH_tac "a : {} <-> False";
   32.31 +val SubtypeXH = XH_tac "a : {x:A.P(x)} <-> (a:A & P(a))";
   32.32 +val UnitXH = XH_tac "a : Unit          <-> a=one";
   32.33 +val BoolXH = XH_tac "a : Bool          <-> a=true | a=false";
   32.34 +val PlusXH = XH_tac "a : A+B           <-> (EX x:A.a=inl(x)) | (EX x:B.a=inr(x))";
   32.35 +val PiXH   = XH_tac "a : PROD x:A.B(x) <-> (EX b.a=lam x.b(x) & (ALL x:A.b(x):B(x)))";
   32.36 +val SgXH   = XH_tac "a : SUM x:A.B(x)  <-> (EX x:A.EX y:B(x).a=<x,y>)";
   32.37 +
   32.38 +val XHs = [EmptyXH,SubtypeXH,UnitXH,BoolXH,PlusXH,PiXH,SgXH];
   32.39 +
   32.40 +val LiftXH = XH_tac "a : [A] <-> (a=bot | a:A)";
   32.41 +val TallXH = XH_tac "a : TALL X.B(X) <-> (ALL X. a:B(X))";
   32.42 +val TexXH  = XH_tac "a : TEX X.B(X) <-> (EX X. a:B(X))";
   32.43 +
   32.44 +val case_rls = XH_to_Es XHs;
   32.45 +
   32.46 +(*** Canonical Type Rules ***)
   32.47 +
   32.48 +fun mk_canT_tac thy xhs s = prove_goal thy s 
   32.49 +                 (fn prems => [fast_tac (set_cs addIs (prems @ (xhs RL [iffD2]))) 1]);
   32.50 +val canT_tac = mk_canT_tac Type.thy XHs;
   32.51 +
   32.52 +val oneT   = canT_tac "one : Unit";
   32.53 +val trueT  = canT_tac "true : Bool";
   32.54 +val falseT = canT_tac "false : Bool";
   32.55 +val lamT   = canT_tac "[| !!x.x:A ==> b(x):B(x) |] ==> lam x.b(x) : Pi(A,B)";
   32.56 +val pairT  = canT_tac "[| a:A; b:B(a) |] ==> <a,b>:Sigma(A,B)";
   32.57 +val inlT   = canT_tac "a:A ==> inl(a) : A+B";
   32.58 +val inrT   = canT_tac "b:B ==> inr(b) : A+B";
   32.59 +
   32.60 +val canTs = [oneT,trueT,falseT,pairT,lamT,inlT,inrT];
   32.61 +
   32.62 +(*** Non-Canonical Type Rules ***)
   32.63 +
   32.64 +local
   32.65 +val lemma = prove_goal Type.thy "[| a:B(u);  u=v |] ==> a : B(v)"
   32.66 +                   (fn prems => [cfast_tac prems 1]);
   32.67 +in
   32.68 +fun mk_ncanT_tac thy defs top_crls crls s = prove_goalw thy defs s 
   32.69 +  (fn major::prems => [(resolve_tac ([major] RL top_crls) 1),
   32.70 +                       (REPEAT_SOME (eresolve_tac (crls @ [exE,bexE,conjE,disjE]))),
   32.71 +                       (ALLGOALS (ASM_SIMP_TAC term_ss)),
   32.72 +                       (ALLGOALS (ares_tac (prems RL [lemma]) ORELSE' 
   32.73 +                                  eresolve_tac [bspec])),
   32.74 +                       (safe_tac (ccl_cs addSIs prems))]);
   32.75 +end;
   32.76 +
   32.77 +val ncanT_tac = mk_ncanT_tac Type.thy [] case_rls case_rls;
   32.78 +
   32.79 +val ifT = ncanT_tac 
   32.80 +     "[| b:Bool; b=true ==> t:A(true); b=false ==> u:A(false) |] ==> \
   32.81 +\     if b then t else u : A(b)";
   32.82 +
   32.83 +val applyT = ncanT_tac 
   32.84 +    "[| f : Pi(A,B);  a:A |] ==> f ` a : B(a)";
   32.85 +
   32.86 +val splitT = ncanT_tac 
   32.87 +    "[| p:Sigma(A,B); !!x y. [| x:A;  y:B(x); p=<x,y>  |] ==> c(x,y):C(<x,y>) |] ==>  \
   32.88 +\     split(p,c):C(p)";
   32.89 +
   32.90 +val whenT = ncanT_tac 
   32.91 +     "[| p:A+B; !!x.[| x:A;  p=inl(x) |] ==> a(x):C(inl(x)); \
   32.92 +\               !!y.[| y:B;  p=inr(y) |] ==> b(y):C(inr(y)) |] ==> \
   32.93 +\     when(p,a,b) : C(p)";
   32.94 +
   32.95 +val ncanTs = [ifT,applyT,splitT,whenT];
   32.96 +
   32.97 +(*** Subtypes ***)
   32.98 +
   32.99 +val SubtypeD1 = standard ((SubtypeXH RS iffD1) RS conjunct1);
  32.100 +val SubtypeD2 = standard ((SubtypeXH RS iffD1) RS conjunct2);
  32.101 +
  32.102 +val prems = goal Type.thy
  32.103 +     "[| a:A;  P(a) |] ==> a : {x:A. P(x)}";
  32.104 +by (REPEAT (resolve_tac (prems@[SubtypeXH RS iffD2,conjI]) 1));
  32.105 +val SubtypeI = result();
  32.106 +
  32.107 +val prems = goal Type.thy
  32.108 +     "[| a : {x:A. P(x)};  [| a:A;  P(a) |] ==> Q |] ==> Q";
  32.109 +by (REPEAT (resolve_tac (prems@[SubtypeD1,SubtypeD2]) 1));
  32.110 +val SubtypeE = result();
  32.111 +
  32.112 +(*** Monotonicity ***)
  32.113 +
  32.114 +goal Type.thy "mono (%X.X)";
  32.115 +by (REPEAT (ares_tac [monoI] 1));
  32.116 +val idM = result();
  32.117 +
  32.118 +goal Type.thy "mono(%X.A)";
  32.119 +by (REPEAT (ares_tac [monoI,subset_refl] 1));
  32.120 +val constM = result();
  32.121 +
  32.122 +val major::prems = goal Type.thy
  32.123 +    "mono(%X.A(X)) ==> mono(%X.[A(X)])";
  32.124 +br (subsetI RS monoI) 1;
  32.125 +bd (LiftXH RS iffD1) 1;
  32.126 +be disjE 1;
  32.127 +be (disjI1 RS (LiftXH RS iffD2)) 1;
  32.128 +br (disjI2 RS (LiftXH RS iffD2)) 1;
  32.129 +be (major RS monoD RS subsetD) 1;
  32.130 +ba 1;
  32.131 +val LiftM = result();
  32.132 +
  32.133 +val prems = goal Type.thy
  32.134 +    "[| mono(%X.A(X)); !!x X. x:A(X) ==> mono(%X.B(X,x)) |] ==> \
  32.135 +\    mono(%X.Sigma(A(X),B(X)))";
  32.136 +by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE
  32.137 +            eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE
  32.138 +            (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE
  32.139 +            hyp_subst_tac 1));
  32.140 +val SgM = result();
  32.141 +
  32.142 +val prems = goal Type.thy
  32.143 +    "[| !!x. x:A ==> mono(%X.B(X,x)) |] ==> mono(%X.Pi(A,B(X)))";
  32.144 +by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE
  32.145 +            eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE
  32.146 +            (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE
  32.147 +            hyp_subst_tac 1));
  32.148 +val PiM = result();
  32.149 +
  32.150 +val prems = goal Type.thy
  32.151 +     "[| mono(%X.A(X));  mono(%X.B(X)) |] ==> mono(%X.A(X)+B(X))";
  32.152 +by (REPEAT (ares_tac ([subsetI RS monoI] @ canTs) 1 ORELSE
  32.153 +            eresolve_tac ([bspec,exE,conjE,disjE,bexE] @ case_rls) 1 ORELSE
  32.154 +            (resolve_tac (prems RL [monoD RS subsetD]) 1 THEN assume_tac 1) ORELSE
  32.155 +            hyp_subst_tac 1));
  32.156 +val PlusM = result();
  32.157 +
  32.158 +(**************** RECURSIVE TYPES ******************)
  32.159 +
  32.160 +(*** Conversion Rules for Fixed Points via monotonicity and Tarski ***)
  32.161 +
  32.162 +goal Type.thy "mono(%X.Unit+X)";
  32.163 +by (REPEAT (ares_tac [PlusM,constM,idM] 1));
  32.164 +val NatM = result();
  32.165 +val def_NatB = result() RS (Nat_def RS def_lfp_Tarski);
  32.166 +
  32.167 +goal Type.thy "mono(%X.(Unit+Sigma(A,%y.X)))";
  32.168 +by (REPEAT (ares_tac [PlusM,SgM,constM,idM] 1));
  32.169 +val ListM = result();
  32.170 +val def_ListB = result() RS (List_def RS def_lfp_Tarski);
  32.171 +val def_ListsB = result() RS (Lists_def RS def_gfp_Tarski);
  32.172 +
  32.173 +goal Type.thy "mono(%X.({} + Sigma(A,%y.X)))";
  32.174 +by (REPEAT (ares_tac [PlusM,SgM,constM,idM] 1));
  32.175 +val IListsM = result();
  32.176 +val def_IListsB = result() RS (ILists_def RS def_gfp_Tarski);
  32.177 +
  32.178 +val ind_type_eqs = [def_NatB,def_ListB,def_ListsB,def_IListsB];
  32.179 +
  32.180 +(*** Exhaustion Rules ***)
  32.181 +
  32.182 +fun mk_iXH_tac teqs ddefs rls s = prove_goalw Type.thy ddefs s 
  32.183 +           (fn _ => [resolve_tac (teqs RL [XHlemma1]) 1,
  32.184 +                     fast_tac (set_cs addSIs canTs addSEs case_rls) 1]);
  32.185 +
  32.186 +val iXH_tac = mk_iXH_tac ind_type_eqs ind_data_defs [];
  32.187 +
  32.188 +val NatXH  = iXH_tac "a : Nat <-> (a=zero | (EX x:Nat.a=succ(x)))";
  32.189 +val ListXH = iXH_tac "a : List(A) <-> (a=[] | (EX x:A.EX xs:List(A).a=x.xs))";
  32.190 +val ListsXH = iXH_tac "a : Lists(A) <-> (a=[] | (EX x:A.EX xs:Lists(A).a=x.xs))";
  32.191 +val IListsXH = iXH_tac "a : ILists(A) <-> (EX x:A.EX xs:ILists(A).a=x.xs)";
  32.192 +
  32.193 +val iXHs = [NatXH,ListXH];
  32.194 +val icase_rls = XH_to_Es iXHs;
  32.195 +
  32.196 +(*** Type Rules ***)
  32.197 +
  32.198 +val icanT_tac = mk_canT_tac Type.thy iXHs;
  32.199 +val incanT_tac = mk_ncanT_tac Type.thy [] icase_rls case_rls;
  32.200 +
  32.201 +val zeroT = icanT_tac "zero : Nat";
  32.202 +val succT = icanT_tac "n:Nat ==> succ(n) : Nat";
  32.203 +val nilT  = icanT_tac "[] : List(A)";
  32.204 +val consT = icanT_tac "[| h:A;  t:List(A) |] ==> h.t : List(A)";
  32.205 +
  32.206 +val icanTs = [zeroT,succT,nilT,consT];
  32.207 +
  32.208 +val ncaseT = incanT_tac 
  32.209 +     "[| n:Nat; n=zero ==> b:C(zero); \
  32.210 +\        !!x.[| x:Nat;  n=succ(x) |] ==> c(x):C(succ(x)) |] ==>  \
  32.211 +\     ncase(n,b,c) : C(n)";
  32.212 +
  32.213 +val lcaseT = incanT_tac
  32.214 +     "[| l:List(A); l=[] ==> b:C([]); \
  32.215 +\        !!h t.[| h:A;  t:List(A); l=h.t |] ==> c(h,t):C(h.t) |] ==> \
  32.216 +\     lcase(l,b,c) : C(l)";
  32.217 +
  32.218 +val incanTs = [ncaseT,lcaseT];
  32.219 +
  32.220 +(*** Induction Rules ***)
  32.221 +
  32.222 +val ind_Ms = [NatM,ListM];
  32.223 +
  32.224 +fun mk_ind_tac ddefs tdefs Ms canTs case_rls s = prove_goalw Type.thy ddefs s 
  32.225 +     (fn major::prems => [resolve_tac (Ms RL ([major] RL (tdefs RL [def_induct]))) 1,
  32.226 +                          fast_tac (set_cs addSIs (prems @ canTs) addSEs case_rls) 1]);
  32.227 +
  32.228 +val ind_tac = mk_ind_tac ind_data_defs ind_type_defs ind_Ms canTs case_rls;
  32.229 +
  32.230 +val Nat_ind = ind_tac
  32.231 +     "[| n:Nat; P(zero); !!x.[| x:Nat; P(x) |] ==> P(succ(x)) |] ==>  \
  32.232 +\     P(n)";
  32.233 +
  32.234 +val List_ind = ind_tac
  32.235 +     "[| l:List(A); P([]); \
  32.236 +\        !!x xs.[| x:A;  xs:List(A); P(xs) |] ==> P(x.xs) |] ==> \
  32.237 +\     P(l)";
  32.238 +
  32.239 +val inds = [Nat_ind,List_ind];
  32.240 +
  32.241 +(*** Primitive Recursive Rules ***)
  32.242 +
  32.243 +fun mk_prec_tac inds s = prove_goal Type.thy s
  32.244 +     (fn major::prems => [resolve_tac ([major] RL inds) 1,
  32.245 +                          ALLGOALS (SIMP_TAC term_ss THEN'
  32.246 +                                    fast_tac (set_cs addSIs prems))]);
  32.247 +val prec_tac = mk_prec_tac inds;
  32.248 +
  32.249 +val nrecT = prec_tac
  32.250 +     "[| n:Nat; b:C(zero); \
  32.251 +\        !!x g.[| x:Nat; g:C(x) |] ==> c(x,g):C(succ(x)) |] ==>  \
  32.252 +\     nrec(n,b,c) : C(n)";
  32.253 +
  32.254 +val lrecT = prec_tac
  32.255 +     "[| l:List(A); b:C([]); \
  32.256 +\        !!x xs g.[| x:A;  xs:List(A); g:C(xs) |] ==> c(x,xs,g):C(x.xs) |] ==>  \
  32.257 +\     lrec(l,b,c) : C(l)";
  32.258 +
  32.259 +val precTs = [nrecT,lrecT];
  32.260 +
  32.261 +
  32.262 +(*** Theorem proving ***)
  32.263 +
  32.264 +val [major,minor] = goal Type.thy
  32.265 +    "[| <a,b> : Sigma(A,B);  [| a:A;  b:B(a) |] ==> P   \
  32.266 +\    |] ==> P";
  32.267 +br (major RS (XH_to_E SgXH)) 1;
  32.268 +br minor 1;
  32.269 +by (ALLGOALS (fast_tac term_cs));
  32.270 +val SgE2 = result();
  32.271 +
  32.272 +(* General theorem proving ignores non-canonical term-formers,             *)
  32.273 +(*         - intro rules are type rules for canonical terms                *)
  32.274 +(*         - elim rules are case rules (no non-canonical terms appear)     *)
  32.275 +
  32.276 +val type_cs = term_cs addSIs (SubtypeI::(canTs @ icanTs))
  32.277 +                      addSEs (SubtypeE::(XH_to_Es XHs));
  32.278 +
  32.279 +
  32.280 +(*** Infinite Data Types ***)
  32.281 +
  32.282 +val [mono] = goal Type.thy "mono(f) ==> lfp(f) <= gfp(f)";
  32.283 +br (lfp_lowerbound RS subset_trans) 1;
  32.284 +br (mono RS gfp_lemma3) 1;
  32.285 +br subset_refl 1;
  32.286 +val lfp_subset_gfp = result();
  32.287 +
  32.288 +val prems = goal Type.thy
  32.289 +    "[| a:A;  !!x X.[| x:A;  ALL y:A.t(y):X |] ==> t(x) : B(X) |] ==> \
  32.290 +\    t(a) : gfp(B)";
  32.291 +br coinduct 1;
  32.292 +by (res_inst_tac [("P","%x.EX y:A.x=t(y)")] CollectI 1);
  32.293 +by (ALLGOALS (fast_tac (ccl_cs addSIs prems)));
  32.294 +val gfpI = result();
  32.295 +
  32.296 +val rew::prem::prems = goal Type.thy
  32.297 +    "[| C==gfp(B);  a:A;  !!x X.[| x:A;  ALL y:A.t(y):X |] ==> t(x) : B(X) |] ==> \
  32.298 +\    t(a) : C";
  32.299 +by (rewtac rew);
  32.300 +by (REPEAT (ares_tac ((prem RS gfpI)::prems) 1));
  32.301 +val def_gfpI = result();
  32.302 +
  32.303 +(* EG *)
  32.304 +
  32.305 +val prems = goal Type.thy 
  32.306 +    "letrec g x be zero.g(x) in g(bot) : Lists(Nat)";
  32.307 +by (rtac (refl RS (XH_to_I UnitXH) RS (Lists_def RS def_gfpI)) 1);
  32.308 +br (letrecB RS ssubst) 1;
  32.309 +bw cons_def;
  32.310 +by (fast_tac type_cs 1);
  32.311 +result();
    33.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    33.2 +++ b/src/CCL/Type.thy	Thu Sep 16 12:20:38 1993 +0200
    33.3 @@ -0,0 +1,73 @@
    33.4 +(*  Title:      CCL/types.thy
    33.5 +    ID:         $Id$
    33.6 +    Author:     Martin Coen
    33.7 +    Copyright   1993  University of Cambridge
    33.8 +
    33.9 +Types in CCL are defined as sets of terms.
   33.10 +
   33.11 +*)
   33.12 +
   33.13 +Type = Term +
   33.14 +
   33.15 +consts
   33.16 +
   33.17 +  Subtype       :: "['a set, 'a => o] => 'a set"
   33.18 +  Bool          :: "i set"
   33.19 +  Unit          :: "i set"
   33.20 +  "+"           :: "[i set, i set] => i set"            (infixr 55)
   33.21 +  Pi            :: "[i set, i => i set] => i set"
   33.22 +  Sigma         :: "[i set, i => i set] => i set"
   33.23 +  Nat           :: "i set"
   33.24 +  List          :: "i set => i set"
   33.25 +  Lists         :: "i set => i set"
   33.26 +  ILists        :: "i set => i set"
   33.27 +  TAll          :: "(i set => i set) => i set"          (binder "TALL " 55)
   33.28 +  TEx           :: "(i set => i set) => i set"          (binder "TEX " 55)
   33.29 +  Lift          :: "i set => i set"                     ("(3[_])")
   33.30 +
   33.31 +  SPLIT         :: "[i, [i, i] => i set] => i set"
   33.32 +
   33.33 +  "@Pi"         :: "[idt, i set, i set] => i set"       ("(3PROD _:_./ _)" [] 60)
   33.34 +  "@Sigma"      :: "[idt, i set, i set] => i set"       ("(3SUM _:_./ _)" [] 60)
   33.35 +  "@->"         :: "[i set, i set] => i set"            ("(_ ->/ _)"  [54, 53] 53)
   33.36 +  "@*"          :: "[i set, i set] => i set"            ("(_ */ _)" [56, 55] 55)
   33.37 +  "@Subtype"    :: "[idt, 'a set, o] => 'a set"         ("(1{_: _ ./ _})")
   33.38 +
   33.39 +translations
   33.40 +  "PROD x:A. B" => "Pi(A, %x. B)"
   33.41 +  "SUM x:A. B"  => "Sigma(A, %x. B)"
   33.42 +  "{x: A. B}"   == "Subtype(A, %x. B)"
   33.43 +
   33.44 +rules
   33.45 +
   33.46 +  Subtype_def "{x:A.P(x)} == {x.x:A & P(x)}"
   33.47 +  Unit_def          "Unit == {x.x=one}"
   33.48 +  Bool_def          "Bool == {x.x=true | x=false}"
   33.49 +  Plus_def           "A+B == {x. (EX a:A.x=inl(a)) | (EX b:B.x=inr(b))}"
   33.50 +  Pi_def         "Pi(A,B) == {x.EX b.x=lam x.b(x) & (ALL x:A.b(x):B(x))}"
   33.51 +  Sigma_def   "Sigma(A,B) == {x.EX a:A.EX b:B(a).x=<a,b>}"
   33.52 +  Nat_def            "Nat == lfp(% X.Unit + X)"
   33.53 +  List_def       "List(A) == lfp(% X.Unit + A*X)"
   33.54 +
   33.55 +  Lists_def     "Lists(A) == gfp(% X.Unit + A*X)"
   33.56 +  ILists_def   "ILists(A) == gfp(% X.{} + A*X)"
   33.57 +
   33.58 +  Tall_def   "TALL X.B(X) == Inter({X.EX Y.X=B(Y)})"
   33.59 +  Tex_def     "TEX X.B(X) == Union({X.EX Y.X=B(Y)})"
   33.60 +  Lift_def           "[A] == A Un {bot}"
   33.61 +
   33.62 +  SPLIT_def   "SPLIT(p,B) == Union({A.EX x y.p=<x,y> & A=B(x,y)})"
   33.63 +
   33.64 +end
   33.65 +
   33.66 +
   33.67 +ML
   33.68 +
   33.69 +val parse_translation =
   33.70 +  [("@->", ndependent_tr "Pi"),
   33.71 +   ("@*", ndependent_tr "Sigma")];
   33.72 +
   33.73 +val print_translation =
   33.74 +  [("Pi", dependent_tr' ("@Pi", "@->")),
   33.75 +   ("Sigma", dependent_tr' ("@Sigma", "@*"))];
   33.76 +
    34.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    34.2 +++ b/src/CCL/Wfd.ML	Thu Sep 16 12:20:38 1993 +0200
    34.3 @@ -0,0 +1,208 @@
    34.4 +(*  Title: 	CCL/wf
    34.5 +    ID:         $Id$
    34.6 +
    34.7 +For wf.thy.
    34.8 +
    34.9 +Based on
   34.10 +    Titles: 	ZF/wf.ML and HOL/ex/lex-prod
   34.11 +    Authors: 	Lawrence C Paulson and Tobias Nipkow
   34.12 +    Copyright   1992  University of Cambridge
   34.13 +
   34.14 +*)
   34.15 +
   34.16 +open Wfd;
   34.17 +
   34.18 +(***********)
   34.19 +
   34.20 +val wfd_congs = mk_congs Wfd.thy ["Wfd","wf","op **","wmap","ListPR"];
   34.21 +
   34.22 +(***********)
   34.23 +
   34.24 +val [major,prem] = goalw Wfd.thy [Wfd_def]
   34.25 +    "[| Wfd(R);       \
   34.26 +\       !!x.[| ALL y. <y,x>: R --> P(y) |] ==> P(x) |]  ==>  \
   34.27 +\    P(a)";
   34.28 +by (rtac (major RS spec RS mp RS spec RS CollectD) 1);
   34.29 +by (fast_tac (set_cs addSIs [prem RS CollectI]) 1);
   34.30 +val wfd_induct = result();
   34.31 +
   34.32 +val [p1,p2,p3] = goal Wfd.thy
   34.33 +    "[| !!x y.<x,y> : R ==> Q(x); \
   34.34 +\       ALL x. (ALL y. <y,x> : R --> y : P) --> x : P; \
   34.35 +\       !!x.Q(x) ==> x:P |] ==> a:P";
   34.36 +br (p2 RS  spec  RS mp) 1;
   34.37 +by (fast_tac (set_cs addSIs [p1 RS p3]) 1);
   34.38 +val wfd_strengthen_lemma = result();
   34.39 +
   34.40 +fun wfd_strengthen_tac s i = res_inst_tac [("Q",s)] wfd_strengthen_lemma i THEN
   34.41 +                             assume_tac (i+1);
   34.42 +
   34.43 +val wfd::prems = goal Wfd.thy "[| Wfd(r);  <a,x>:r;  <x,a>:r |] ==> P";
   34.44 +by (subgoal_tac "ALL x. <a,x>:r --> <x,a>:r --> P" 1);
   34.45 +by (fast_tac (FOL_cs addIs prems) 1);
   34.46 +br (wfd RS  wfd_induct) 1;
   34.47 +by (ALLGOALS (fast_tac (ccl_cs addSIs prems)));
   34.48 +val wf_anti_sym = result();
   34.49 +
   34.50 +val prems = goal Wfd.thy "[| Wfd(r);  <a,a>: r |] ==> P";
   34.51 +by (rtac wf_anti_sym 1);
   34.52 +by (REPEAT (resolve_tac prems 1));
   34.53 +val wf_anti_refl = result();
   34.54 +
   34.55 +(*** Irreflexive transitive closure ***)
   34.56 +
   34.57 +val [prem] = goal Wfd.thy "Wfd(R) ==> Wfd(R^+)";
   34.58 +by (rewtac Wfd_def);
   34.59 +by (REPEAT (ares_tac [allI,ballI,impI] 1));
   34.60 +(*must retain the universal formula for later use!*)
   34.61 +by (rtac allE 1 THEN assume_tac 1);
   34.62 +by (etac mp 1);
   34.63 +br (prem RS wfd_induct) 1;
   34.64 +by (rtac (impI RS allI) 1);
   34.65 +by (etac tranclE 1);
   34.66 +by (fast_tac ccl_cs 1);
   34.67 +be (spec RS mp RS spec RS mp) 1;
   34.68 +by (REPEAT (atac 1));
   34.69 +val trancl_wf = result();
   34.70 +
   34.71 +(*** Lexicographic Ordering ***)
   34.72 +
   34.73 +goalw Wfd.thy [lex_def] 
   34.74 + "p : ra**rb <-> (EX a a' b b'.p = <<a,b>,<a',b'>> & (<a,a'> : ra | a=a' & <b,b'> : rb))";
   34.75 +by (fast_tac ccl_cs 1);
   34.76 +val lexXH = result();
   34.77 +
   34.78 +val prems = goal Wfd.thy
   34.79 + "<a,a'> : ra ==> <<a,b>,<a',b'>> : ra**rb";
   34.80 +by (fast_tac (ccl_cs addSIs (prems @ [lexXH RS iffD2])) 1);
   34.81 +val lexI1 = result();
   34.82 +
   34.83 +val prems = goal Wfd.thy
   34.84 + "<b,b'> : rb ==> <<a,b>,<a,b'>> : ra**rb";
   34.85 +by (fast_tac (ccl_cs addSIs (prems @ [lexXH RS iffD2])) 1);
   34.86 +val lexI2 = result();
   34.87 +
   34.88 +val major::prems = goal Wfd.thy
   34.89 + "[| p : ra**rb;  \
   34.90 +\    !!a a' b b'.[| <a,a'> : ra; p=<<a,b>,<a',b'>> |] ==> R;  \
   34.91 +\    !!a b b'.[| <b,b'> : rb;  p = <<a,b>,<a,b'>> |] ==> R  |] ==> \
   34.92 +\ R";
   34.93 +br (major RS (lexXH RS iffD1) RS exE) 1;
   34.94 +by (REPEAT_SOME (eresolve_tac ([exE,conjE,disjE]@prems)));
   34.95 +by (ALLGOALS (fast_tac ccl_cs));
   34.96 +val lexE = result();
   34.97 +
   34.98 +val [major,minor] = goal Wfd.thy
   34.99 + "[| p : r**s;  !!a a' b b'. p = <<a,b>,<a',b'>> ==> P |] ==>P";
  34.100 +br (major RS lexE) 1;
  34.101 +by (ALLGOALS (fast_tac (set_cs addSEs [minor])));
  34.102 +val lex_pair = result();
  34.103 +
  34.104 +val [wfa,wfb] = goal Wfd.thy
  34.105 + "[| Wfd(R); Wfd(S) |] ==> Wfd(R**S)";
  34.106 +bw Wfd_def;
  34.107 +by (safe_tac ccl_cs);
  34.108 +by (wfd_strengthen_tac "%x.EX a b.x=<a,b>" 1);
  34.109 +by (fast_tac (term_cs addSEs [lex_pair]) 1);
  34.110 +by (subgoal_tac "ALL a b.<a,b>:P" 1);
  34.111 +by (fast_tac ccl_cs 1);
  34.112 +br (wfa RS wfd_induct RS allI) 1;
  34.113 +br (wfb RS wfd_induct RS allI) 1;back();
  34.114 +by (fast_tac (type_cs addSEs [lexE]) 1);
  34.115 +val lex_wf = result();
  34.116 +
  34.117 +(*** Mapping ***)
  34.118 +
  34.119 +goalw Wfd.thy [wmap_def] 
  34.120 + "p : wmap(f,r) <-> (EX x y. p=<x,y>  &  <f(x),f(y)> : r)";
  34.121 +by (fast_tac ccl_cs 1);
  34.122 +val wmapXH = result();
  34.123 +
  34.124 +val prems = goal Wfd.thy
  34.125 + "<f(a),f(b)> : r ==> <a,b> : wmap(f,r)";
  34.126 +by (fast_tac (ccl_cs addSIs (prems @ [wmapXH RS iffD2])) 1);
  34.127 +val wmapI = result();
  34.128 +
  34.129 +val major::prems = goal Wfd.thy
  34.130 + "[| p : wmap(f,r);  !!a b.[| <f(a),f(b)> : r;  p=<a,b> |] ==> R |] ==> R";
  34.131 +br (major RS (wmapXH RS iffD1) RS exE) 1;
  34.132 +by (REPEAT_SOME (eresolve_tac ([exE,conjE,disjE]@prems)));
  34.133 +by (ALLGOALS (fast_tac ccl_cs));
  34.134 +val wmapE = result();
  34.135 +
  34.136 +val [wf] = goal Wfd.thy
  34.137 + "Wfd(r) ==> Wfd(wmap(f,r))";
  34.138 +bw Wfd_def;
  34.139 +by (safe_tac ccl_cs);
  34.140 +by (subgoal_tac "ALL b.ALL a.f(a)=b-->a:P" 1);
  34.141 +by (fast_tac ccl_cs 1);
  34.142 +br (wf RS wfd_induct RS allI) 1;
  34.143 +by (safe_tac ccl_cs);
  34.144 +be (spec RS mp) 1;
  34.145 +by (safe_tac (ccl_cs addSEs [wmapE]));
  34.146 +be (spec RS mp RS spec RS mp) 1;
  34.147 +ba 1;
  34.148 +br refl 1;
  34.149 +val wmap_wf = result();
  34.150 +
  34.151 +(* Projections *)
  34.152 +
  34.153 +val prems = goal Wfd.thy "<xa,ya> : r ==> <<xa,xb>,<ya,yb>> : wmap(fst,r)";
  34.154 +br wmapI 1;
  34.155 +by (SIMP_TAC (term_ss addrews prems) 1);
  34.156 +val wfstI = result();
  34.157 +
  34.158 +val prems = goal Wfd.thy "<xb,yb> : r ==> <<xa,xb>,<ya,yb>> : wmap(snd,r)";
  34.159 +br wmapI 1;
  34.160 +by (SIMP_TAC (term_ss addrews prems) 1);
  34.161 +val wsndI = result();
  34.162 +
  34.163 +val prems = goal Wfd.thy "<xc,yc> : r ==> <<xa,<xb,xc>>,<ya,<yb,yc>>> : wmap(thd,r)";
  34.164 +br wmapI 1;
  34.165 +by (SIMP_TAC (term_ss addrews prems) 1);
  34.166 +val wthdI = result();
  34.167 +
  34.168 +(*** Ground well-founded relations ***)
  34.169 +
  34.170 +val prems = goalw Wfd.thy [wf_def] 
  34.171 +    "[| Wfd(r);  a : r |] ==> a : wf(r)";
  34.172 +by (fast_tac (set_cs addSIs prems) 1);
  34.173 +val wfI = result();
  34.174 +
  34.175 +val prems = goalw Wfd.thy [Wfd_def] "Wfd({})";
  34.176 +by (fast_tac (set_cs addEs [EmptyXH RS iffD1 RS FalseE]) 1);
  34.177 +val Empty_wf = result();
  34.178 +
  34.179 +val prems = goalw Wfd.thy [wf_def] "Wfd(wf(R))";
  34.180 +by (res_inst_tac [("Q","Wfd(R)")] (excluded_middle RS disjE) 1);
  34.181 +by (ALLGOALS (ASM_SIMP_TAC (CCL_ss addcongs wfd_congs)));
  34.182 +br Empty_wf 1;
  34.183 +val wf_wf = result();
  34.184 +
  34.185 +goalw Wfd.thy [NatPR_def]  "p : NatPR <-> (EX x:Nat.p=<x,succ(x)>)";
  34.186 +by (fast_tac set_cs 1);
  34.187 +val NatPRXH = result();
  34.188 +
  34.189 +goalw Wfd.thy [ListPR_def]  "p : ListPR(A) <-> (EX h:A.EX t:List(A).p=<t,h.t>)";
  34.190 +by (fast_tac set_cs 1);
  34.191 +val ListPRXH = result();
  34.192 +
  34.193 +val NatPRI = refl RS (bexI RS (NatPRXH RS iffD2));
  34.194 +val ListPRI = refl RS (bexI RS (bexI RS (ListPRXH RS iffD2)));
  34.195 +
  34.196 +goalw Wfd.thy [Wfd_def]  "Wfd(NatPR)";
  34.197 +by (safe_tac set_cs);
  34.198 +by (wfd_strengthen_tac "%x.x:Nat" 1);
  34.199 +by (fast_tac (type_cs addSEs [XH_to_E NatPRXH]) 1);
  34.200 +be Nat_ind 1;
  34.201 +by (ALLGOALS (fast_tac (type_cs addEs [XH_to_E NatPRXH])));
  34.202 +val NatPR_wf = result();
  34.203 +
  34.204 +goalw Wfd.thy [Wfd_def]  "Wfd(ListPR(A))";
  34.205 +by (safe_tac set_cs);
  34.206 +by (wfd_strengthen_tac "%x.x:List(A)" 1);
  34.207 +by (fast_tac (type_cs addSEs [XH_to_E ListPRXH]) 1);
  34.208 +be List_ind 1;
  34.209 +by (ALLGOALS (fast_tac (type_cs addEs [XH_to_E ListPRXH])));
  34.210 +val ListPR_wf = result();
  34.211 +
    35.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    35.2 +++ b/src/CCL/Wfd.thy	Thu Sep 16 12:20:38 1993 +0200
    35.3 @@ -0,0 +1,34 @@
    35.4 +(*  Title: 	CCL/wf.thy
    35.5 +    ID:         $Id$
    35.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    35.7 +    Copyright   1993  University of Cambridge
    35.8 +
    35.9 +Well-founded relations in CCL.
   35.10 +*)
   35.11 +
   35.12 +Wfd = Trancl + Type +
   35.13 +
   35.14 +consts
   35.15 +      (*** Predicates ***)
   35.16 +  Wfd        ::       "[i set] => o"
   35.17 +      (*** Relations ***)
   35.18 +  wf         ::       "[i set] => i set"
   35.19 +  wmap       ::       "[i=>i,i set] => i set"
   35.20 +  "**"       ::       "[i set,i set] => i set"      (infixl 70)
   35.21 +  NatPR      ::       "i set"
   35.22 +  ListPR     ::       "i set => i set"
   35.23 +
   35.24 +rules
   35.25 +
   35.26 +  Wfd_def
   35.27 +  "Wfd(R) == ALL P.(ALL x.(ALL y.<y,x> : R --> y:P) --> x:P) --> (ALL a.a:P)"
   35.28 +
   35.29 +  wf_def         "wf(R) == {x.x:R & Wfd(R)}"
   35.30 +
   35.31 +  wmap_def       "wmap(f,R) == {p. EX x y. p=<x,y>  &  <f(x),f(y)> : R}"
   35.32 +  lex_def
   35.33 +  "ra**rb == {p. EX a a' b b'.p = <<a,b>,<a',b'>> & (<a,a'> : ra | (a=a' & <b,b'> : rb))}"
   35.34 +
   35.35 +  NatPR_def      "NatPR == {p.EX x:Nat. p=<x,succ(x)>}"
   35.36 +  ListPR_def     "ListPR(A) == {p.EX h:A.EX t:List(A). p=<t,h.t>}"
   35.37 +end
    36.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    36.2 +++ b/src/CCL/ccl.ML	Thu Sep 16 12:20:38 1993 +0200
    36.3 @@ -0,0 +1,362 @@
    36.4 +(*  Title: 	CCL/ccl
    36.5 +    ID:         $Id$
    36.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    36.7 +    Copyright   1993  University of Cambridge
    36.8 +
    36.9 +For ccl.thy.
   36.10 +*)
   36.11 +
   36.12 +open CCL;
   36.13 +
   36.14 +val ccl_data_defs = [apply_def,fix_def];
   36.15 +
   36.16 +(*** Simplifier for pre-order and equality ***)
   36.17 +
   36.18 +structure CCL_SimpData : SIMP_DATA =
   36.19 +  struct
   36.20 +  val refl_thms		= [refl, po_refl, iff_refl]
   36.21 +  val trans_thms	= [trans, iff_trans, po_trans]
   36.22 +  val red1		= iffD1
   36.23 +  val red2		= iffD2
   36.24 +  val mk_rew_rules	= mk_rew_rules
   36.25 +  val case_splits	= []         (*NO IF'S!*)
   36.26 +  val norm_thms		= norm_thms
   36.27 +  val subst_thms	= [subst];
   36.28 +  val dest_red		= dest_red
   36.29 +  end;
   36.30 +
   36.31 +structure CCL_Simp = SimpFun(CCL_SimpData);
   36.32 +open CCL_Simp;
   36.33 +
   36.34 +val auto_ss = empty_ss setauto (fn hyps => ares_tac (TrueI::hyps));
   36.35 +
   36.36 +val po_refl_iff_T = make_iff_T po_refl;
   36.37 +
   36.38 +val CCL_ss = auto_ss addcongs (FOL_congs @ set_congs)
   36.39 +                     addrews  ([po_refl_iff_T] @ FOL_rews @ mem_rews);
   36.40 +
   36.41 +(*** Congruence Rules ***)
   36.42 +
   36.43 +(*similar to AP_THM in Gordon's HOL*)
   36.44 +val fun_cong = prove_goal CCL.thy "(f::'a=>'b) = g ==> f(x)=g(x)"
   36.45 +  (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
   36.46 +
   36.47 +(*similar to AP_TERM in Gordon's HOL and FOL's subst_context*)
   36.48 +val arg_cong = prove_goal CCL.thy "x=y ==> f(x)=f(y)"
   36.49 + (fn [prem] => [rtac (prem RS subst) 1, rtac refl 1]);
   36.50 +
   36.51 +goal CCL.thy  "(ALL x. f(x) = g(x)) --> (%x.f(x)) = (%x.g(x))";
   36.52 +by (SIMP_TAC (CCL_ss addrews [eq_iff]) 1);
   36.53 +by (fast_tac (set_cs addIs [po_abstractn]) 1);
   36.54 +val abstractn = standard (allI RS (result() RS mp));
   36.55 +
   36.56 +fun type_of_terms (Const("Trueprop",_) $ 
   36.57 +                   (Const("op =",(Type ("fun", [t,_]))) $ _ $ _)) = t;
   36.58 +
   36.59 +fun abs_prems thm = 
   36.60 +   let fun do_abs n thm (Type ("fun", [_,t])) = do_abs n (abstractn RSN (n,thm)) t
   36.61 +         | do_abs n thm _                     = thm
   36.62 +       fun do_prems n      [] thm = thm
   36.63 +         | do_prems n (x::xs) thm = do_prems (n+1) xs (do_abs n thm (type_of_terms x));
   36.64 +   in do_prems 1 (prems_of thm) thm
   36.65 +   end;
   36.66 +
   36.67 +fun ccl_mk_congs thy cs = map abs_prems (mk_congs thy cs); 
   36.68 +
   36.69 +val ccl_congs = ccl_mk_congs CCL.thy 
   36.70 + ["op [=","SIM","POgen","EQgen","pair","lambda","case","op `","fix"];
   36.71 +
   36.72 +val caseBs = [caseBtrue,caseBfalse,caseBpair,caseBlam,caseBbot];
   36.73 +
   36.74 +(*** Termination and Divergence ***)
   36.75 +
   36.76 +goalw CCL.thy [Trm_def,Dvg_def] "Trm(t) <-> ~ t = bot";
   36.77 +br iff_refl 1;
   36.78 +val Trm_iff = result();
   36.79 +
   36.80 +goalw CCL.thy [Trm_def,Dvg_def] "Dvg(t) <-> t = bot";
   36.81 +br iff_refl 1;
   36.82 +val Dvg_iff = result();
   36.83 +
   36.84 +(*** Constructors are injective ***)
   36.85 +
   36.86 +val prems = goal CCL.thy
   36.87 +    "[| x=a;  y=b;  x=y |] ==> a=b";
   36.88 +by  (REPEAT (SOMEGOAL (ares_tac (prems@[box_equals]))));
   36.89 +val eq_lemma = result();
   36.90 +
   36.91 +fun mk_inj_rl thy rews congs s = 
   36.92 +      let fun mk_inj_lemmas r = ([arg_cong] RL [(r RS (r RS eq_lemma))]);
   36.93 +          val inj_lemmas = flat (map mk_inj_lemmas rews);
   36.94 +          val tac = REPEAT (ares_tac [iffI,allI,conjI] 1 ORELSE
   36.95 +                            eresolve_tac inj_lemmas 1 ORELSE
   36.96 +                            ASM_SIMP_TAC (CCL_ss addrews rews 
   36.97 +                                                 addcongs congs) 1)
   36.98 +      in prove_goal thy s (fn _ => [tac])
   36.99 +      end;
  36.100 +
  36.101 +val ccl_injs = map (mk_inj_rl CCL.thy caseBs ccl_congs)
  36.102 +               ["<a,b> = <a',b'> <-> (a=a' & b=b')",
  36.103 +                "(lam x.b(x) = lam x.b'(x)) <-> ((ALL z.b(z)=b'(z)))"];
  36.104 +
  36.105 +val pair_inject = ((hd ccl_injs) RS iffD1) RS conjE;
  36.106 +
  36.107 +(*** Constructors are distinct ***)
  36.108 +
  36.109 +local
  36.110 +  fun pairs_of f x [] = []
  36.111 +    | pairs_of f x (y::ys) = (f x y) :: (f y x) :: (pairs_of f x ys);
  36.112 +
  36.113 +  fun mk_combs ff [] = []
  36.114 +    | mk_combs ff (x::xs) = (pairs_of ff x xs) @ mk_combs ff xs;
  36.115 +
  36.116 +(* Doesn't handle binder types correctly *)
  36.117 +  fun saturate thy sy name = 
  36.118 +       let fun arg_str 0 a s = s
  36.119 +         | arg_str 1 a s = "(" ^ a ^ "a" ^ s ^ ")"
  36.120 +         | arg_str n a s = arg_str (n-1) a ("," ^ a ^ (chr((ord "a")+n-1)) ^ s);
  36.121 +           val sg = sign_of thy;
  36.122 +           val T = case Sign.Symtab.lookup(#const_tab(Sign.rep_sg sg),sy) of
  36.123 +  		            None => error(sy^" not declared") | Some(T) => T;
  36.124 +           val arity = length (fst (strip_type T));
  36.125 +       in sy ^ (arg_str arity name "") end;
  36.126 +
  36.127 +  fun mk_thm_str thy a b = "~ " ^ (saturate thy a "a") ^ " = " ^ (saturate thy b "b");
  36.128 +
  36.129 +  val lemma = prove_goal CCL.thy "t=t' --> case(t,b,c,d,e) = case(t',b,c,d,e)"
  36.130 +                   (fn _ => [SIMP_TAC (CCL_ss addcongs ccl_congs) 1]) RS mp;
  36.131 +  fun mk_lemma (ra,rb) = [lemma] RL [ra RS (rb RS eq_lemma)] RL 
  36.132 +                           [distinctness RS notE,sym RS (distinctness RS notE)];
  36.133 +in
  36.134 +  fun mk_lemmas rls = flat (map mk_lemma (mk_combs pair rls));
  36.135 +  fun mk_dstnct_rls thy xs = mk_combs (mk_thm_str thy) xs;
  36.136 +end;
  36.137 +
  36.138 +
  36.139 +val caseB_lemmas = mk_lemmas caseBs;
  36.140 +
  36.141 +val ccl_dstncts = 
  36.142 +        let fun mk_raw_dstnct_thm rls s = 
  36.143 +                  prove_goal CCL.thy s (fn _=> [rtac notI 1,eresolve_tac rls 1])
  36.144 +        in map (mk_raw_dstnct_thm caseB_lemmas) 
  36.145 +                (mk_dstnct_rls CCL.thy ["bot","true","false","pair","lambda"]) end;
  36.146 +
  36.147 +fun mk_dstnct_thms thy defs inj_rls xs = 
  36.148 +          let fun mk_dstnct_thm rls s = prove_goalw thy defs s 
  36.149 +                               (fn _ => [SIMP_TAC (CCL_ss addrews (rls@inj_rls)) 1])
  36.150 +          in map (mk_dstnct_thm ccl_dstncts) (mk_dstnct_rls thy xs) end;
  36.151 +
  36.152 +fun mkall_dstnct_thms thy defs i_rls xss = flat (map (mk_dstnct_thms thy defs i_rls) xss);
  36.153 +
  36.154 +(*** Rewriting and Proving ***)
  36.155 +
  36.156 +fun XH_to_I rl = rl RS iffD2;
  36.157 +fun XH_to_D rl = rl RS iffD1;
  36.158 +val XH_to_E = make_elim o XH_to_D;
  36.159 +val XH_to_Is = map XH_to_I;
  36.160 +val XH_to_Ds = map XH_to_D;
  36.161 +val XH_to_Es = map XH_to_E;
  36.162 +
  36.163 +val ccl_rews = caseBs @ ccl_injs @ ccl_dstncts;
  36.164 +val ccl_ss = CCL_ss addrews ccl_rews addcongs ccl_congs;
  36.165 +
  36.166 +val ccl_cs = set_cs addSEs (pair_inject::(ccl_dstncts RL [notE])) 
  36.167 +                    addSDs (XH_to_Ds ccl_injs);
  36.168 +
  36.169 +(****** Facts from gfp Definition of [= and = ******)
  36.170 +
  36.171 +val major::prems = goal Set.thy "[| A=B;  a:B <-> P |] ==> a:A <-> P";
  36.172 +brs (prems RL [major RS ssubst]) 1;
  36.173 +val XHlemma1 = result();
  36.174 +
  36.175 +goal CCL.thy "(P(t,t') <-> Q) --> (<t,t'> : {p.EX t t'.p=<t,t'> &  P(t,t')} <-> Q)";
  36.176 +by (fast_tac ccl_cs 1);
  36.177 +val XHlemma2 = result() RS mp;
  36.178 +
  36.179 +(*** Pre-Order ***)
  36.180 +
  36.181 +goalw CCL.thy [POgen_def,SIM_def]  "mono(%X.POgen(X))";
  36.182 +br monoI 1;
  36.183 +by (safe_tac ccl_cs);
  36.184 +by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
  36.185 +by (ALLGOALS (SIMP_TAC ccl_ss));
  36.186 +by (ALLGOALS (fast_tac set_cs));
  36.187 +val POgen_mono = result();
  36.188 +
  36.189 +goalw CCL.thy [POgen_def,SIM_def]
  36.190 +  "<t,t'> : POgen(R) <-> t= bot | (t=true & t'=true)  | (t=false & t'=false) | \
  36.191 +\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
  36.192 +\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
  36.193 +br (iff_refl RS XHlemma2) 1;
  36.194 +val POgenXH = result();
  36.195 +
  36.196 +goal CCL.thy
  36.197 +  "t [= t' <-> t=bot | (t=true & t'=true) | (t=false & t'=false) | \
  36.198 +\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a [= a' & b [= b') | \
  36.199 +\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x) [= f'(x)))";
  36.200 +by (SIMP_TAC (ccl_ss addrews [PO_iff]) 1);
  36.201 +br (rewrite_rule [POgen_def,SIM_def] 
  36.202 +                 (POgen_mono RS (PO_def RS def_gfp_Tarski) RS XHlemma1)) 1;
  36.203 +br (iff_refl RS XHlemma2) 1;
  36.204 +val poXH = result();
  36.205 +
  36.206 +goal CCL.thy "bot [= b";
  36.207 +br (poXH RS iffD2) 1;
  36.208 +by (SIMP_TAC ccl_ss 1);
  36.209 +val po_bot = result();
  36.210 +
  36.211 +goal CCL.thy "a [= bot --> a=bot";
  36.212 +br impI 1;
  36.213 +bd (poXH RS iffD1) 1;
  36.214 +be rev_mp 1;
  36.215 +by (SIMP_TAC ccl_ss 1);
  36.216 +val bot_poleast = result() RS mp;
  36.217 +
  36.218 +goal CCL.thy "<a,b> [= <a',b'> <->  a [= a' & b [= b'";
  36.219 +br (poXH RS iff_trans) 1;
  36.220 +by (SIMP_TAC ccl_ss 1);
  36.221 +by (fast_tac ccl_cs 1);
  36.222 +val po_pair = result();
  36.223 +
  36.224 +goal CCL.thy "lam x.f(x) [= lam x.f'(x) <-> (ALL x. f(x) [= f'(x))";
  36.225 +br (poXH RS iff_trans) 1;
  36.226 +by (SIMP_TAC ccl_ss 1);
  36.227 +by (REPEAT (ares_tac [iffI,allI] 1 ORELSE eresolve_tac [exE,conjE] 1));
  36.228 +by (ASM_SIMP_TAC ccl_ss 1);
  36.229 +by (fast_tac ccl_cs 1);
  36.230 +val po_lam = result();
  36.231 +
  36.232 +val ccl_porews = [po_bot,po_pair,po_lam];
  36.233 +
  36.234 +val [p1,p2,p3,p4,p5] = goal CCL.thy
  36.235 +    "[| t [= t';  a [= a';  b [= b';  !!x y.c(x,y) [= c'(x,y); \
  36.236 +\       !!u.d(u) [= d'(u) |] ==> case(t,a,b,c,d) [= case(t',a',b',c',d')";
  36.237 +br (p1 RS po_cong RS po_trans) 1;
  36.238 +br (p2 RS po_cong RS po_trans) 1;
  36.239 +br (p3 RS po_cong RS po_trans) 1;
  36.240 +br (p4 RS po_abstractn RS po_abstractn RS po_cong RS po_trans) 1;
  36.241 +by (res_inst_tac [("f1","%d.case(t',a',b',c',d)")] 
  36.242 +               (p5 RS po_abstractn RS po_cong RS po_trans) 1);
  36.243 +br po_refl 1;
  36.244 +val case_pocong = result();
  36.245 +
  36.246 +val [p1,p2] = goalw CCL.thy ccl_data_defs
  36.247 +    "[| f [= f';  a [= a' |] ==> f ` a [= f' ` a'";
  36.248 +by (REPEAT (ares_tac [po_refl,case_pocong,p1,p2 RS po_cong] 1));
  36.249 +val apply_pocong = result();
  36.250 +
  36.251 +
  36.252 +val prems = goal CCL.thy "~ lam x.b(x) [= bot";
  36.253 +br notI 1;
  36.254 +bd bot_poleast 1;
  36.255 +be (distinctness RS notE) 1;
  36.256 +val npo_lam_bot = result();
  36.257 +
  36.258 +val eq1::eq2::prems = goal CCL.thy
  36.259 +    "[| x=a;  y=b;  x[=y |] ==> a[=b";
  36.260 +br (eq1 RS subst) 1;
  36.261 +br (eq2 RS subst) 1;
  36.262 +brs prems 1;
  36.263 +val po_lemma = result();
  36.264 +
  36.265 +goal CCL.thy "~ <a,b> [= lam x.f(x)";
  36.266 +br notI 1;
  36.267 +br (npo_lam_bot RS notE) 1;
  36.268 +be (case_pocong RS (caseBlam RS (caseBpair RS po_lemma))) 1;
  36.269 +by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
  36.270 +val npo_pair_lam = result();
  36.271 +
  36.272 +goal CCL.thy "~ lam x.f(x) [= <a,b>";
  36.273 +br notI 1;
  36.274 +br (npo_lam_bot RS notE) 1;
  36.275 +be (case_pocong RS (caseBpair RS (caseBlam RS po_lemma))) 1;
  36.276 +by (REPEAT (resolve_tac [po_refl,npo_lam_bot] 1));
  36.277 +val npo_lam_pair = result();
  36.278 +
  36.279 +fun mk_thm s = prove_goal CCL.thy s (fn _ => 
  36.280 +                          [rtac notI 1,dtac case_pocong 1,etac rev_mp 5,
  36.281 +                           ALLGOALS (SIMP_TAC ccl_ss),
  36.282 +                           REPEAT (resolve_tac [po_refl,npo_lam_bot] 1)]);
  36.283 +
  36.284 +val npo_rls = [npo_pair_lam,npo_lam_pair] @ map mk_thm
  36.285 +            ["~ true [= false",          "~ false [= true",
  36.286 +             "~ true [= <a,b>",          "~ <a,b> [= true",
  36.287 +             "~ true [= lam x.f(x)","~ lam x.f(x) [= true",
  36.288 +            "~ false [= <a,b>",          "~ <a,b> [= false",
  36.289 +            "~ false [= lam x.f(x)","~ lam x.f(x) [= false"];
  36.290 +
  36.291 +(* Coinduction for [= *)
  36.292 +
  36.293 +val prems = goal CCL.thy "[|  <t,u> : R;  R <= POgen(R) |] ==> t [= u";
  36.294 +br (PO_def RS def_coinduct RS (PO_iff RS iffD2)) 1;
  36.295 +by (REPEAT (ares_tac prems 1));
  36.296 +val po_coinduct = result();
  36.297 +
  36.298 +fun po_coinduct_tac s i = res_inst_tac [("R",s)] po_coinduct i;
  36.299 +
  36.300 +(*************** EQUALITY *******************)
  36.301 +
  36.302 +goalw CCL.thy [EQgen_def,SIM_def]  "mono(%X.EQgen(X))";
  36.303 +br monoI 1;
  36.304 +by (safe_tac set_cs);
  36.305 +by (REPEAT_SOME (resolve_tac [exI,conjI,refl]));
  36.306 +by (ALLGOALS (SIMP_TAC ccl_ss));
  36.307 +by (ALLGOALS (fast_tac set_cs));
  36.308 +val EQgen_mono = result();
  36.309 +
  36.310 +goalw CCL.thy [EQgen_def,SIM_def]
  36.311 +  "<t,t'> : EQgen(R) <-> (t=bot & t'=bot)  | (t=true & t'=true)  | \
  36.312 +\                                            (t=false & t'=false) | \
  36.313 +\                (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : R & <b,b'> : R) | \
  36.314 +\                (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))";
  36.315 +br (iff_refl RS XHlemma2) 1;
  36.316 +val EQgenXH = result();
  36.317 +
  36.318 +goal CCL.thy
  36.319 +  "t=t' <-> (t=bot & t'=bot)  | (t=true & t'=true)  | (t=false & t'=false) | \
  36.320 +\                    (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & a=a' & b=b') | \
  36.321 +\                    (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.f(x)=f'(x)))";
  36.322 +by (subgoal_tac
  36.323 +  "<t,t'> : EQ <-> (t=bot & t'=bot)  | (t=true & t'=true) | (t=false & t'=false) | \
  36.324 +\             (EX a a' b b'.t=<a,b> &  t'=<a',b'>  & <a,a'> : EQ & <b,b'> : EQ) | \
  36.325 +\             (EX f f'.t=lam x.f(x) &  t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : EQ))" 1);
  36.326 +be rev_mp 1;
  36.327 +by (SIMP_TAC (CCL_ss addrews [EQ_iff RS iff_sym]) 1);
  36.328 +br (rewrite_rule [EQgen_def,SIM_def]
  36.329 +                 (EQgen_mono RS (EQ_def RS def_gfp_Tarski) RS XHlemma1)) 1;
  36.330 +br (iff_refl RS XHlemma2) 1;
  36.331 +val eqXH = result();
  36.332 +
  36.333 +val prems = goal CCL.thy "[|  <t,u> : R;  R <= EQgen(R) |] ==> t = u";
  36.334 +br (EQ_def RS def_coinduct RS (EQ_iff RS iffD2)) 1;
  36.335 +by (REPEAT (ares_tac prems 1));
  36.336 +val eq_coinduct = result();
  36.337 +
  36.338 +val prems = goal CCL.thy 
  36.339 +    "[|  <t,u> : R;  R <= EQgen(lfp(%x.EQgen(x) Un R Un EQ)) |] ==> t = u";
  36.340 +br (EQ_def RS def_coinduct3 RS (EQ_iff RS iffD2)) 1;
  36.341 +by (REPEAT (ares_tac (EQgen_mono::prems) 1));
  36.342 +val eq_coinduct3 = result();
  36.343 +
  36.344 +fun eq_coinduct_tac s i = res_inst_tac [("R",s)] eq_coinduct i;
  36.345 +fun eq_coinduct3_tac s i = res_inst_tac [("R",s)] eq_coinduct3 i;
  36.346 +
  36.347 +(*** Untyped Case Analysis and Other Facts ***)
  36.348 +
  36.349 +goalw CCL.thy [apply_def]  "(EX f.t=lam x.f(x)) --> t = lam x.(t ` x)";
  36.350 +by (safe_tac ccl_cs);
  36.351 +by (SIMP_TAC ccl_ss 1);
  36.352 +val cond_eta = result() RS mp;
  36.353 +
  36.354 +goal CCL.thy "(t=bot) | (t=true) | (t=false) | (EX a b.t=<a,b>) | (EX f.t=lam x.f(x))";
  36.355 +by (cut_facts_tac [refl RS (eqXH RS iffD1)] 1);
  36.356 +by (fast_tac set_cs 1);
  36.357 +val exhaustion = result();
  36.358 +
  36.359 +val prems = goal CCL.thy 
  36.360 +    "[| P(bot);  P(true);  P(false);  !!x y.P(<x,y>);  !!b.P(lam x.b(x)) |] ==> P(t)";
  36.361 +by (cut_facts_tac [exhaustion] 1);
  36.362 +by (REPEAT_SOME (ares_tac prems ORELSE' eresolve_tac [disjE,exE,ssubst]));
  36.363 +val term_case = result();
  36.364 +
  36.365 +fun term_case_tac a i = res_inst_tac [("t",a)] term_case i;
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/CCL/ccl.thy	Thu Sep 16 12:20:38 1993 +0200
    37.3 @@ -0,0 +1,148 @@
    37.4 +(*  Title: 	CCL/ccl.thy
    37.5 +    ID:         $Id$
    37.6 +    Author: 	Martin Coen
    37.7 +    Copyright   1993  University of Cambridge
    37.8 +
    37.9 +Classical Computational Logic for Untyped Lambda Calculus with reduction to 
   37.10 +weak head-normal form.
   37.11 +
   37.12 +Based on FOL extended with set collection, a primitive higher-order logic.
   37.13 +HOL is too strong - descriptions prevent a type of programs being defined
   37.14 +which contains only executable terms.
   37.15 +*)
   37.16 +
   37.17 +CCL = Gfp +
   37.18 +
   37.19 +classes prog < term
   37.20 +
   37.21 +default prog
   37.22 +
   37.23 +types i 0
   37.24 +
   37.25 +arities 
   37.26 +      i          :: prog
   37.27 +      fun        :: (prog,prog)prog
   37.28 +
   37.29 +consts
   37.30 +  (*** Evaluation Judgement ***)
   37.31 +  "--->"      ::       "[i,i]=>prop"          (infixl 20)
   37.32 +
   37.33 +  (*** Bisimulations for pre-order and equality ***)
   37.34 +  "[="        ::       "['a,'a]=>o"           (infixl 50)
   37.35 +  SIM         ::       "[i,i,i set]=>o"
   37.36 +  POgen,EQgen ::       "i set => i set"
   37.37 +  PO,EQ       ::       "i set"
   37.38 +
   37.39 +  (*** Term Formers ***)
   37.40 +  true,false  ::       "i"
   37.41 +  pair        ::       "[i,i]=>i"             ("(1<_,/_>)")
   37.42 +  lambda      ::       "(i=>i)=>i"            (binder "lam " 55)
   37.43 +  case        ::       "[i,i,i,[i,i]=>i,(i=>i)=>i]=>i"
   37.44 +  "`"         ::       "[i,i]=>i"             (infixl 56)
   37.45 +  bot         ::       "i"
   37.46 +  fix         ::       "(i=>i)=>i"
   37.47 +
   37.48 +  (*** Defined Predicates ***)
   37.49 +  Trm,Dvg     ::       "i => o"
   37.50 +
   37.51 +rules
   37.52 +
   37.53 +  (******* EVALUATION SEMANTICS *******)
   37.54 +
   37.55 +  (**  This is the evaluation semantics from which the axioms below were derived.  **)
   37.56 +  (**  It is included here just as an evaluator for FUN and has no influence on    **)
   37.57 +  (**  inference in the theory CCL.                                                **)
   37.58 +
   37.59 +  trueV       "true ---> true"
   37.60 +  falseV      "false ---> false"
   37.61 +  pairV       "<a,b> ---> <a,b>"
   37.62 +  lamV        "lam x.b(x) ---> lam x.b(x)"
   37.63 +  caseVtrue   "[| t ---> true;  d ---> c |] ==> case(t,d,e,f,g) ---> c"
   37.64 +  caseVfalse  "[| t ---> false;  e ---> c |] ==> case(t,d,e,f,g) ---> c"
   37.65 +  caseVpair   "[| t ---> <a,b>;  f(a,b) ---> c |] ==> case(t,d,e,f,g) ---> c"
   37.66 +  caseVlam    "[| t ---> lam x.b(x);  g(b) ---> c |] ==> case(t,d,e,f,g) ---> c"
   37.67 +
   37.68 +  (*** Properties of evaluation: note that "t ---> c" impies that c is canonical ***)
   37.69 +
   37.70 +  canonical  "[| t ---> c; c==true ==> u--->v; \
   37.71 +\                          c==false ==> u--->v; \
   37.72 +\                    !!a b.c==<a,b> ==> u--->v; \
   37.73 +\                      !!f.c==lam x.f(x) ==> u--->v |] ==> \
   37.74 +\             u--->v"
   37.75 +
   37.76 +  (* Should be derivable - but probably a bitch! *)
   37.77 +  substitute "[| a==a'; t(a)--->c(a) |] ==> t(a')--->c(a')"
   37.78 +
   37.79 +  (************** LOGIC ***************)
   37.80 +
   37.81 +  (*** Definitions used in the following rules ***)
   37.82 +
   37.83 +  apply_def     "f ` t == case(f,bot,bot,%x y.bot,%u.u(t))"
   37.84 +  bot_def         "bot == (lam x.x`x)`(lam x.x`x)"
   37.85 +  fix_def      "fix(f) == (lam x.f(x`x))`(lam x.f(x`x))"
   37.86 +
   37.87 +  (*  The pre-order ([=) is defined as a simulation, and behavioural equivalence (=) *)
   37.88 +  (*  as a bisimulation.  They can both be expressed as (bi)simulations up to        *)
   37.89 +  (*  behavioural equivalence (ie the relations PO and EQ defined below).            *)
   37.90 +
   37.91 +  SIM_def
   37.92 +  "SIM(t,t',R) ==  (t=true & t'=true) | (t=false & t'=false) | \
   37.93 +\                  (EX a a' b b'.t=<a,b> & t'=<a',b'> & <a,a'> : R & <b,b'> : R) | \
   37.94 +\                  (EX f f'.t=lam x.f(x) & t'=lam x.f'(x) & (ALL x.<f(x),f'(x)> : R))"
   37.95 +
   37.96 +  POgen_def  "POgen(R) == {p. EX t t'. p=<t,t'> & (t = bot | SIM(t,t',R))}"
   37.97 +  EQgen_def  "EQgen(R) == {p. EX t t'. p=<t,t'> & (t = bot & t' = bot | SIM(t,t',R))}"
   37.98 +
   37.99 +  PO_def    "PO == gfp(POgen)"
  37.100 +  EQ_def    "EQ == gfp(EQgen)"
  37.101 +
  37.102 +  (*** Rules ***)
  37.103 +
  37.104 +  (** Partial Order **)
  37.105 +
  37.106 +  po_refl        "a [= a"
  37.107 +  po_trans       "[| a [= b;  b [= c |] ==> a [= c"
  37.108 +  po_cong        "a [= b ==> f(a) [= f(b)"
  37.109 +
  37.110 +  (* Extend definition of [= to program fragments of higher type *)
  37.111 +  po_abstractn   "(!!x. f(x) [= g(x)) ==> (%x.f(x)) [= (%x.g(x))"
  37.112 +
  37.113 +  (** Equality - equivalence axioms inherited from FOL.thy   **)
  37.114 +  (**          - congruence of "=" is axiomatised implicitly **)
  37.115 +
  37.116 +  eq_iff         "t = t' <-> t [= t' & t' [= t"
  37.117 +
  37.118 +  (** Properties of canonical values given by greatest fixed point definitions **)
  37.119 + 
  37.120 +  PO_iff         "t [= t' <-> <t,t'> : PO"
  37.121 +  EQ_iff         "t =  t' <-> <t,t'> : EQ"
  37.122 +
  37.123 +  (** Behaviour of non-canonical terms (ie case) given by the following beta-rules **)
  37.124 +
  37.125 +  caseBtrue            "case(true,d,e,f,g) = d"
  37.126 +  caseBfalse          "case(false,d,e,f,g) = e"
  37.127 +  caseBpair           "case(<a,b>,d,e,f,g) = f(a,b)"
  37.128 +  caseBlam       "case(lam x.b(x),d,e,f,g) = g(b)"
  37.129 +  caseBbot              "case(bot,d,e,f,g) = bot"            (* strictness *)
  37.130 +
  37.131 +  (** The theory is non-trivial **)
  37.132 +  distinctness   "~ lam x.b(x) = bot"
  37.133 +
  37.134 +  (*** Definitions of Termination and Divergence ***)
  37.135 +
  37.136 +  Dvg_def  "Dvg(t) == t = bot"
  37.137 +  Trm_def  "Trm(t) == ~ Dvg(t)"
  37.138 +
  37.139 +end
  37.140 +
  37.141 +
  37.142 +(*
  37.143 +Would be interesting to build a similar theory for a typed programming language:
  37.144 +    ie.     true :: bool,      fix :: ('a=>'a)=>'a  etc......
  37.145 +
  37.146 +This is starting to look like LCF.
  37.147 +What are the advantages of this approach?   
  37.148 +        - less axiomatic                                            
  37.149 +        - wfd induction / coinduction and fixed point induction available
  37.150 +           
  37.151 +*)
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/CCL/coinduction.ML	Thu Sep 16 12:20:38 1993 +0200
    38.3 @@ -0,0 +1,107 @@
    38.4 +(*  Title: 	92/CCL/coinduction
    38.5 +    ID:         $Id$
    38.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    38.7 +    Copyright   1993  University of Cambridge
    38.8 +
    38.9 +Lemmas and tactics for using the rule coinduct3 on [= and =.
   38.10 +*)
   38.11 +
   38.12 +val [mono,prem] = goal Lfp.thy "[| mono(f);  a : f(lfp(f)) |] ==> a : lfp(f)";
   38.13 +br ((mono RS lfp_Tarski) RS ssubst) 1;
   38.14 +br prem 1;
   38.15 +val lfpI = result();
   38.16 +
   38.17 +val prems = goal CCL.thy "[| a=a';  a' : A |] ==> a : A";
   38.18 +by (SIMP_TAC (term_ss addrews prems) 1);
   38.19 +val ssubst_single = result();
   38.20 +
   38.21 +val prems = goal CCL.thy "[| a=a';  b=b';  <a',b'> : A |] ==> <a,b> : A";
   38.22 +by (SIMP_TAC (term_ss addrews prems) 1);
   38.23 +val ssubst_pair = result();
   38.24 +
   38.25 +(***)
   38.26 +
   38.27 +local 
   38.28 +fun mk_thm s = prove_goal Term.thy s (fn mono::prems => 
   38.29 +       [fast_tac (term_cs addIs ((mono RS coinduct3_mono_lemma RS lfpI)::prems)) 1]);
   38.30 +in
   38.31 +val ci3_RI    = mk_thm "[|  mono(Agen);  a : R |] ==> a : lfp(%x. Agen(x) Un R Un A)";
   38.32 +val ci3_AgenI = mk_thm "[|  mono(Agen);  a : Agen(lfp(%x. Agen(x) Un R Un A)) |] ==> \
   38.33 +\                       a : lfp(%x. Agen(x) Un R Un A)";
   38.34 +val ci3_AI    = mk_thm "[|  mono(Agen);  a : A |] ==> a : lfp(%x. Agen(x) Un R Un A)";
   38.35 +end;
   38.36 +
   38.37 +fun mk_genIs thy defs genXH gen_mono s = prove_goalw thy defs s 
   38.38 +      (fn prems => [rtac (genXH RS iffD2) 1,
   38.39 +                    (SIMP_TAC term_ss 1),
   38.40 +                    TRY (fast_tac (term_cs addIs 
   38.41 +                            ([genXH RS iffD2,gen_mono RS coinduct3_mono_lemma RS lfpI]
   38.42 +                             @ prems)) 1)]);
   38.43 +
   38.44 +(** POgen **)
   38.45 +
   38.46 +goal Term.thy "<a,a> : PO";
   38.47 +br (po_refl RS (XH_to_D PO_iff)) 1;
   38.48 +val PO_refl = result();
   38.49 +
   38.50 +val POgenIs = map (mk_genIs Term.thy data_defs POgenXH POgen_mono)
   38.51 +      ["<true,true> : POgen(R)",
   38.52 +       "<false,false> : POgen(R)",
   38.53 +       "[| <a,a'> : R;  <b,b'> : R |] ==> <<a,b>,<a',b'>> : POgen(R)",
   38.54 +       "[|!!x. <b(x),b'(x)> : R |] ==><lam x.b(x),lam x.b'(x)> : POgen(R)",
   38.55 +       "<one,one> : POgen(R)",
   38.56 +       "<a,a'> : lfp(%x. POgen(x) Un R Un PO) ==> \
   38.57 +\                         <inl(a),inl(a')> : POgen(lfp(%x. POgen(x) Un R Un PO))",
   38.58 +       "<b,b'> : lfp(%x. POgen(x) Un R Un PO) ==> \
   38.59 +\                         <inr(b),inr(b')> : POgen(lfp(%x. POgen(x) Un R Un PO))",
   38.60 +       "<zero,zero> : POgen(lfp(%x. POgen(x) Un R Un PO))",
   38.61 +       "<n,n'> : lfp(%x. POgen(x) Un R Un PO) ==> \
   38.62 +\                         <succ(n),succ(n')> : POgen(lfp(%x. POgen(x) Un R Un PO))",
   38.63 +       "<[],[]> : POgen(lfp(%x. POgen(x) Un R Un PO))",
   38.64 +       "[| <h,h'> : lfp(%x. POgen(x) Un R Un PO); \
   38.65 +\          <t,t'> : lfp(%x. POgen(x) Un R Un PO) |] ==> \
   38.66 +\       <h.t,h'.t'> : POgen(lfp(%x. POgen(x) Un R Un PO))"];
   38.67 +
   38.68 +fun POgen_tac (rla,rlb) i =
   38.69 +       SELECT_GOAL (safe_tac ccl_cs) i THEN
   38.70 +       rtac (rlb RS (rla RS ssubst_pair)) i THEN
   38.71 +       (REPEAT (resolve_tac (POgenIs @ [PO_refl RS (POgen_mono RS ci3_AI)] @ 
   38.72 +                   (POgenIs RL [POgen_mono RS ci3_AgenI]) @ [POgen_mono RS ci3_RI]) i));
   38.73 +
   38.74 +(** EQgen **)
   38.75 +
   38.76 +goal Term.thy "<a,a> : EQ";
   38.77 +br (refl RS (EQ_iff RS iffD1)) 1;
   38.78 +val EQ_refl = result();
   38.79 +
   38.80 +val EQgenIs = map (mk_genIs Term.thy data_defs EQgenXH EQgen_mono)
   38.81 +      ["<true,true> : EQgen(R)",
   38.82 +       "<false,false> : EQgen(R)",
   38.83 +       "[| <a,a'> : R;  <b,b'> : R |] ==> <<a,b>,<a',b'>> : EQgen(R)",
   38.84 +       "[|!!x. <b(x),b'(x)> : R |] ==> <lam x.b(x),lam x.b'(x)> : EQgen(R)",
   38.85 +       "<one,one> : EQgen(R)",
   38.86 +       "<a,a'> : lfp(%x. EQgen(x) Un R Un EQ) ==> \
   38.87 +\                         <inl(a),inl(a')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
   38.88 +       "<b,b'> : lfp(%x. EQgen(x) Un R Un EQ) ==> \
   38.89 +\                         <inr(b),inr(b')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
   38.90 +       "<zero,zero> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
   38.91 +       "<n,n'> : lfp(%x. EQgen(x) Un R Un EQ) ==> \
   38.92 +\                         <succ(n),succ(n')> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
   38.93 +       "<[],[]> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))",
   38.94 +       "[| <h,h'> : lfp(%x. EQgen(x) Un R Un EQ); \
   38.95 +\          <t,t'> : lfp(%x. EQgen(x) Un R Un EQ) |] ==> \
   38.96 +\       <h.t,h'.t'> : EQgen(lfp(%x. EQgen(x) Un R Un EQ))"];
   38.97 +
   38.98 +fun EQgen_raw_tac i =
   38.99 +       (REPEAT (resolve_tac (EQgenIs @ [EQ_refl RS (EQgen_mono RS ci3_AI)] @ 
  38.100 +                   (EQgenIs RL [EQgen_mono RS ci3_AgenI]) @ [EQgen_mono RS ci3_RI]) i));
  38.101 +
  38.102 +(* Goals of the form R <= EQgen(R) - rewrite elements <a,b> : EQgen(R) using rews and *)
  38.103 +(* then reduce this to a goal <a',b'> : R (hopefully?)                                *)
  38.104 +(*      rews are rewrite rules that would cause looping in the simpifier              *)
  38.105 +
  38.106 +fun EQgen_tac simp_set rews i = 
  38.107 +       SELECT_GOAL (TRY (safe_tac ccl_cs) THEN
  38.108 +                    resolve_tac ((rews@[refl]) RL ((rews@[refl]) RL [ssubst_pair])) i THEN
  38.109 +                    ALLGOALS (SIMP_TAC simp_set) THEN
  38.110 +                    ALLGOALS EQgen_raw_tac) i;
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/CCL/equalities.ML	Thu Sep 16 12:20:38 1993 +0200
    39.3 @@ -0,0 +1,134 @@
    39.4 +(*  Title: 	CCL/equalities
    39.5 +    ID:         $Id$
    39.6 +
    39.7 +Modified version of
    39.8 +    Title: 	HOL/equalities
    39.9 +    Author: 	Lawrence C Paulson, Cambridge University Computer Laboratory
   39.10 +    Copyright   1991  University of Cambridge
   39.11 +
   39.12 +Equalities involving union, intersection, inclusion, etc.
   39.13 +*)
   39.14 +
   39.15 +writeln"File HOL/equalities";
   39.16 +
   39.17 +val eq_cs = set_cs addSIs [equalityI];
   39.18 +
   39.19 +(** Binary Intersection **)
   39.20 +
   39.21 +goal Set.thy "A Int A = A";
   39.22 +by (fast_tac eq_cs 1);
   39.23 +val Int_absorb = result();
   39.24 +
   39.25 +goal Set.thy "A Int B  =  B Int A";
   39.26 +by (fast_tac eq_cs 1);
   39.27 +val Int_commute = result();
   39.28 +
   39.29 +goal Set.thy "(A Int B) Int C  =  A Int (B Int C)";
   39.30 +by (fast_tac eq_cs 1);
   39.31 +val Int_assoc = result();
   39.32 +
   39.33 +goal Set.thy "(A Un B) Int C  =  (A Int C) Un (B Int C)";
   39.34 +by (fast_tac eq_cs 1);
   39.35 +val Int_Un_distrib = result();
   39.36 +
   39.37 +goal Set.thy "(A<=B) <-> (A Int B = A)";
   39.38 +by (fast_tac (eq_cs addSEs [equalityE]) 1);
   39.39 +val subset_Int_eq = result();
   39.40 +
   39.41 +(** Binary Union **)
   39.42 +
   39.43 +goal Set.thy "A Un A = A";
   39.44 +by (fast_tac eq_cs 1);
   39.45 +val Un_absorb = result();
   39.46 +
   39.47 +goal Set.thy "A Un B  =  B Un A";
   39.48 +by (fast_tac eq_cs 1);
   39.49 +val Un_commute = result();
   39.50 +
   39.51 +goal Set.thy "(A Un B) Un C  =  A Un (B Un C)";
   39.52 +by (fast_tac eq_cs 1);
   39.53 +val Un_assoc = result();
   39.54 +
   39.55 +goal Set.thy "(A Int B) Un C  =  (A Un C) Int (B Un C)";
   39.56 +by (fast_tac eq_cs 1);
   39.57 +val Un_Int_distrib = result();
   39.58 +
   39.59 +goal Set.thy
   39.60 + "(A Int B) Un (B Int C) Un (C Int A) = (A Un B) Int (B Un C) Int (C Un A)";
   39.61 +by (fast_tac eq_cs 1);
   39.62 +val Un_Int_crazy = result();
   39.63 +
   39.64 +goal Set.thy "(A<=B) <-> (A Un B = B)";
   39.65 +by (fast_tac (eq_cs addSEs [equalityE]) 1);
   39.66 +val subset_Un_eq = result();
   39.67 +
   39.68 +(** Simple properties of Compl -- complement of a set **)
   39.69 +
   39.70 +goal Set.thy "A Int Compl(A) = {x.False}";
   39.71 +by (fast_tac eq_cs 1);
   39.72 +val Compl_disjoint = result();
   39.73 +
   39.74 +goal Set.thy "A Un Compl(A) = {x.True}";
   39.75 +by (fast_tac eq_cs 1);
   39.76 +val Compl_partition = result();
   39.77 +
   39.78 +goal Set.thy "Compl(Compl(A)) = A";
   39.79 +by (fast_tac eq_cs 1);
   39.80 +val double_complement = result();
   39.81 +
   39.82 +goal Set.thy "Compl(A Un B) = Compl(A) Int Compl(B)";
   39.83 +by (fast_tac eq_cs 1);
   39.84 +val Compl_Un = result();
   39.85 +
   39.86 +goal Set.thy "Compl(A Int B) = Compl(A) Un Compl(B)";
   39.87 +by (fast_tac eq_cs 1);
   39.88 +val Compl_Int = result();
   39.89 +
   39.90 +goal Set.thy "Compl(UN x:A. B(x)) = (INT x:A. Compl(B(x)))";
   39.91 +by (fast_tac eq_cs 1);
   39.92 +val Compl_UN = result();
   39.93 +
   39.94 +goal Set.thy "Compl(INT x:A. B(x)) = (UN x:A. Compl(B(x)))";
   39.95 +by (fast_tac eq_cs 1);
   39.96 +val Compl_INT = result();
   39.97 +
   39.98 +(*Halmos, Naive Set Theory, page 16.*)
   39.99 +
  39.100 +goal Set.thy "((A Int B) Un C = A Int (B Un C)) <-> (C<=A)";
  39.101 +by (fast_tac (eq_cs addSEs [equalityE]) 1);
  39.102 +val Un_Int_assoc_eq = result();
  39.103 +
  39.104 +
  39.105 +(** Big Union and Intersection **)
  39.106 +
  39.107 +goal Set.thy "Union(A Un B) = Union(A) Un Union(B)";
  39.108 +by (fast_tac eq_cs 1);
  39.109 +val Union_Un_distrib = result();
  39.110 +
  39.111 +val prems = goal Set.thy
  39.112 +   "(Union(C) Int A = {x.False}) <-> (ALL B:C. B Int A = {x.False})";
  39.113 +by (fast_tac (eq_cs addSEs [equalityE]) 1);
  39.114 +val Union_disjoint = result();
  39.115 +
  39.116 +goal Set.thy "Inter(A Un B) = Inter(A) Int Inter(B)";
  39.117 +by (best_tac eq_cs 1);
  39.118 +val Inter_Un_distrib = result();
  39.119 +
  39.120 +(** Unions and Intersections of Families **)
  39.121 +
  39.122 +goal Set.thy "(UN x:A. B(x)) = Union({Y. EX x:A. Y=B(x)})";
  39.123 +by (fast_tac eq_cs 1);
  39.124 +val UN_eq = result();
  39.125 +
  39.126 +(*Look: it has an EXISTENTIAL quantifier*)
  39.127 +goal Set.thy "(INT x:A. B(x)) = Inter({Y. EX x:A. Y=B(x)})";
  39.128 +by (fast_tac eq_cs 1);
  39.129 +val INT_eq = result();
  39.130 +
  39.131 +goal Set.thy "A Int Union(B) = (UN C:B. A Int C)";
  39.132 +by (fast_tac eq_cs 1);
  39.133 +val Int_Union_image = result();
  39.134 +
  39.135 +goal Set.thy "A Un Inter(B) = (INT C:B. A Un C)";
  39.136 +by (fast_tac eq_cs 1);
  39.137 +val Un_Inter_image = result();
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/CCL/eval.ML	Thu Sep 16 12:20:38 1993 +0200
    40.3 @@ -0,0 +1,104 @@
    40.4 +(*  Title: 	92/CCL/eval
    40.5 +    ID:         $Id$
    40.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    40.7 +    Copyright   1992  University of Cambridge
    40.8 +
    40.9 +*)
   40.10 +
   40.11 +
   40.12 +
   40.13 +(*** Evaluation ***)
   40.14 +
   40.15 +val EVal_rls = ref [trueV,falseV,pairV,lamV,caseVtrue,caseVfalse,caseVpair,caseVlam];
   40.16 +val eval_tac = DEPTH_SOLVE_1 (resolve_tac (!EVal_rls) 1);
   40.17 +fun ceval_tac rls = DEPTH_SOLVE_1 (resolve_tac (!EVal_rls@rls) 1);
   40.18 +
   40.19 +val prems = goalw thy [apply_def]
   40.20 +   "[| f ---> lam x.b(x);  b(a) ---> c |] ==> f ` a ---> c";
   40.21 +by (ceval_tac prems);
   40.22 +val applyV = result();
   40.23 +
   40.24 +EVal_rls := !EVal_rls @ [applyV];
   40.25 +
   40.26 +val major::prems = goalw thy [let_def]
   40.27 +   "[| t ---> a;  f(a) ---> c |] ==> let x be t in f(x) ---> c";
   40.28 +br (major RS canonical) 1;
   40.29 +by (REPEAT (DEPTH_SOLVE_1 (resolve_tac ([major]@prems@(!EVal_rls)) 1 ORELSE
   40.30 +                           eresolve_tac [substitute] 1)));
   40.31 +val letV = result();
   40.32 +
   40.33 +val prems = goalw thy [fix_def]
   40.34 +   "f(fix(f)) ---> c ==> fix(f) ---> c";
   40.35 +br applyV 1;
   40.36 +br lamV 1;
   40.37 +brs prems 1;
   40.38 +val fixV = result();
   40.39 +
   40.40 +val prems = goalw thy [letrec_def]
   40.41 +    "h(t,%y.letrec g x be h(x,g) in g(y)) ---> c ==> \
   40.42 +\                  letrec g x be h(x,g) in g(t) ---> c";
   40.43 +by (REPEAT (resolve_tac (prems @ [fixV,applyV,lamV]) 1));
   40.44 +val letrecV = result();
   40.45 +
   40.46 +EVal_rls := !EVal_rls @ [letV,letrecV,fixV];
   40.47 +
   40.48 +fun mk_V_rl s = prove_goalw thy data_defs s (fn prems => [ceval_tac prems]);
   40.49 +
   40.50 +val V_rls = map mk_V_rl 
   40.51 +             ["true ---> true",
   40.52 +              "false ---> false",
   40.53 +              "[| b--->true;  t--->c |] ==> if b then t else u ---> c",
   40.54 +              "[| b--->false;  u--->c |] ==> if b then t else u ---> c",
   40.55 +              "<a,b> ---> <a,b>",
   40.56 +              "[| t ---> <a,b>;  h(a,b) ---> c |] ==> split(t,h) ---> c",
   40.57 +              "zero ---> zero",
   40.58 +              "succ(n) ---> succ(n)",
   40.59 +              "[| n ---> zero; t ---> c |] ==> ncase(n,t,u) ---> c",
   40.60 +              "[| n ---> succ(x); u(x) ---> c |] ==> ncase(n,t,u) ---> c",
   40.61 +              "[| n ---> zero; t ---> c |] ==> nrec(n,t,u) ---> c",
   40.62 +              "[| n--->succ(x); u(x,nrec(x,t,u))--->c |] ==> nrec(n,t,u)--->c",
   40.63 +              "[] ---> []",
   40.64 +              "h.t ---> h.t",
   40.65 +              "[| l ---> []; t ---> c |] ==> lcase(l,t,u) ---> c",
   40.66 +              "[| l ---> x.xs; u(x,xs) ---> c |] ==> lcase(l,t,u) ---> c",
   40.67 +              "[| l ---> []; t ---> c |] ==> lrec(l,t,u) ---> c",
   40.68 +              "[| l--->x.xs; u(x,xs,lrec(xs,t,u))--->c |] ==> lrec(l,t,u)--->c"];
   40.69 +
   40.70 +EVal_rls := !EVal_rls @ V_rls;
   40.71 +
   40.72 +(* Factorial *)
   40.73 +
   40.74 +val prems = goal thy
   40.75 +    "letrec f n be ncase(n,succ(zero),%x.nrec(n,zero,%y g.nrec(f(x),g,%z h.succ(h)))) \
   40.76 +\              in f(succ(succ(zero))) ---> ?a";
   40.77 +by (ceval_tac []);
   40.78 +
   40.79 +val prems = goal thy
   40.80 +    "letrec f n be ncase(n,succ(zero),%x.nrec(n,zero,%y g.nrec(f(x),g,%z h.succ(h)))) \
   40.81 +\              in f(succ(succ(succ(zero)))) ---> ?a";
   40.82 +by (ceval_tac []);
   40.83 +
   40.84 +(* Less Than Or Equal *)
   40.85 +
   40.86 +fun isle x y = prove_goal thy 
   40.87 +    ("letrec f p be split(p,%m n.ncase(m,true,%x.ncase(n,false,%y.f(<x,y>)))) \
   40.88 +\              in f(<"^x^","^y^">) ---> ?a")
   40.89 +    (fn prems => [ceval_tac []]);
   40.90 +
   40.91 +isle "succ(zero)" "succ(zero)";
   40.92 +isle "succ(zero)" "succ(succ(succ(succ(zero))))";
   40.93 +isle "succ(succ(succ(succ(succ(zero)))))" "succ(succ(succ(succ(zero))))";
   40.94 +
   40.95 +
   40.96 +(* Reverse *)
   40.97 +
   40.98 +val prems = goal thy
   40.99 +    "letrec id l be lcase(l,[],%x xs.x.id(xs)) \
  40.100 +\              in id(zero.succ(zero).[]) ---> ?a";
  40.101 +by (ceval_tac []);
  40.102 +
  40.103 +val prems = goal thy
  40.104 +    "letrec rev l be lcase(l,[],%x xs.lrec(rev(xs),x.[],%y ys g.y.g)) \
  40.105 +\              in rev(zero.succ(zero).(succ((lam x.x)`succ(zero))).([])) ---> ?a";
  40.106 +by (ceval_tac []);
  40.107 +
    41.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    41.2 +++ b/src/CCL/ex/Flag.ML	Thu Sep 16 12:20:38 1993 +0200
    41.3 @@ -0,0 +1,46 @@
    41.4 +(*  Title: 	CCL/ex/flag
    41.5 +    ID:         $Id$
    41.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    41.7 +    Copyright   1993  University of Cambridge
    41.8 +
    41.9 +For flag.thy.
   41.10 +*)
   41.11 +
   41.12 +open Flag;
   41.13 +
   41.14 +(******)
   41.15 +
   41.16 +val flag_defs = [Colour_def,red_def,white_def,blue_def,ccase_def];
   41.17 +
   41.18 +(******)
   41.19 +
   41.20 +val ColourXH = mk_XH_tac Flag.thy (simp_type_defs @flag_defs) [] 
   41.21 +          "a : Colour <-> (a=red | a=white | a=blue)";
   41.22 +
   41.23 +val Colour_case = XH_to_E ColourXH;
   41.24 +
   41.25 +val redT = mk_canT_tac Flag.thy [ColourXH] "red : Colour";
   41.26 +val whiteT = mk_canT_tac Flag.thy [ColourXH] "white : Colour";
   41.27 +val blueT = mk_canT_tac Flag.thy [ColourXH] "blue : Colour";
   41.28 +
   41.29 +
   41.30 +val ccaseT = mk_ncanT_tac Flag.thy flag_defs case_rls case_rls
   41.31 +     "[| c:Colour; \
   41.32 +\        c=red ==> r : C(red); c=white ==> w : C(white); c=blue ==> b : C(blue) |] ==> \
   41.33 +\     ccase(c,r,w,b) : C(c)";
   41.34 +
   41.35 +(***)
   41.36 +
   41.37 +val prems = goalw Flag.thy [flag_def]
   41.38 +    "flag : List(Colour)->List(Colour)*List(Colour)*List(Colour)";
   41.39 +by (typechk_tac [redT,whiteT,blueT,ccaseT] 1);
   41.40 +by clean_ccs_tac;
   41.41 +be (ListPRI RS (ListPR_wf RS wfI)) 1;
   41.42 +ba 1;
   41.43 +result();
   41.44 +
   41.45 +
   41.46 +val prems = goalw Flag.thy [flag_def]
   41.47 +    "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).FLAG(x,l)}";
   41.48 +by (gen_ccs_tac [redT,whiteT,blueT,ccaseT] 1);
   41.49 +by (REPEAT_SOME (ares_tac [ListPRI RS (ListPR_wf RS wfI)]));
    42.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.2 +++ b/src/CCL/ex/Flag.thy	Thu Sep 16 12:20:38 1993 +0200
    42.3 @@ -0,0 +1,48 @@
    42.4 +(*  Title: 	CCL/ex/flag.thy
    42.5 +    ID:         $Id$
    42.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    42.7 +    Copyright   1993  University of Cambridge
    42.8 +
    42.9 +Dutch national flag program - except that the point of Dijkstra's example was to use 
   42.10 +arrays and this uses lists.
   42.11 +
   42.12 +*)
   42.13 +
   42.14 +Flag = List + 
   42.15 +
   42.16 +consts
   42.17 +
   42.18 +  Colour             :: "i set"
   42.19 +  red, white, blue   :: "i"
   42.20 +  ccase              :: "[i,i,i,i]=>i"
   42.21 +  flag               :: "i"
   42.22 +
   42.23 +rules
   42.24 +
   42.25 +  Colour_def  "Colour == Unit + Unit + Unit"
   42.26 +  red_def        "red == inl(one)"
   42.27 +  white_def    "white == inr(inl(one))"
   42.28 +  blue_def     "blue == inr(inr(one))"
   42.29 +
   42.30 +  ccase_def   "ccase(c,r,w,b) == when(c,%x.r,%wb.when(wb,%x.w,%x.b))"
   42.31 +
   42.32 +  flag_def    "flag == lam l.letrec \
   42.33 +\      flagx l be lcase(l,<[],<[],[]>>, \
   42.34 +\                       %h t. split(flagx(t),%lr p.split(p,%lw lb. \
   42.35 +\                            ccase(h, <red.lr,<lw,lb>>, \
   42.36 +\                                     <lr,<white.lw,lb>>, \
   42.37 +\                                     <lr,<lw,blue.lb>>)))) \
   42.38 +\      in flagx(l)"    
   42.39 +
   42.40 +  Flag_def
   42.41 +     "Flag(l,x) == ALL lr:List(Colour).ALL lw:List(Colour).ALL lb:List(Colour). \
   42.42 +\                    x = <lr,<lw,lb>> --> \
   42.43 +\                  (ALL c:Colour.(c mem lr = true --> c=red) & \
   42.44 +\                                (c mem lw = true --> c=white) & \
   42.45 +\                                (c mem lb = true --> c=blue)) & \
   42.46 +\                  Perm(l,lr @ lw @ lb)"
   42.47 +
   42.48 +end
   42.49 +
   42.50 +
   42.51 +
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/CCL/ex/List.ML	Thu Sep 16 12:20:38 1993 +0200
    43.3 @@ -0,0 +1,108 @@
    43.4 +(*  Title: 	CCL/ex/list
    43.5 +    ID:         $Id$
    43.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    43.7 +    Copyright   1993  University of Cambridge
    43.8 +
    43.9 +For list.thy.
   43.10 +*)
   43.11 +
   43.12 +open List;
   43.13 +
   43.14 +val list_defs = [map_def,comp_def,append_def,filter_def,flat_def,
   43.15 +                 insert_def,isort_def,partition_def,qsort_def];
   43.16 +
   43.17 +(****)
   43.18 +
   43.19 +val listBs = map (fn s=>prove_goalw List.thy list_defs s (fn _ => [SIMP_TAC term_ss 1]))
   43.20 +     ["(f o g) = (%a.f(g(a)))",
   43.21 +      "(f o g)(a) = f(g(a))",
   43.22 +      "map(f,[]) = []",
   43.23 +      "map(f,x.xs) = f(x).map(f,xs)",
   43.24 +      "[] @ m = m",
   43.25 +      "x.xs @ m = x.(xs @ m)",
   43.26 +      "filter(f,[]) = []",
   43.27 +      "filter(f,x.xs) = if f`x then x.filter(f,xs) else filter(f,xs)",
   43.28 +      "flat([]) = []",
   43.29 +      "flat(x.xs) = x @ flat(xs)",
   43.30 +      "insert(f,a,[]) = a.[]",
   43.31 +      "insert(f,a,x.xs) = if f`a`x then a.x.xs else x.insert(f,a,xs)"];
   43.32 +
   43.33 +val list_congs = ccl_mk_congs List.thy ["map","op @","filter","flat","insert","napply"];
   43.34 +
   43.35 +val list_ss = nat_ss addrews listBs addcongs list_congs;
   43.36 +
   43.37 +(****)
   43.38 +
   43.39 +val [prem] = goal List.thy "n:Nat ==> map(f) ^ n ` [] = []";
   43.40 +br (prem RS Nat_ind) 1;
   43.41 +by (ALLGOALS (ASM_SIMP_TAC list_ss));
   43.42 +val nmapBnil = result();
   43.43 +
   43.44 +val [prem] = goal List.thy "n:Nat ==> map(f)^n`(x.xs) = f^n`x.map(f)^n`xs";
   43.45 +br (prem RS Nat_ind) 1;
   43.46 +by (ALLGOALS (ASM_SIMP_TAC list_ss));
   43.47 +val nmapBcons = result();
   43.48 +
   43.49 +(***)
   43.50 +
   43.51 +val prems = goalw List.thy [map_def]
   43.52 +  "[| !!x.x:A==>f(x):B;  l : List(A) |] ==> map(f,l) : List(B)";
   43.53 +by (typechk_tac prems 1);
   43.54 +val mapT = result();
   43.55 +
   43.56 +val prems = goalw List.thy [append_def]
   43.57 +  "[| l : List(A);  m : List(A) |] ==> l @ m : List(A)";
   43.58 +by (typechk_tac prems 1);
   43.59 +val appendT = result();
   43.60 +
   43.61 +val prems = goal List.thy
   43.62 +  "[| l : {l:List(A). m : {m:List(A).P(l @ m)}} |] ==> l @ m : {x:List(A). P(x)}";
   43.63 +by (cut_facts_tac prems 1);
   43.64 +by (fast_tac (set_cs addSIs [SubtypeI,appendT] addSEs [SubtypeE]) 1);
   43.65 +val appendTS = result();
   43.66 +
   43.67 +val prems = goalw List.thy [filter_def]
   43.68 +  "[| f:A->Bool;   l : List(A) |] ==> filter(f,l) : List(A)";
   43.69 +by (typechk_tac prems 1);
   43.70 +val filterT = result();
   43.71 +
   43.72 +val prems = goalw List.thy [flat_def]
   43.73 +  "l : List(List(A)) ==> flat(l) : List(A)";
   43.74 +by (typechk_tac (appendT::prems) 1);
   43.75 +val flatT = result();
   43.76 +
   43.77 +val prems = goalw List.thy [insert_def]
   43.78 +  "[|  f : A->A->Bool; a:A; l : List(A) |] ==> insert(f,a,l) : List(A)";
   43.79 +by (typechk_tac prems 1);
   43.80 +val insertT = result();
   43.81 +
   43.82 +val prems = goal List.thy
   43.83 +  "[| f : {f:A->A->Bool. a : {a:A. l : {l:List(A).P(insert(f,a,l))}}} |] ==> \
   43.84 +\  insert(f,a,l)  : {x:List(A). P(x)}";
   43.85 +by (cut_facts_tac prems 1);
   43.86 +by (fast_tac (set_cs addSIs [SubtypeI,insertT] addSEs [SubtypeE]) 1);
   43.87 +val insertTS = result();
   43.88 +
   43.89 +val prems = goalw List.thy [partition_def]
   43.90 +  "[| f:A->Bool;  l : List(A) |] ==> partition(f,l) : List(A)*List(A)";
   43.91 +by (typechk_tac prems 1);
   43.92 +by clean_ccs_tac;
   43.93 +br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 2;
   43.94 +br (ListPRI RS wfstI RS (ListPR_wf RS wmap_wf RS wfI)) 1;
   43.95 +by (REPEAT (atac 1));
   43.96 +val partitionT = result();
   43.97 +
   43.98 +(*** Correctness Conditions for Insertion Sort ***)
   43.99 +
  43.100 +
  43.101 +val prems = goalw List.thy [isort_def] 
  43.102 +    "f:A->A->Bool ==> isort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}";
  43.103 +by (gen_ccs_tac  ([insertTS,insertT]@prems) 1);
  43.104 +
  43.105 +
  43.106 +(*** Correctness Conditions for Quick Sort ***)
  43.107 +
  43.108 +val prems = goalw List.thy [qsort_def] 
  43.109 +    "f:A->A->Bool ==> qsort(f) : PROD l:List(A).{x: List(A). Ord(f,x) & Perm(x,l)}";
  43.110 +by (gen_ccs_tac  ([partitionT,appendTS,appendT]@prems) 1);
  43.111 +
    44.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    44.2 +++ b/src/CCL/ex/List.thy	Thu Sep 16 12:20:38 1993 +0200
    44.3 @@ -0,0 +1,44 @@
    44.4 +(*  Title: 	CCL/ex/list.thy
    44.5 +    ID:         $Id$
    44.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    44.7 +    Copyright   1993  University of Cambridge
    44.8 +
    44.9 +Programs defined over lists.
   44.10 +*)
   44.11 +
   44.12 +List = Nat + 
   44.13 +
   44.14 +consts
   44.15 +  map       :: "[i=>i,i]=>i"
   44.16 +  "o"       :: "[i=>i,i=>i]=>i=>i"             (infixr 55)
   44.17 +  "@"       :: "[i,i]=>i"             (infixr 55)
   44.18 +  mem       :: "[i,i]=>i"             (infixr 55)
   44.19 +  filter    :: "[i,i]=>i"
   44.20 +  flat      :: "i=>i"
   44.21 +  partition :: "[i,i]=>i"
   44.22 +  insert    :: "[i,i,i]=>i"
   44.23 +  isort     :: "i=>i"
   44.24 +  qsort     :: "i=>i"
   44.25 +
   44.26 +rules 
   44.27 +
   44.28 +  map_def     "map(f,l)   == lrec(l,[],%x xs g.f(x).g)"
   44.29 +  comp_def    "f o g == (%x.f(g(x)))"
   44.30 +  append_def  "l @ m == lrec(l,m,%x xs g.x.g)"
   44.31 +  mem_def     "a mem l == lrec(l,false,%h t g.if eq(a,h) then true else g)"
   44.32 +  filter_def  "filter(f,l) == lrec(l,[],%x xs g.if f`x then x.g else g)"
   44.33 +  flat_def    "flat(l) == lrec(l,[],%h t g.h @ g)"
   44.34 +
   44.35 +  insert_def  "insert(f,a,l) == lrec(l,a.[],%h t g.if f`a`h then a.h.t else h.g)"
   44.36 +  isort_def   "isort(f) == lam l.lrec(l,[],%h t g.insert(f,h,g))"
   44.37 +
   44.38 +  partition_def 
   44.39 +  "partition(f,l) == letrec part l a b be lcase(l,<a,b>,%x xs.\
   44.40 +\                            if f`x then part(xs,x.a,b) else part(xs,a,x.b)) \
   44.41 +\                    in part(l,[],[])"
   44.42 +  qsort_def   "qsort(f) == lam l. letrec qsortx l be lcase(l,[],%h t. \
   44.43 +\                                   let p be partition(f`h,t) \
   44.44 +\                                   in split(p,%x y.qsortx(x) @ h.qsortx(y))) \
   44.45 +\                          in qsortx(l)"
   44.46 +
   44.47 +end
    45.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    45.2 +++ b/src/CCL/ex/Nat.ML	Thu Sep 16 12:20:38 1993 +0200
    45.3 @@ -0,0 +1,75 @@
    45.4 +(*  Title: 	CCL/ex/nat
    45.5 +    ID:         $Id$
    45.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    45.7 +    Copyright   1993  University of Cambridge
    45.8 +
    45.9 +For nat.thy.
   45.10 +*)
   45.11 +
   45.12 +open Nat;
   45.13 +
   45.14 +val nat_defs = [not_def,add_def,mult_def,sub_def,le_def,lt_def,ack_def,napply_def];
   45.15 +
   45.16 +val natBs = map (fn s=>prove_goalw Nat.thy nat_defs s (fn _ => [SIMP_TAC term_ss 1]))
   45.17 +     ["not(true) = false",
   45.18 +      "not(false) = true",
   45.19 +      "zero #+ n = n",
   45.20 +      "succ(n) #+ m = succ(n #+ m)",
   45.21 +      "zero #* n = zero",
   45.22 +      "succ(n) #* m = m #+ (n #* m)",
   45.23 +      "f^zero`a = a",
   45.24 +      "f^succ(n)`a = f(f^n`a)"];
   45.25 +
   45.26 +val nat_congs  = ccl_mk_congs Nat.thy ["not","op #+","op #*","op #-","op ##",
   45.27 +                                     "op #<","op #<=","ackermann","napply"];
   45.28 +
   45.29 +val nat_ss = term_ss addrews natBs addcongs nat_congs;
   45.30 +
   45.31 +(*** Lemma for napply ***)
   45.32 +
   45.33 +val [prem] = goal Nat.thy "n:Nat ==> f^n`f(a) = f^succ(n)`a";
   45.34 +br (prem RS Nat_ind) 1;
   45.35 +by (ALLGOALS (ASM_SIMP_TAC (nat_ss addcongs [read_instantiate [("f","f")] arg_cong])));
   45.36 +val napply_f = result();
   45.37 +
   45.38 +(****)
   45.39 +
   45.40 +val prems = goalw Nat.thy [add_def] "[| a:Nat;  b:Nat |] ==> a #+ b : Nat";
   45.41 +by (typechk_tac prems 1);
   45.42 +val addT = result();
   45.43 +
   45.44 +val prems = goalw Nat.thy [mult_def] "[| a:Nat;  b:Nat |] ==> a #* b : Nat";
   45.45 +by (typechk_tac (addT::prems) 1);
   45.46 +val multT = result();
   45.47 +
   45.48 +(* Defined to return zero if a<b *)
   45.49 +val prems = goalw Nat.thy [sub_def] "[| a:Nat;  b:Nat |] ==> a #- b : Nat";
   45.50 +by (typechk_tac (prems) 1);
   45.51 +by clean_ccs_tac;
   45.52 +be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1;
   45.53 +val subT = result();
   45.54 +
   45.55 +val prems = goalw Nat.thy [le_def] "[| a:Nat;  b:Nat |] ==> a #<= b : Bool";
   45.56 +by (typechk_tac (prems) 1);
   45.57 +by clean_ccs_tac;
   45.58 +be (NatPRI RS wfstI RS (NatPR_wf RS wmap_wf RS wfI)) 1;
   45.59 +val leT = result();
   45.60 +
   45.61 +val prems = goalw Nat.thy [not_def,lt_def] "[| a:Nat;  b:Nat |] ==> a #< b : Bool";
   45.62 +by (typechk_tac (prems@[leT]) 1);
   45.63 +val ltT = result();
   45.64 +
   45.65 +(* Correctness conditions for subtractive division **)
   45.66 +
   45.67 +val prems = goalw Nat.thy [div_def] 
   45.68 +    "[| a:Nat;  b:{x:Nat.~x=zero} |] ==> a ## b : {x:Nat. DIV(a,b,x)}";
   45.69 +by (gen_ccs_tac (prems@[ltT,subT]) 1);
   45.70 +
   45.71 +(* Termination Conditions for Ackermann's Function *)
   45.72 +
   45.73 +val prems = goalw Nat.thy [ack_def]
   45.74 +    "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat";
   45.75 +by (gen_ccs_tac prems 1);
   45.76 +val relI = NatPR_wf RS (NatPR_wf RS lex_wf RS wfI);
   45.77 +by (REPEAT (eresolve_tac [NatPRI RS (lexI1 RS relI),NatPRI RS (lexI2 RS relI)] 1));
   45.78 +result();
    46.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    46.2 +++ b/src/CCL/ex/Nat.thy	Thu Sep 16 12:20:38 1993 +0200
    46.3 @@ -0,0 +1,38 @@
    46.4 +(*  Title: 	CCL/ex/nat.thy
    46.5 +    ID:         $Id$
    46.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    46.7 +    Copyright   1993  University of Cambridge
    46.8 +
    46.9 +Programs defined over the natural numbers
   46.10 +*)
   46.11 +
   46.12 +Nat = Wfd +
   46.13 +
   46.14 +consts
   46.15 +
   46.16 +  not              :: "i=>i"
   46.17 +  "#+","#*","#-",
   46.18 +  "##","#<","#<="  :: "[i,i]=>i"            (infixr 60)
   46.19 +  ackermann        :: "[i,i]=>i"
   46.20 +
   46.21 +rules 
   46.22 +
   46.23 +  not_def     "not(b) == if b then false else true"
   46.24 +
   46.25 +  add_def     "a #+ b == nrec(a,b,%x g.succ(g))"
   46.26 +  mult_def    "a #* b == nrec(a,zero,%x g.b #+ g)"
   46.27 +  sub_def     "a #- b == letrec sub x y be ncase(y,x,%yy.ncase(x,zero,%xx.sub(xx,yy))) \
   46.28 +\                        in sub(a,b)"
   46.29 +  le_def     "a #<= b == letrec le x y be ncase(x,true,%xx.ncase(y,false,%yy.le(xx,yy))) \
   46.30 +\                        in le(a,b)"
   46.31 +  lt_def     "a #< b == not(b #<= a)"
   46.32 +
   46.33 +  div_def    "a ## b == letrec div x y be if x #< y then zero else succ(div(x#-y,y)) \
   46.34 +\                       in div(a,b)"
   46.35 +  ack_def    
   46.36 +  "ackermann(a,b) == letrec ack n m be ncase(n,succ(m),%x. \
   46.37 +\                          ncase(m,ack(x,succ(zero)),%y.ack(x,ack(succ(x),y))))\
   46.38 +\                    in ack(a,b)"
   46.39 +
   46.40 +end
   46.41 +
    47.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    47.2 +++ b/src/CCL/ex/ROOT.ML	Thu Sep 16 12:20:38 1993 +0200
    47.3 @@ -0,0 +1,17 @@
    47.4 +(*  Title:      CCL/ex/ROOT
    47.5 +    ID:         $Id$
    47.6 +    Author:     Martin Coen, Cambridge University Computer Laboratory
    47.7 +    Copyright   1993  University of Cambridge
    47.8 +
    47.9 +Executes all examples for Classical Computational Logic
   47.10 +*)
   47.11 +
   47.12 +CCL_build_completed;	(*Cause examples to fail if CCL did*)
   47.13 +
   47.14 +writeln"Root file for CCL examples";
   47.15 +proof_timing := true;
   47.16 +time_use_thy "ex/nat";
   47.17 +time_use_thy "ex/list";
   47.18 +time_use_thy "ex/stream";
   47.19 +time_use_thy "ex/flag";
   47.20 +maketest"END: Root file for CCL examples";
    48.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    48.2 +++ b/src/CCL/ex/Stream.ML	Thu Sep 16 12:20:38 1993 +0200
    48.3 @@ -0,0 +1,112 @@
    48.4 +(*  Title: 	CCL/ex/stream
    48.5 +    ID:         $Id$
    48.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    48.7 +    Copyright   1993  University of Cambridge
    48.8 +
    48.9 +For stream.thy.
   48.10 +
   48.11 +Proving properties about infinite lists using coinduction:
   48.12 +    Lists(A)  is the set of all finite and infinite lists of elements of A.
   48.13 +    ILists(A) is the set of infinite lists of elements of A.
   48.14 +*)
   48.15 +
   48.16 +open Stream;
   48.17 +
   48.18 +(*** Map of composition is composition of maps ***)
   48.19 +
   48.20 +val prems = goal Stream.thy "l:Lists(A) ==> map(f o g,l) = map(f,map(g,l))";
   48.21 +by (eq_coinduct3_tac 
   48.22 +       "{p. EX x y.p=<x,y> & (EX l:Lists(A).x=map(f o g,l) & y=map(f,map(g,l)))}"  1);
   48.23 +by (fast_tac (ccl_cs addSIs prems) 1);
   48.24 +by (safe_tac type_cs);
   48.25 +be (XH_to_E ListsXH) 1;
   48.26 +by (EQgen_tac list_ss [] 1);
   48.27 +by (SIMP_TAC list_ss 1);
   48.28 +by (fast_tac ccl_cs 1);
   48.29 +val map_comp = result();
   48.30 +
   48.31 +(*** Mapping the identity function leaves a list unchanged ***)
   48.32 +
   48.33 +val prems = goal Stream.thy "l:Lists(A) ==> map(%x.x,l) = l";
   48.34 +by (eq_coinduct3_tac 
   48.35 +       "{p. EX x y.p=<x,y> & (EX l:Lists(A).x=map(%x.x,l) & y=l)}"  1);
   48.36 +by (fast_tac (ccl_cs addSIs prems) 1);
   48.37 +by (safe_tac type_cs);
   48.38 +be (XH_to_E ListsXH) 1;
   48.39 +by (EQgen_tac list_ss [] 1);
   48.40 +by (fast_tac ccl_cs 1);
   48.41 +val map_id = result();
   48.42 +
   48.43 +(*** Mapping distributes over append ***)
   48.44 +
   48.45 +val prems = goal Stream.thy 
   48.46 +        "[| l:Lists(A); m:Lists(A) |] ==> map(f,l@m) = map(f,l) @ map(f,m)";
   48.47 +by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX l:Lists(A).EX m:Lists(A). \
   48.48 +\                                           x=map(f,l@m) & y=map(f,l) @ map(f,m))}"  1);
   48.49 +by (fast_tac (ccl_cs addSIs prems) 1);
   48.50 +by (safe_tac type_cs);
   48.51 +be (XH_to_E ListsXH) 1;
   48.52 +by (EQgen_tac list_ss [] 1);
   48.53 +be (XH_to_E ListsXH) 1;
   48.54 +by (EQgen_tac list_ss [] 1);
   48.55 +by (fast_tac ccl_cs 1);
   48.56 +val map_append = result();
   48.57 +
   48.58 +(*** Append is associative ***)
   48.59 +
   48.60 +val prems = goal Stream.thy 
   48.61 +        "[| k:Lists(A); l:Lists(A); m:Lists(A) |] ==> k @ l @ m = (k @ l) @ m";
   48.62 +by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX k:Lists(A).EX l:Lists(A).EX m:Lists(A). \
   48.63 +\                                                   x=k @ l @ m & y=(k @ l) @ m)}"  1);
   48.64 +by (fast_tac (ccl_cs addSIs prems) 1);
   48.65 +by (safe_tac type_cs);
   48.66 +be (XH_to_E ListsXH) 1;
   48.67 +by (EQgen_tac list_ss [] 1);
   48.68 +be (XH_to_E ListsXH) 1;back();
   48.69 +by (EQgen_tac list_ss [] 1);
   48.70 +be (XH_to_E ListsXH) 1;
   48.71 +by (EQgen_tac list_ss [] 1);
   48.72 +by (fast_tac ccl_cs 1);
   48.73 +val append_assoc = result();
   48.74 +
   48.75 +(*** Appending anything to an infinite list doesn't alter it ****)
   48.76 +
   48.77 +val prems = goal Stream.thy "l:ILists(A) ==> l @ m = l";
   48.78 +by (eq_coinduct3_tac "{p. EX x y.p=<x,y> & (EX l:ILists(A).EX m.x=l@m & y=l)}" 1);
   48.79 +by (fast_tac (ccl_cs addSIs prems) 1);
   48.80 +by (safe_tac set_cs);
   48.81 +be (XH_to_E IListsXH) 1;
   48.82 +by (EQgen_tac list_ss [] 1);
   48.83 +by (fast_tac ccl_cs 1);
   48.84 +val ilist_append = result();
   48.85 +
   48.86 +(*** The equivalance of two versions of an iteration function       ***)
   48.87 +(*                                                                    *)
   48.88 +(*        fun iter1(f,a) = a.iter1(f,f(a))                            *)
   48.89 +(*        fun iter2(f,a) = a.map(f,iter2(f,a))                        *)
   48.90 +
   48.91 +goalw Stream.thy [iter1_def] "iter1(f,a) = a.iter1(f,f(a))";
   48.92 +br (letrecB RS trans) 1;
   48.93 +by (SIMP_TAC term_ss 1);
   48.94 +val iter1B = result();
   48.95 +
   48.96 +goalw Stream.thy [iter2_def] "iter2(f,a) = a . map(f,iter2(f,a))";
   48.97 +br (letrecB RS trans) 1;
   48.98 +br refl 1;
   48.99 +val iter2B = result();
  48.100 +
  48.101 +val [prem] =goal Stream.thy
  48.102 +   "n:Nat ==> map(f) ^ n ` iter2(f,a) = f ^ n ` a . map(f) ^ n ` map(f,iter2(f,a))";
  48.103 +br (iter2B RS ssubst) 1;back();back();
  48.104 +by (SIMP_TAC (list_ss addrews [prem RS nmapBcons]) 1);
  48.105 +val iter2Blemma = result();
  48.106 +
  48.107 +goal Stream.thy "iter1(f,a) = iter2(f,a)";
  48.108 +by (eq_coinduct3_tac 
  48.109 +    "{p. EX x y.p=<x,y> & (EX n:Nat.x=iter1(f,f^n`a) & y=map(f)^n`iter2(f,a))}" 1);
  48.110 +by (fast_tac (type_cs addSIs [napplyBzero RS sym,napplyBzero RS sym RS arg_cong]) 1);
  48.111 +by (EQgen_tac list_ss [iter1B,iter2Blemma] 1);
  48.112 +by (rtac (napply_f RS ssubst) 1 THEN atac 1);
  48.113 +by (res_inst_tac [("f1","f")] (napplyBsucc RS subst) 1);
  48.114 +by (fast_tac type_cs 1);
  48.115 +val iter1_iter2_eq = result();
    49.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    49.2 +++ b/src/CCL/ex/Stream.thy	Thu Sep 16 12:20:38 1993 +0200
    49.3 @@ -0,0 +1,20 @@
    49.4 +(*  Title: 	CCL/ex/stream.thy
    49.5 +    ID:         $Id$
    49.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    49.7 +    Copyright   1993  University of Cambridge
    49.8 +
    49.9 +Programs defined over streams.
   49.10 +*)
   49.11 +
   49.12 +Stream = List + 
   49.13 +
   49.14 +consts
   49.15 +
   49.16 +  iter1,iter2   ::  "[i=>i,i]=>i"
   49.17 +
   49.18 +rules 
   49.19 +
   49.20 +  iter1_def   "iter1(f,a) == letrec iter x be x.iter(f(x)) in iter(a)"
   49.21 +  iter2_def   "iter2(f,a) == letrec iter x be x.map(f,iter(x)) in iter(a)"
   49.22 +
   49.23 +end
    50.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    50.2 +++ b/src/CCL/ex/flag.ML	Thu Sep 16 12:20:38 1993 +0200
    50.3 @@ -0,0 +1,46 @@
    50.4 +(*  Title: 	CCL/ex/flag
    50.5 +    ID:         $Id$
    50.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    50.7 +    Copyright   1993  University of Cambridge
    50.8 +
    50.9 +For flag.thy.
   50.10 +*)
   50.11 +
   50.12 +open Flag;
   50.13 +
   50.14 +(******)
   50.15 +
   50.16 +val flag_defs = [Colour_def,red_def,white_def,blue_def,ccase_def];
   50.17 +
   50.18 +(******)
   50.19 +
   50.20 +val ColourXH = mk_XH_tac Flag.thy (simp_type_defs @flag_defs) [] 
   50.21 +          "a : Colour <-> (a=red | a=white | a=blue)";
   50.22 +
   50.23 +val Colour_case = XH_to_E ColourXH;
   50.24 +
   50.25 +val redT = mk_canT_tac Flag.thy [ColourXH] "red : Colour";
   50.26 +val whiteT = mk_canT_tac Flag.thy [ColourXH] "white : Colour";
   50.27 +val blueT = mk_canT_tac Flag.thy [ColourXH] "blue : Colour";
   50.28 +
   50.29 +
   50.30 +val ccaseT = mk_ncanT_tac Flag.thy flag_defs case_rls case_rls
   50.31 +     "[| c:Colour; \
   50.32 +\        c=red ==> r : C(red); c=white ==> w : C(white); c=blue ==> b : C(blue) |] ==> \
   50.33 +\     ccase(c,r,w,b) : C(c)";
   50.34 +
   50.35 +(***)
   50.36 +
   50.37 +val prems = goalw Flag.thy [flag_def]
   50.38 +    "flag : List(Colour)->List(Colour)*List(Colour)*List(Colour)";
   50.39 +by (typechk_tac [redT,whiteT,blueT,ccaseT] 1);
   50.40 +by clean_ccs_tac;
   50.41 +be (ListPRI RS (ListPR_wf RS wfI)) 1;
   50.42 +ba 1;
   50.43 +result();
   50.44 +
   50.45 +
   50.46 +val prems = goalw Flag.thy [flag_def]
   50.47 +    "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).FLAG(x,l)}";
   50.48 +by (gen_ccs_tac [redT,whiteT,blueT,ccaseT] 1);
   50.49 +by (REPEAT_SOME (ares_tac [ListPRI RS (ListPR_wf RS wfI)]));
    51.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    51.2 +++ b/src/CCL/ex/flag.thy	Thu Sep 16 12:20:38 1993 +0200
    51.3 @@ -0,0 +1,48 @@
    51.4 +(*  Title: 	CCL/ex/flag.thy
    51.5 +    ID:         $Id$
    51.6 +    Author: 	Martin Coen, Cambridge University Computer Laboratory
    51.7 +    Copyright   1993  University of Cambridge
    51.8 +
    51.9 +Dutch national flag program - except that the point of Dijkstra's example was to use 
   51.10 +arrays and this uses lists.