Import acl2_7.4dfsg.orig.tar.gz

[dgit import orig acl2_7.4dfsg.orig.tar.gz]

99 files changed, 14329 insertions, 0 deletions

diff --git a/books/workshops/1999/ivy/ivy-v2/Cleanup b/books/workshops/1999/ivy/ivy-v2/Cleanup
new file mode 100755
index 0000000..66d0b33
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/Cleanup
@@ -0,0 +1,26 @@
+#!/bin/csh
+
+echo ""
+echo "This will take you back to a state close to the original state."
+echo ""
+
+echo -n "Do you really want to do it (y or n) ? "
+set ok=$<
+
+if ($ok != "y") then
+    exit
+endif
+
+/bin/rm -r *~
+
+cd mace-1.3.4
+make realclean
+cd ..
+
+cd otter-3.0.6/source
+make realclean
+cd ../..
+
+cd ivy-sources
+make realclean
+cd ..
diff --git a/books/workshops/1999/ivy/ivy-v2/Configure b/books/workshops/1999/ivy/ivy-v2/Configure
new file mode 100755
index 0000000..6a0c3ab
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/Configure
@@ -0,0 +1,88 @@
+#!/bin/csh
+
+# This script sets up pathnames in
+#   1. the scripts that run Ivy,
+#   2. the mace scripts.
+
+set base=$PWD
+
+echo ""
+echo "Base directory is $base"
+echo ""
+
+set src=$base/ivy-sources
+set macedir=mace-1.3.4
+set otterdir=otter-3.0.6
+
+# Insert backslashes before the slashes, because the path will be
+# used in sed commands.
+
+set srcx=`echo $src | sed "s/\//\\\//g"`
+
+echo 
+echo -n "What command runs ACL2 (default acl2) ? "
+set acl2=$<
+if ($acl2 == "") set acl2=acl2
+set acl2x=`echo $acl2 | sed "s/\//\\\//g"`
+
+echo ""
+echo -n "What command runs Otter-306 (default $base/$otterdir/source/otter) ? "
+set otter=$<
+if ($otter == "") set otter=$base/$otterdir/source/otter
+set otterx=`echo $otter | sed "s/\//\\\//g"`
+
+echo ""
+echo -n "What command runs MACE-134 (default $base/$macedir/mace-loop) ? "
+set mace=$<
+if ($mace == "") set mace=$base/$macedir/mace-loop
+set macex=`echo $mace | sed "s/\//\\\//g"`
+
+echo ""
+echo "Making ivy and sivy scripts in"
+echo "      $src/util ..."
+echo ""
+
+cd $src/util
+
+foreach i (ivy sivy checker make-saved-ivy)
+    echo doing $i ...
+    sed -e "/set ivy_source=/s/=.*/=$srcx/" \
+	-e "/set acl2=/s/=.*/=$acl2x/" \
+	-e "/set otter_binary=/s/=.*/=$otterx/" \
+	-e "/set mace_binary/s/=.*/=$macex/" \
+	$i.orig >! $i
+    chmod +x $i	
+end
+
+# Go back to starting directory
+
+cd $base
+
+echo ""
+echo "Updating mace and mace-loop scripts in"
+echo "      $base/$macedir"
+echo "to use"
+echo "      $otter."
+echo ""
+
+foreach i ($macedir/mace $macedir/mace-loop)
+    echo doing $i ...
+    if (-e $i) then
+	cp $i temp$$
+    else
+	cp $i.orig temp$$
+    endif	
+    sed -e "/set OTTER=/s/=.*/=$otterx/" temp$$ >! $i
+    /bin/rm temp$$
+    chmod +x $i
+end
+
+echo 
+echo "**********************************************************************"
+echo "* Check the pathname in                                              *"
+echo "*        $src/arithmetic.lisp"
+echo "* and update it if necessary.                                        *"
+echo "**********************************************************************"
+echo ""
+echo "After that, the pathname configuration should be complete."
+echo ""
diff --git a/books/workshops/1999/ivy/ivy-v2/README b/books/workshops/1999/ivy/ivy-v2/README
new file mode 100644
index 0000000..e858c67
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/README
@@ -0,0 +1,120 @@
+===========================================================
+Ivy: A Preprocessor and Proof Checker for First-order Logic
+===========================================================
+
+Files:
+
+    README
+    Configure
+
+Subdirectories:
+
+    ivy-sources
+    otter-3.0.6     : the full otter-3.0.6 distribution
+    mace-1.3.4      : the full mace-1.3.4 distribution
+
+[Modification for ACL2 distribution:  To create directories otter-3.0.6 and
+ mace-1.3.4 on your system, issue the following commands:
+
+ gunzip otter-3.0.6.tar.gz
+ tar xvf otter-3.0.6.tar
+ rm otter-3.0.6.tar
+ gunzip mace-1.3.4.tar.gz
+ tar xvf mace-1.3.4.tar
+ rm mace-1.3.4.tar
+]
+
+------------
+INTRODUCTION
+------------
+
+Ivy is a preprocessor and proof checker for resolution/paramodulation
+theorem provers.  It is coded in ACL2 and proved sound for finite
+interpretations.
+
+Ivy is described in a paper that will appear as a chapter in
+	Computer-Aided Reasoning: ACL2 Case Studies
+	-------------------------------------------
+edited by Matt Kaufmann, Pete Manolios, and J Moore,
+to be published by Kluwer Academic in 2000. See
+http://www.wkap.nl/series.htm/ADFM.
+
+The Ivy web page is http://www.mcs.anl.gov/~mccune/acl2/ivy.
+
+----------
+INSTALLING
+----------
+
+To install Ivy, you have to (1) run the Configure script to update
+pathnames in several scripts, (2) certify the Ivy books, and
+(3) compile the external programs Otter and MACE (this can
+be done before running the Configure script if you like).
+
+If all goes according to plan, the following commands should work.
+(This works for us with ACL2-v2.4 on Linux and on Solaris.  The
+three makes---Ivy, Otter, and MACE---are independent and can be
+done in any order.)
+
+
+    ./Configure  # this will ask some questions; try the default answers
+
+    # Part 1. Make Ivy.
+
+    [look at ivy-sources/arithmetic.lisp, and change the pathname if necessary]
+    cd ivy-sources
+    make &                       # 90 minutes, 21 megabytes of output
+    cd ..
+
+    # Part 2. Make Otter.
+
+    cd otter-3.0.6/source
+    make
+    cd ../..
+
+    # Part 3. Make MACE.
+
+    cd mace-1.3.4
+    make
+    cd ..
+
+    # Simple tests of Ivy; the first calls Otter, the second calls MACE
+
+    ivy-sources/util/ivy  prove  ivy-sources/test/p-implies-p
+    ivy-sources/util/ivy  model  ivy-sources/test/p
+
+-------
+RUNNING
+-------
+
+The ivy script in ivy-sources/util is the way to run Ivy.
+The first argument is ( prove | refute | disprove | model ), and
+the second argument is a file containing a formula.
+You should be able to run it from anywhere, but you must have
+write-permission in the directory containing the input file.
+
+For further tests, see the README files in ivy-sources/test
+and ivy-sources/examples.
+
+---------
+SAVED_IVY
+---------
+
+Running ivy-sources/util/ivy loads all of the Ivy books, which takes
+a while.  Instead, you can try to create a saved_ivy file with the
+command
+
+    ivy-sources/util/make-saved-ivy
+
+After several minutes, you should have a file ivy-sources/saved_ivy.
+This seems to build a good saved_ivy on our Solaris systems, BUT IT
+DOESN'T WORK ON OUR LINUX SYSTEMS.
+
+You can run saved_ivy by using util/sivy instead of util/ivy:
+
+    ivy-sources/util/sivy  prove  ivy-sources/test/p-implies-p
+    ivy-sources/util/sivy  model  ivy-sources/test/p
+
+William McCune (mccune@mcs.anl.gov, http://www.mcs.anl.gov/~mccune)
+Olga Shumsky (shumsky@ece.nwu.edu, http://www.ece.nwu.edu/~shumsky)
+
+April 2000
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/Certify.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Certify.lsp
new file mode 100644
index 0000000..1f9ad02
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Certify.lsp
@@ -0,0 +1,50 @@
+(in-package "ACL2")
+
+(ubt! 1)
+
+(certify-book "arithmetic")   :u
+(certify-book "sets")   :u
+(certify-book "permutations")   :u
+(certify-book "base")   :u
+(certify-book "xeval")   :u
+(certify-book "variables")   :u
+(certify-book "alls")   :u
+(certify-book "wfftype")   :u
+(certify-book "stage")   :u
+(certify-book "keval")   :u
+(certify-book "close")   :u
+(certify-book "resolve")   :u
+(certify-book "paramod")   :u
+(certify-book "flip")   :u
+(certify-book "prop-subsume")   :u
+(certify-book "gensym-e")   :u
+(certify-book "instance")   :u
+(certify-book "instance-closure")   :u
+(certify-book "substitution")   :u
+(certify-book "simultaneous-d")   :u
+(certify-book "uc-conj")   :u
+(certify-book "derive")   :u
+(certify-book "simple-check")   :u
+(certify-book "cnf")   :u
+(certify-book "right-assoc")   :u
+(certify-book "nnf")   :u
+(certify-book "simplify")   :u
+(certify-book "rename")   :u
+(certify-book "rename-sound")   :u
+(certify-book "rename-unique")   :u
+(certify-book "rename-top")   :u
+(certify-book "pull")   :u
+(certify-book "pull-sound")   :u
+(certify-book "pull-pulls")   :u
+(certify-book "pull-top")   :u
+(certify-book "sk-misc-lemmas")   :u
+(certify-book "sk-useless")   :u
+(certify-book "sk-step")   :u
+(certify-book "sk-xbuild")   :u
+(certify-book "sk-step-sound")   :u
+(certify-book "skolem-top")   :u
+(certify-book "prover")   :u
+(certify-book "modeler")   :u
+(certify-book "top")   :u
+(certify-book "sugar")   :u
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/Include-graph.fig b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Include-graph.fig
new file mode 100644
index 0000000..5db63c1
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Include-graph.fig
@@ -0,0 +1,183 @@
+#FIG 3.2
+Landscape
+Center
+Inches
+Letter  
+100.00
+Single
+-2
+1200 2
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6075 9675 6525 9375
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6675 8400 6900 8175
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6525 7575 7050 7875
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6375 7275 4950 6675
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 7050 7875 10950 6825
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 9150 6750 6525 7275
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6075 9675 5400 8625
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 5325 8325 6375 7575
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 4875 6375 4575 5925
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 4425 5625 4500 5175
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6450 7275 5850 5625
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6450 7200 6600 6975
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6750 6750 6825 6525
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 4575 4875 6225 3675
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6075 5325 6225 3750
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6900 6525 9150 8925
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 9225 6750 9225 8850
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 10950 6825 9225 8925
+2 1 0 1 0 7 100 0 -1 0.000 0 0 -1 0 0 2
+	 6600 8775 6525 9075
+2 1 2 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6825 6225 7950 6075
+2 1 2 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6825 6225 6900 5925
+2 1 2 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6825 6225 6150 5625
+2 1 2 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6825 6225 4875 5925
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6375 3675 8025 5775
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 3150 6450 6300 7275
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6300 7275 2325 6675
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6750 7950 1575 6825
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6000 1500 1500 6525
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 2325 6375 6000 1575
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6000 1650 3075 6150
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6975 5625 6300 3750
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 7950 6075 6525 7275
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6075 1725 6225 3375
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6150 1650 9150 6150
+2 1 0 1 0 7 100 0 -1 3.000 0 0 -1 0 0 2
+	 6150 1575 10875 6225
+2 1 0 1 0 7 0 0 -1 0.000 0 0 -1 0 0 2
+	 7350 5400 7050 5100
+2 1 0 1 0 7 0 0 -1 0.000 0 0 -1 0 0 2
+	 6975 4800 6375 3750
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 750 6450 5925 1500
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 750 7050 6600 7950
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 6645 7226 8160 6641
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 690 7046 4215 8276
+2 3 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 5
+	 10920 6206 10320 6506 10920 6806 11520 6506 10920 6206
+2 3 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 5
+	 9225 6131 8625 6431 9225 6731 9825 6431 9225 6131
+2 3 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 5
+	 660 6446 60 6746 660 7046 1260 6746 660 6446
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8625 1781 8100 2096
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 1
+	 8625 1781
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8640 1811 8250 2096
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8640 1826 8475 2156
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8640 1841 8670 2216
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8625 1826 8970 2231
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8700 1841 9180 2261
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 7440 1196 8535 1556
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 6420 1361 7395 1211
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 8640 1856 8310 2186
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 6120 9911 6900 10061
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 6960 10046 8805 9236
+2 1 0 1 0 7 0 0 -1 3.000 0 0 -1 0 0 2
+	 4650 9236 5940 9671
+3 2 0 1 0 7 100 0 -1 0.000 0 0 0 3
+	 6450 7275 6450 6450 6750 5925
+	 0.000 -1.000 0.000
+3 2 0 1 0 7 0 0 -1 0.000 0 0 0 3
+	 6525 7200 7350 6375 7425 5625
+	 0.000 -1.000 0.000
+3 2 2 1 0 7 0 0 -1 3.000 0 0 0 3
+	 6825 6225 7275 5925 7425 5625
+	 0.000 -1.000 0.000
+3 2 0 1 0 7 0 0 -1 3.000 0 0 0 3
+	 8445 6446 8385 5591 6150 1856
+	 0.000 -1.000 0.000
+3 0 0 1 0 7 0 0 -1 3.000 0 0 0 5
+	 4275 8261 4380 7241 3645 6206 3510 5666 4335 5201
+	 0.000 1.000 1.000 1.000 0.000
+3 0 0 1 0 7 0 0 -1 3.000 0 0 0 4
+	 4350 8291 5685 7556 7350 7631 9135 6821
+	 0.000 1.000 1.000 0.000
+3 0 2 1 0 7 0 0 -1 3.000 0 0 0 4
+	 4890 6431 4125 6116 1410 7586 690 7106
+	 0.000 1.000 1.000 0.000
+3 0 0 1 0 7 0 0 -1 3.000 0 0 0 4
+	 9210 8951 7860 8276 1740 7736 735 7166
+	 0.000 1.000 1.000 0.000
+4 0 0 0 0 0 12 0.0000 4 135 630 300 6825 skolem*\001
+4 0 0 0 0 0 12 0.0000 4 135 240 1350 6750 cnf\001
+4 0 0 0 0 0 12 0.0000 4 180 600 2025 6600 simplify\001
+4 0 0 0 0 0 12 0.0000 4 135 240 3000 6375 nnf\001
+4 0 0 0 0 0 12 0.0000 4 135 1305 3675 5850 instance-closure\001
+4 0 0 0 0 0 12 0.0000 4 135 900 4200 5100 substitution\001
+4 0 0 0 0 0 12 0.0000 4 135 465 6000 3600 derive\001
+4 0 0 0 0 0 12 0.0000 4 180 1110 5250 5550 prop-subsume\001
+4 0 0 0 0 0 12 0.0000 4 135 555 6750 5850 resolve\001
+4 0 0 0 0 0 12 0.0000 4 180 600 7650 6000 uc-conj\001
+4 0 0 0 0 0 12 0.0000 4 135 405 6600 6450 close\001
+4 0 0 0 0 0 12 0.0000 4 135 405 6450 6900 keval\001
+4 0 0 0 0 0 12 0.0000 4 150 420 6150 7500 stage\001
+4 0 0 0 0 0 12 0.0000 4 180 585 6600 8100 wfftype\001
+4 0 0 0 0 0 12 0.0000 4 135 270 6450 8700 alls\001
+4 0 0 0 0 0 12 0.0000 4 135 690 6000 9300 variables\001
+4 0 0 0 0 0 12 0.0000 4 135 405 5100 8550 xeval\001
+4 0 0 0 0 0 12 0.0000 4 180 990 8550 9150 permutations\001
+4 0 0 0 0 0 12 0.0000 4 135 645 8850 6525 rename*\001
+4 0 0 0 0 0 12 0.0000 4 180 360 10800 6600 pull*\001
+4 0 0 0 0 0 12 0.0000 4 180 645 7125 5550 paramod\001
+4 0 0 0 0 0 12 0.0000 4 180 240 6900 5025 flip\001
+4 0 0 0 0 0 12 0.0000 4 135 645 4500 6600 instance\001
+4 0 0 0 0 0 12 0.0000 4 180 900 7725 6600 right-assoc\001
+4 0 0 0 0 0 12 0.0000 4 180 780 3825 8516 gensym-d\001
+4 0 0 0 0 0 12 0.0000 4 135 1440 420 8816 *Contains diamond\001
+4 0 0 0 0 0 12 0.0000 4 180 1365 420 9041  shaped subgraph.\001
+4 0 0 0 0 0 12 0.0000 4 180 1695 465 9671 Dotted lines represent\001
+4 0 0 0 0 0 12 0.0000 4 135 1080 465 9896 local includes.\001
+4 0 0 0 0 0 12 0.0000 4 135 600 8385 1721 modeler\001
+4 0 0 0 0 0 12 0.0000 4 150 240 7290 1136 top\001
+4 0 0 0 0 0 12 0.0000 4 135 480 6060 1515 prover\001
+4 0 0 0 0 0 12 0.0000 4 180 1380 7890 2486 (similar to prover)\001
+4 0 0 0 0 0 12 0.0000 4 105 330 6780 10215 sets\001
+4 0 0 0 0 0 12 0.0000 4 135 360 5925 9840 base\001
+4 0 0 0 0 0 12 0.0000 4 135 420 4410 9176 sugar\001
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/Include-graph.ps.gz b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Include-graph.ps.gz
new file mode 100644
index 0000000..a8c3871
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Include-graph.ps.gz
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/Ivy-books b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Ivy-books
new file mode 100644
index 0000000..f4c2cbe
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Ivy-books
@@ -0,0 +1,45 @@
+arithmetic.lisp
+sets.lisp
+permutations.lisp
+base.lisp
+xeval.lisp
+variables.lisp
+alls.lisp
+wfftype.lisp
+stage.lisp
+keval.lisp
+close.lisp
+resolve.lisp
+paramod.lisp
+flip.lisp
+prop-subsume.lisp
+gensym-e.lisp
+instance.lisp
+instance-closure.lisp
+substitution.lisp
+simultaneous-d.lisp
+uc-conj.lisp
+derive.lisp
+simple-check.lisp
+cnf.lisp
+right-assoc.lisp
+nnf.lisp
+simplify.lisp
+rename.lisp
+rename-sound.lisp
+rename-unique.lisp
+rename-top.lisp
+pull.lisp
+pull-sound.lisp
+pull-pulls.lisp
+pull-top.lisp
+sk-misc-lemmas.lisp
+sk-useless.lisp
+sk-step.lisp
+sk-xbuild.lisp
+sk-step-sound.lisp
+skolem-top.lisp
+prover.lisp
+modeler.lisp
+top.lisp
+sugar.lisp
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/Makefile b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Makefile
new file mode 100644
index 0000000..9731736
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Makefile
@@ -0,0 +1,40 @@
+include ../../../../../Makefile-generic
+
+# Override default setting since Certify.lisp is not intended to be certified.
+
+BOOKS = alls arithmetic base close cnf derive		\
+  flip gensym-e instance-closure instance keval		\
+  modeler nnf paramod permutations prop-subsume		\
+  prover pull-pulls pull-sound pull-top pull		\
+  rename-sound rename-top rename-unique rename resolve	\
+  right-assoc sets simple-check simplify simultaneous-d	\
+  sk-misc-lemmas sk-step-sound sk-step sk-useless	\
+  sk-xbuild skolem-top stage substitution sugar top	\
+  uc-conj variables wfftype xeval
+
+-include Makefile-deps
+
+# Original target from Ivy distribution:
+ivy:
+	acl2 < Certify.lsp > Certify.out
+	grep -v FAIL Certify.out > /dev/null
+
+realclean:
+	/bin/rm -f *.out
+	/bin/rm -f *.cert
+	/bin/rm -f *.o
+	/bin/rm -f saved_ivy
+	/bin/rm -f test/*.in
+	/bin/rm -f test/*.proof-obj
+	/bin/rm -f test/*.model
+	/bin/rm -f examples/*.in
+	/bin/rm -f examples/*.proof-obj
+	/bin/rm -f examples/*.model
+	/bin/rm -f exercises/*.out
+	/bin/rm -f exercises/*.cert
+	/bin/rm -f exercises/*.o
+	/bin/rm -f util/ivy
+	/bin/rm -f util/sivy
+	/bin/rm -f util/checker
+	/bin/rm -f util/make-saved-ivy
+	/bin/rm -f *~ */*~
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/Makefile.original b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Makefile.original
new file mode 100644
index 0000000..fe11e96
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/Makefile.original
@@ -0,0 +1,24 @@
+ivy:
+	acl2 < Certify.lisp > Certify.out
+	grep -v FAIL Certify.out > /dev/null
+
+realclean:
+	/bin/rm -f *.out
+	/bin/rm -f *.cert
+	/bin/rm -f *.o
+	/bin/rm -f saved_ivy
+	/bin/rm -f test/*.in
+	/bin/rm -f test/*.proof-obj
+	/bin/rm -f test/*.model
+	/bin/rm -f examples/*.in
+	/bin/rm -f examples/*.proof-obj
+	/bin/rm -f examples/*.model
+	/bin/rm -f exercises/*.out
+	/bin/rm -f exercises/*.cert
+	/bin/rm -f exercises/*.o
+	/bin/rm -f util/ivy
+	/bin/rm -f util/sivy
+	/bin/rm -f util/checker
+	/bin/rm -f util/make-saved-ivy
+	/bin/rm -f *~ */*~
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/README b/books/workshops/1999/ivy/ivy-v2/ivy-sources/README
new file mode 100644
index 0000000..96f9797
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/README
@@ -0,0 +1,39 @@
+	===========
+	Ivy sources
+	===========
+
+Files:
+
+  Makefile          :
+  *.lisp            : the books
+  Certify.lisp      : ACL2 commands to certify all the books
+  Include-graph.ps  : a graph showing the include-structure of the books
+
+Subdirectories:
+
+  util              : Common Lisp code for the external-prover interface,
+                    : and scripts for running Ivy
+  test              : a few simple tests of Ivy
+  examples          : more tests of Ivy
+  exercises         : exercises and solutions
+
+To certify all of the books,
+
+  1. make sure the pathname in arithmetic.lisp is correct (unless this
+     directory comes from the ACL2 distribution and has not been moved relative
+     to that distribution)
+
+  2. Type make on a Unix system.  Otherwise:
+     acl2 < Certify.lisp > Certify.out
+     This takes almost 90 minutes on a PII-400 Linux box and
+     generates about 23 megabytes of output.
+
+To run Ivy, see
+
+  test/README
+  examples/README
+
+The entire Ivy distribution, which includes mace-1.3.4 and otter-3.0.6 (but is
+not included in the ACL2 distribution), may be found at:
+
+  http://www.mcs.anl.gov/~mccune/acl2/ivy/ivy-v2.tar.gz
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/README.original b/books/workshops/1999/ivy/ivy-v2/ivy-sources/README.original
new file mode 100644
index 0000000..081c2e9
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/README.original
@@ -0,0 +1,31 @@
+	===========
+	Ivy sources
+	===========
+
+Files:
+
+  Makefile          :
+  *.lisp            : the books
+  Certify.lisp      : ACL2 commands to certify all the books
+  Include-graph.ps  : a graph showing the include-structure of the books
+
+Subdirectories:
+
+  util              : Common Lisp code for the external-prover interface,
+                    : and scripts for running Ivy
+  test              : a few simple tests of Ivy
+  examples          : more tests of Ivy
+  exercises         : exercises and solutions
+
+To certify all of the books,
+
+  1. make sure the pathname in arithmetic.lisp is correct;
+
+  2. acl2 < Certify.lisp > Certify.out
+     This takes almost 90 minutes on a PII-400 Linux box and
+     generates about 23 megabytes of output.
+
+To run Ivy, see
+
+  test/README
+  examples/README
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/alls.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/alls.lisp
new file mode 100644
index 0000000..bb4bb0c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/alls.lisp
@@ -0,0 +1,193 @@
+(in-package "ACL2")
+
+;; This book is mostly about universal closures.  The theorem
+;; prover operates on clauses (which contain free variables and
+;; no quantifiers, and free variables are understood as being
+;; universally quantified), and when proving soundness of various
+;; things, we have to frequently add and remove universal quantifiers
+;; to the top of a formula.
+;;
+;; Some of this applies to existential quantifiers as well.
+
+(include-book "variables")
+(include-book "../../../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+;;------------------------------------------
+;; Function alls (vars f) tacks on a list of variables as universally
+;; quantified variables.
+
+(defun alls (vars f)
+  (declare (xargs :guard (and (var-list vars) (wff f))))
+  (if (atom vars)
+      f
+      (list 'all (car vars) (alls (cdr vars) f))))
+
+(defthm alls-vars-f-wff
+  (implies (and (var-list vars)
+		(wff f))
+	   (wff (alls vars f))))
+
+(defthm subst-alls-commute
+  (implies (and (not (member-equal x vars))
+		(var-list vars))
+	   (equal (subst-free (alls vars f) x e)
+		  (alls vars (subst-free f x e)))))
+
+(defthm remove-vars-alls
+  (implies (and (domain-term e)
+                (var-list a)
+                (not (member-equal x a))
+                (not (remove-equal x (free-vars (alls a f)))))
+           (not (free-vars (alls a (subst-free f x e)))))
+  :hints (("Goal"
+           :use ((:instance vars-alls-free (f (alls a f)))))))
+
+(defthm alls-preserves-closedness
+  (implies (not (free-vars f))
+	   (not (free-vars (alls v f))))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm alls-all
+  (implies (and (consp vars)
+		(var-list vars))
+	   (wfall (alls vars f))))
+
+(defthm alls-quant
+  (implies (and (consp vars)
+		(var-list vars))
+	   (wfquant (alls vars f))))
+
+(defun remove-leading-alls (f)
+  (declare (xargs :guard (wff f)))
+  (if (wfall f)
+      (remove-leading-alls (a2 f))
+      f))
+
+(defthm remove-leading-alls-preserves-wff
+  (implies (wff f)
+	   (wff (remove-leading-alls f))))
+
+(defun leading-alls (f)
+  (declare (xargs :guard (wff f)))
+  (if (wfall f)
+      (cons (a1 f) (leading-alls (a2 f)))
+      nil))
+
+(defthm lead-alls-var-list
+  (var-list (leading-alls f)))
+
+(defthm alls-lead-remove-f-is-f
+  (equal (alls (leading-alls f) (remove-leading-alls f)) f))
+
+(defun remove-leading-quants (f)
+  (declare (xargs :guard (wff f)))
+  (if (wfquant f)
+      (remove-leading-quants (a2 f))
+      f))
+
+(defun leading-quants (f)
+  (declare (xargs :guard (wff f)))
+  (if (wfquant f)
+      (cons (a1 f) (leading-quants (a2 f)))
+      nil))
+
+;;--------------------
+
+(defthm leading-all-is-quantified-var
+  (implies (not (member-equal x (quantified-vars f)))
+	   (not (member-equal x (leading-alls f)))))
+
+(defthm setp-qvars-leading-alls
+  (implies (setp (quantified-vars f))
+	   (setp (leading-alls f))))
+
+(defthm varset-qvars-leading-alls
+  (implies (var-set (quantified-vars f))
+	   (var-set (leading-alls f))))
+
+;;------------
+;; Prove that the universal closure of a formula is closed.
+;; First prove thw two key properties, then do a resolution
+;; step to get the result in terms of member-equal, then
+;; get it in the desired form.
+
+(defthm alls-eliminates-free-vars
+  (implies (member-equal x vars)
+	   (not (member-equal x (free-vars (alls vars f))))))
+
+(defthm alls-doesnt-introduce-free-vars
+  (implies (not (member-equal x (free-vars f)))
+	   (not (member-equal x (free-vars (alls vars f))))))
+
+(defthm universal-closure-is-closed-almost-in-final-form
+  (not (member-equal x (free-vars (alls (free-vars f) f))))
+  :hints (("Goal"
+	   :use ((:instance alls-eliminates-free-vars
+			    (x x) (f f) (vars (free-vars f)))
+		 (:instance alls-doesnt-introduce-free-vars
+			    (x x) (f f) (vars (free-vars f))))
+	   )))
+
+(defmacro universal-closure (f)
+  (list 'alls (list 'free-vars f) f))
+
+(defthm universal-closure-is-closed
+  (not (free-vars (universal-closure f)))
+  :hints (("Goal"
+	   :use ((:instance consp-has-member-equal
+			    (x (free-vars (alls (free-vars f) f))))))))
+
+;;-------------------------------------
+;; Eval inductions on variables.  These functions give useful induction
+;; schemes for proving soundness theorems about universal closures,
+;; in particular about formulas (alls vars f), with evaluation function xeval.
+;; Think of the two arguments "vars f" as "(alls vars f)".
+
+(defun var-induct (vars f dom i)
+  (declare (xargs :measure (cons (+ 1 (acl2-count vars)) (acl2-count dom))
+                  :guard (and (var-list vars) (wff f)
+                              (domain-term-list (fringe dom)))))
+  (if (atom vars)
+      nil
+      (if (atom dom)
+          (var-induct (cdr vars) (subst-free f (car vars) dom) (domain i) i)
+          (cons (var-induct vars f (car dom) i)
+                (var-induct vars f (cdr dom) i)))))
+
+;; This induction scheme goes through two formulas together.
+
+(defun var-induct-2 (vars f g dom i)
+  (declare (xargs :measure (cons (+ 1 (acl2-count vars)) (acl2-count dom))
+                  :guard (and (var-list vars) (wff f) (wff g)
+                              (domain-term-list (fringe dom)))))
+  (if (atom vars)
+      nil
+      (if (atom dom)
+          (var-induct-2 (cdr vars)
+                        (subst-free f (car vars) dom)
+                        (subst-free g (car vars) dom)
+                        (domain i) i)
+          (cons (var-induct-2 vars f g (car dom) i)
+                (var-induct-2 vars f g (cdr dom) i)))))
+
+;-------------------------
+
+(defthm not-free-feval-same
+  (implies (and (variable-term x)
+                (not (member-equal x (free-vars f))))
+           (equal (feval-d (list 'all x f) dom i)
+                  (feval f i)))
+  :hints (("Goal"
+           :induct (dom-i dom))
+	  ("Subgoal *1/1"
+           :in-theory (enable not-free-not-change-2))))
+
+(defthm feval-alls-true
+  (implies (var-list vars)
+	   (feval (alls vars 'true) i)))
+
+(defthm feval-alls-false
+  (implies (var-list vars)
+	   (not (feval (alls vars 'false) i))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.lisp
new file mode 100644
index 0000000..face859
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/arithmetic.lisp
@@ -0,0 +1,9 @@
+(in-package "ACL2")
+
+;; We need this arithmetic book in several places.  The purpose
+;; of this book is to isolate the pathname, which has to be changed
+;; when moving to another site or OS.
+
+(include-book "../../../../../arithmetic/top")
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/base.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/base.lisp
new file mode 100644
index 0000000..448b402
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/base.lisp
@@ -0,0 +1,677 @@
+(in-package "ACL2")
+
+;; This book contains the core definitions of our first-order logic.
+;; The main definitions are wff (well-formed formula) and feval
+;; (evaluation in finite interpretations).  Look elsewhere for
+;; comments on infinite interpretations.
+;;
+;; At the end is a simple example of a soundness proof.
+
+(include-book "sets")
+(include-book "../../../../../ordinals/e0-ordinal")
+(set-well-founded-relation ACL2::e0-ord-<)
+
+;(defmacro natp (n)
+;    (list 'and (list 'integerp n) (list '<= 0 n)))
+
+(defun fringe (x)
+  (declare (xargs :guard t))
+  (if (atom x)
+      (list x)
+      (append (fringe (car x)) (fringe (cdr x)))))
+
+(defthm fringe-is-true-listp
+  (true-listp (fringe x)))
+
+(defun fassoc (x a)  ;; an unguarded version of assoc-equal
+  (declare (xargs :guard t))
+  (cond ((atom a) nil)
+	((and (consp (car a))
+	      (equal x (caar a))) (car a))
+	(t (fassoc x (cdr a)))))
+
+;; A variable is a symbolp.
+
+(defun variable-term (x)
+  (declare (xargs :guard t))
+  (symbolp x))
+
+;; A function symbol is a symbolp.
+
+(defun function-symbol (x)
+  (declare (xargs :guard t))
+  (symbolp x))
+
+;; Reserved logic symbols.  A relation symbol cannot be one of these.
+;; This is mostly to keep users from writing confusing formulas.  For
+;; example, 'and is binary; if a user writes a ternary 'and in a formula
+;; context, it will be non-well-formed rather than an atomic formula.
+;; (Note that one of these CAN be a function symbol.)
+
+(defun logic-symbolp (x)
+  (declare (xargs :guard t))
+  (or (equal x 'true)
+      (equal x 'false)
+      (equal x 'and)
+      (equal x 'or)
+      (equal x 'not)
+      (equal x 'imp)
+      (equal x 'iff)
+      (equal x 'all)
+      (equal x 'exists)))
+
+;; A relation symbol is a symbolp that is not a logic-symbolp.
+;; This means that a relation symbol is also a function symbol.
+;; Atomic formulas are distinguished from terms by context.
+
+(defun relation-symbol (x)
+  (declare (xargs :guard t))
+  (and (symbolp x) (not (logic-symbolp x))))
+
+;; Note: Arity-overloading is acceptable for function symbols
+;; and relation symbols, and a symbol can serve as both a function
+;; symbol and a relation symbol.
+;;
+;; We might have to be careful in a few places, because
+;; (and (variable-term nil) (function-symbol nil) (relation-symbol nil)).
+
+;; Macros a1 and a2 get the first and second arguments of a formula
+;; (that is, the second and third members of a list).
+
+(defmacro a1 (p)  ;; argument 1
+  (list 'cadr p))
+
+(defmacro a2 (p)  ;; argument 2
+  (list 'caddr p))
+
+;; These functions check for true lists of length 2 and 3.
+;; I don't know if it would be better to use true-listp and len.
+
+(defun list2p (l)
+  (declare (xargs :guard t))
+  (and (consp l) (consp (cdr l)) (null (cddr l))))
+
+(defun list3p (l)
+  (declare (xargs :guard t))
+  (and (consp l) (list2p (cdr l))))
+
+;;------------------------------------------------------
+;; The following functions check if a formula has a particular type
+;; and is well-formed at the top level.  Note that subformulas are
+;; not checked for well-formedness here.  These are the official
+;; functions, but they are slow.  For recursion through formulas,
+;; it is usually much faster to use wfbinary, wfquant, below.
+
+(defun wfnot (f)
+  (declare (xargs :guard t))
+  (and (list2p f) (equal (car f) 'not)))
+
+(defun wfand (p)
+  (declare (xargs :guard t))
+  (and (list3p p) (equal (car p) 'and)))
+
+(defun wfor  (p)
+  (declare (xargs :guard t))
+  (and (list3p p) (equal (car p) 'or)))
+
+(defun wfimp (p)
+  (declare (xargs :guard t))
+  (and (list3p p) (equal (car p) 'imp)))
+
+(defun wfiff (p)
+  (declare (xargs :guard t))
+  (and (list3p p) (equal (car p) 'iff)))
+
+(defun wfall (p)
+  (declare (xargs :guard t))
+  (and (list3p p) (equal (car p) 'all) (variable-term (a1 p))))
+
+(defun wfexists (p)
+  (declare (xargs :guard t))
+  (and (list3p p) (equal (car p) 'exists) (variable-term (a1 p))))
+
+(defun wfatomtop (p)  ;; note different from wfatom below
+  (declare (xargs :guard t))
+  (and (consp p)
+       (relation-symbol (car p))
+       (true-listp (cdr p))))
+
+;;--------------------------------------------
+;; Using these instead of the preceding functions can really
+;; speed up proofs, I think because list3p gets expanded a lot less.
+
+(defun wfbinary (f)
+  (declare (xargs :guard t))
+  (and (list3p f)
+       (or (equal (car f) 'and)
+	   (equal (car f) 'or)
+	   (equal (car f) 'imp)
+	   (equal (car f) 'iff))))
+
+(defun wfquant (f)
+  (declare (xargs :guard t))
+  (and (list3p f)
+       (or (equal (car f) 'all)
+	   (equal (car f) 'exists))
+       (variable-term (a1 f))))
+
+;; Wfeq recognizes a true-listp of len 3, with = as the first member.
+
+(defun wfeq (a)
+  (declare (xargs :guard t))
+  (and (true-listp a) (equal (len a) 3) (equal (car a) '=)))
+
+;; A wf-ap-term-top (well-formed application term top) is just
+;; a true-listp with a function-symbol as the first member.
+
+(defun wf-ap-term-top (tm)
+  (declare (xargs :guard t))
+  (and (consp tm)
+       (function-symbol (car tm))
+       (true-listp (cdr tm))))
+
+;;=================================================================
+;; In the general version, the encapsulation starts here.
+;;=================================================================
+
+;; A domain-term is a member of the domain of some interpretation.
+;; Below, when we define well-formed term, we will allow domain-term
+;; to be a well-formed term, because when we evaluate formulas in an
+;; interpretation, we substitute domain-terms for free variables,
+;; and we wish to retain well-formedness.
+;;
+;; A Side Note.  When we evaluate quantified formulas, we  immediately
+;; substitute domain-terms for variables, then continue evaluating.
+;; An alternative is to delay the substitution (by carrying an alist)
+;; until we get down to variables.  We now think the alternative would
+;; simplify things in several ways, for example, (1) there wouldn't be
+;; any reason to make domain-terms be well-formed terms, and (2)
+;; inductions on the evaluation functions would be simpler.
+;; Big exercise: try it!
+;;
+;; A domain-term is a natural number.  (Function symbols, in particular
+;; constant symbols, cannot be natural numbers, so they won't get
+;; mixed up with domain-terms.)
+
+(defun domain-term (e)
+  (declare (xargs :guard t))
+  (natp e))
+
+(in-theory (disable domain-term))
+
+;; -------------------------------------------------
+;; Well-formed terms.  Note that a domain-term is a well-formed term.
+
+(defun wft-list (l)
+  (declare (xargs :guard t))
+  (if (atom l)
+      (null l)
+    (and (or (variable-term (car l))
+	     (domain-term (car l))
+	     (and (consp (car l))
+		  (function-symbol (caar l))
+		  (wft-list (cdar l))))
+	 (wft-list (cdr l)))))
+
+(defmacro wft (x) ;; well-formed term
+  (list 'wft-list (list 'list x)))
+
+;;-------------------------------------------------
+;; Formulas
+
+;; Well-Formed Atomic Formula
+
+(defun wfatom (a)
+  (declare (xargs :guard t))
+  (and (consp a)
+       (relation-symbol (car a))
+       (wft-list (cdr a))))
+
+;; Well-Formed Formula
+
+(defun wff (f)
+  (declare (xargs :guard t))
+  (cond ((equal f 'true) t)
+	((equal f 'false) t)
+	((wfatom f) t)
+	((wfnot f) (wff (a1 f)))
+	((wfbinary f) (and (wff (a1 f)) (wff (a2 f))))
+	((wfquant f) (wff (a2 f)))
+	(t nil)))
+
+;;--------------------------------------------------------
+;; Back to domain-terms.
+
+(defun domain-term-list (l)
+  (declare (xargs :guard t))
+  (cond ((atom l) (null l))
+	(t (and (domain-term (car l))
+		(domain-term-list (cdr l))))))
+
+(defthm domain-term-list-true-listp
+  (implies (domain-term-list l)
+	   (true-listp l)))
+
+;; A domainp is the domain of some interpretation.
+;; It is a binary tree whose fringe consists of domain-terms,
+;; contains 0, and has no duplicates.
+;; (Why not make it a list of domain-terms?  I think a binary
+;; tree is more convenient, because domains are nonempty.)
+;; (Why not make it a natp, say n, with domain elements 0, ..., n-1?)
+
+(defun domainp (dom)
+  (declare (xargs :guard t))
+  (and (domain-term-list (fringe dom))
+       (setp (fringe dom))
+       (member-equal 0 (fringe dom))))
+
+;; There are no recognizers for function, function-list, relation,
+;; relation-list, or interpretation.  If something goes wrong
+;; when evaluating a formula or term in an interpretation
+;; (the interpretation is not well-formed or inadequate, the formula
+;; is not well-formed or contains free variables)
+;; default values are returned (nil for formulas, and 0 for terms).
+;;
+;; Apply a function to a tuple of domain-terms.
+
+(defun fapply (f tuple)
+  (declare (xargs :guard (domain-term-list tuple)))
+  (if (and (fassoc tuple f)
+	   (domain-term (cdr (fassoc tuple f))))
+      (cdr (fassoc tuple f))
+    0))
+
+(defthm fapply-returns-domain-term
+  (domain-term (fapply f tuple)))
+
+;; Apply a relation to a tuple of domain-terms.
+
+(defun rapply (r tuple)
+  (declare (xargs :guard (domain-term-list tuple)))
+  (and (fassoc tuple r)
+       (equal (cdr (fassoc tuple r)) t)))  ;; note true iff t
+
+(in-theory (disable fapply rapply))
+
+;;------------------------------------------------------
+;; Interpretation.  There is no recognizer.
+;;
+;; A "nice" interpretation (an undefined notion) will consist of
+;; (domainp . (relation-list . function-list)).
+
+;; Access functions for the 3 components of an interpretation.
+
+(defun domain (i)
+  (declare (xargs :guard t))
+  (cond ((and (consp i) (domainp (car i))) (car i))
+	(t 0)))
+
+(defun relations (i)
+  (declare (xargs :guard t))
+  (cond ((and (consp i) (consp (cdr i))) (cadr i))
+	(t nil)))
+
+(defun functions (i)
+  (declare (xargs :guard t))
+  (cond ((and (consp i) (consp (cdr i))) (cddr i))
+	(t nil)))
+
+(defthm domain-is-domainp
+  (domainp (domain i)))
+
+(defthm fringe-of-domain-is-domain-term-list
+  (domain-term-list (fringe (domain i))))
+
+(defthm fringe-of-domain-contains-0
+  (member-equal 0 (fringe (domain i))))
+
+(in-theory (disable domain relations functions))
+
+;;-------------------------------------------------
+;; This section leads to the evaluation function.
+
+;; Flookup takes a function-symbol, a tuple of domain-terms,
+;; and an interpretation, and looks up the value of the function
+;; for that tuple.  If anything goes wrong at the top level,
+;; the default value 0 is returned.
+
+(defun flookup (fsym tuple i)
+  (declare (xargs :guard (and (function-symbol fsym)
+			      (domain-term-list tuple))))
+  (if (or (not (function-symbol fsym))
+	  (not (domain-term-list tuple)))
+      0  ;; default value
+    (let ((sym-func (fassoc (cons fsym (len tuple)) (functions i))))
+      (if (not (consp sym-func))
+	  0  ;; function is not in function list
+	(let ((val (fapply (cdr sym-func) tuple)))
+	  (if (member-equal val (fringe (domain i)))
+	      val
+	    0  ;; function value is not in the domain
+	    ))))))
+
+(defthm flookup-returns-domain-term
+  (domain-term (flookup func-sym tuple i)))
+
+;; Eval-term-list takes a list of terms and an interpretation,
+;; evaluates the terms, and returns a list of domain-terms.
+;; If vars-in-term-list were defined at this point, it should
+;; be in the guard.
+
+(defun eval-term-list (l i)
+  (declare (xargs :guard (wft-list l)
+		  :verify-guards nil))
+  (if (atom l)
+      nil
+    (cons (cond ((domain-term (car l))
+		 (if (member-equal (car l) (fringe (domain i)))
+		     (car l)
+		   0)) ;; default value
+		((variable-term (car l)) 0) ;; default value
+		((wf-ap-term-top (car l))
+		 (flookup (caar l) (eval-term-list (cdar l) i) i))
+		(t 0))  ;; default value for non-term
+	  (eval-term-list (cdr l) i))))
+
+(defmacro eval-term (tm i)
+  (list 'car (list 'eval-term-list (list 'list tm) i)))
+
+(defthm eval-term-list-gives-domain-term-list
+  (domain-term-list (eval-term-list l i)))
+
+(verify-guards eval-term-list)
+
+;; Rlookup takes a relation-symbol, a tuple of domain-terms, and an
+;; interpretation, and looks up the value of the relation for that
+;; tuple.  If anything goes wrong (at the top level), the default
+;; value nil is returned.
+
+(defun rlookup (rsym tuple i)
+  (declare (xargs :guard (and (relation-symbol rsym)
+			      (domain-term-list tuple))))
+  (cond ((not (relation-symbol rsym)) nil)
+	((not (domain-term-list tuple)) nil)
+	((consp (fassoc (cons rsym (len tuple))
+			(relations i)))
+	 (rapply (cdr (fassoc (cons rsym (len tuple))
+			      (relations i))) tuple))
+	(t nil)))
+
+(defthm wft-list-1  ;; for eval-atomic guard
+  (implies (and (wft-list l)
+		(consp l))
+	   (wft-list (list (car l)))))
+
+(defthm wft-list-2  ;; for eval-atomic guard
+  (implies (wft-list (cons x y))
+	   (wft-list (list x)))
+  :hints (("Goal"
+	   :use ((:instance wft-list-1 (l (cons x y)))))))
+
+;; Eval-atomic evaluates an atomic formula in an interpretation.
+;; Note that an equality atom is true iff the two arguments
+;; evaluate to the same thing.  If free-vars were defined
+;; at this point, it should be in the guard.
+
+(defun eval-atomic (a i)
+  (declare (xargs :guard (wfatom a)))
+  (cond ((or (not (consp a))
+	     (not (relation-symbol (car a)))
+	     (not (true-listp (cdr a))))
+	 nil)  ;; default value
+	((wfeq a) (equal (eval-term (a1 a) i)
+			 (eval-term (a2 a) i)))
+	(t (rlookup (car a) (eval-term-list (cdr a) i) i))))
+
+(in-theory (disable eval-atomic))  ;; Most soundness proofs don't need it.
+
+;; Function subst-term-list substitutes a term for a variable
+;; in a list of terms.
+
+(defun subst-term-list (l v tm)
+  (declare (xargs :guard (and (wft-list l) (variable-term v) (wft tm))))
+  (if (atom l)
+      l
+    (cons (cond ((variable-term (car l)) (if (equal (car l) v)
+					     tm
+					   (car l)))
+		((domain-term (car l)) (car l))
+		((wf-ap-term-top (car l))
+		 (cons (caar l) (subst-term-list (cdar l) v tm)))
+		(t (car l)))  ;; leave non-term unchanged
+	  (subst-term-list (cdr l) v tm))))
+
+(defmacro subst-term (t1 x t2)
+  (list 'car (list 'subst-term-list (list 'list t1) x t2)))
+
+;; subst-term-list preserves true-listp and well-formedness.
+
+(defthm subst-term-list-preserves-true-listp
+  (equal (true-listp (subst-term-list l x tm))
+	 (true-listp l)))
+
+(defthm subst-term-list-wf
+  (implies (and (wft-list l)
+		(wft tm))
+	   (wft-list (subst-term-list l v tm))))
+
+;; Function subst-free substitutes a term for free
+;; occurrences of a variable in a formula.
+
+(defun subst-free (f v tm)
+  (declare (xargs :guard (and (wff f)
+			      (variable-term v)
+			      (wft tm))))
+  (cond ((wfnot f) (list 'not (subst-free (a1 f) v tm)))
+	((wfbinary f) (list (car f)
+			    (subst-free (a1 f) v tm)
+			    (subst-free (a2 f) v tm)))
+	((wfquant f) (if (equal (a1 f) v)
+			 f
+		       (list (car f)
+			     (a1 f)
+			     (subst-free (a2 f) v tm))))
+	((wfatomtop f) (cons (car f) (subst-term-list (cdr f) v tm)))
+	(t f)))
+
+;; subst-free preserves well-formedness.
+
+(defthm subst-free-wf
+  (implies (and (wff f)
+		(wft tm))
+	   (wff (subst-free f v tm))))
+
+;; Function wff-count counts the number of formula nodes in a formula.
+;; It is useful for proving termination of functions (on formulas)
+;; that change atomic formulas.
+
+(defun wff-count (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfnot f)    (+ 1 (wff-count (a1 f))))
+	((wfbinary f) (+ 1 (wff-count (a1 f)) (wff-count (a2 f))))
+	((wfquant f)  (+ 1 (wff-count (a2 f))))
+	(t 1)))
+
+;; subst-free preserves the wff-count of a formula.
+
+(defthm subst-free-preserves-wff-count
+  (equal (wff-count (subst-free f v e))
+	 (wff-count f)))
+
+(defthm domain-append-right  ;; for feval guard
+  (implies (and (not (domain-term-list a))
+		(true-listp a))
+	   (not (domain-term-list (append a b)))))
+
+(defthm domain-append-left  ;; for feval guard
+  (implies (and (not (domain-term-list b))
+		(true-listp b))
+	   (not (domain-term-list (append a b)))))
+
+(defthm domain-term-list-subset
+  (implies (and (domain-term-list a)
+		(true-listp b)
+		(not (domain-term-list b)))
+	   (not (subsetp-equal b a))))
+
+(defthm domain-term-list-member
+  (implies (and (domain-term-list a)
+		(not (domain-term e)))
+	   (not (member-equal e a))))
+
+;; The Evaluation Function
+
+;; There are 2 mutually recursive functions: (feval f i) evaluates
+;; a formula in an interpretation, and when it gets to a quantified
+;; subformula, it calls (feval-d f dom i), which recurses through the
+;; domain of the interpretation, substituting elements and calling feval.
+;;
+;; It would be nice to have a guard (not (free-vars f)) on both of
+;; these functions, but free-vars hasn't been defined yet.
+;;
+;; The termination measure has 3 components: the size of the formula,
+;; the function (feval-d is smaller than feval), and the size of the
+;; domain.  The second component is there because nothing gets smaller
+;; when feval calls feval-d.
+
+(mutual-recursion
+ (defun feval (f i)  ;; recurse through formula
+   (declare (xargs :measure (cons (cons (wff-count f) 2) 0)
+                   :guard (wff f)))
+   (cond ((equal f 'true) t)
+         ((equal f 'false) nil)
+         ((wfnot f) (not     (feval (a1 f) i)))
+         ((wfand f) (and     (feval (a1 f) i) (feval (a2 f) i)))
+         ((wfor  f) (or      (feval (a1 f) i) (feval (a2 f) i)))
+         ((wfimp f) (implies (feval (a1 f) i) (feval (a2 f) i)))
+         ((wfiff f) (iff     (feval (a1 f) i) (feval (a2 f) i)))
+         ((wfquant f) (feval-d f (domain i) i))
+         (t (eval-atomic f i))))
+
+ (defun feval-d (f dom i)  ;; recurse through domain
+   (declare (xargs :measure (cons (cons (wff-count f) 1)
+                                  (acl2-count dom))
+                   :guard (and (wff f)
+                               (wfquant f)
+			       ;; (domain-term-list (fringe dom))
+                               (subsetp-equal (fringe dom)
+                                              (fringe (domain i))))))
+   (cond ((not (wfquant f)) nil) ;; default value
+         ((atom dom) (feval (subst-free (a2 f) (a1 f) dom) i))
+         ((wfall f)    (and (feval-d f (car dom) i)
+                            (feval-d f (cdr dom) i)))
+         ((wfexists f) (or  (feval-d f (car dom) i)
+                            (feval-d f (cdr dom) i)))
+         (t nil))) ;; default value
+)
+
+;; Notes about feval.  Because of the default values, some unexpected
+;; things can happen if the formula being evaluated has free variables,
+;; is not well formed, or is not fully interpreted.  For example,
+;;
+;; 1.  (FEVAL '(= X Y) i) for any i, will evaluate to T, because
+;; all free variables evaluate to the default value 0.
+;;
+;; 2.  (FEVAL '(NOT (OR (P))) i), for any i, will evaluate to T,
+;; because the '(OR (P)) is not a wff.
+;;
+;; Also, we must make sure that domain-terms are not thought of as
+;; ordinary constants, because
+;;
+;; 3.  (FEVAL '(= 1 2) (cons '(0 1 . 2) anything)) is NIL.
+;;
+;; If the domain-terms are uninterpreted, they act like uninterpreted
+;; constants:
+;;
+;; 4.  (FEVAL '(= 3 4) (cons '(0 1 . 2) anything)) is T.
+;; 5.  (FEVAL '(= 3 4) nil) is T.
+;; 6.  (FEVAL '(= (a) (b)) nil) is T.
+
+;; A Side Note.  As a check of our handling of default
+;; values, we could define a recognizer
+;; (adequate-interpretation formula interp), which checks
+;; if an interpretation is well-formed and interprets all
+;; of the symbols in a formula, and also a function
+;; (fix-interpretation formula interp) which makes an
+;; interpretaion adequate for a formula.  Then, we should
+;; be able to prove some theorems like
+;;   (adequate-interpretation f (fix-interpretation f i)).
+;; and
+;;   (feval f i) = (feval f (fix-interpretation f i))
+;; Big Exercise: try it.
+
+;;=================================================================
+;; In the general version, the encapsulation ends here.
+;;=================================================================
+
+;; A useful induction scheme for feval.  Note that this is not a direct
+;; translation of feval/feval-d --- it has been simplified by using
+;; wfbinary and wfquant, and by CONSing the recursive calls.
+
+(defun feval-i (flg f dom i)
+  (declare (xargs :measure (cons (cons (wff-count f) (if flg 2 1))
+				 (acl2-count dom))
+		  :guard (and (wff f)
+			      (implies (not flg)
+				       (domain-term-list (fringe dom))))
+		  ))
+  (if flg
+      (cond ((wfnot f) (feval-i t (a1 f) 'junk i))
+	    ((wfbinary f) (cons (feval-i t (a1 f) 'junk i)
+				(feval-i t (a2 f) 'junk i)))
+	    ((wfquant f) (feval-i nil f (domain i) i))
+	    (t nil))
+    (cond ((not (wfquant f)) nil)
+	  ((atom dom) (feval-i t (subst-free (a2 f) (a1 f) dom) 'junk i))
+	  (t (cons (feval-i nil f (car dom) i)
+		   (feval-i nil f (cdr dom) i))))))
+
+;; A scheme for inducting on domains.  This is useful for proving
+;; feval properties about a quantifier at the top of a formula.
+
+(defun dom-i (d)
+  (declare (xargs :guard t))
+  (if (atom d)
+      nil
+    (cons (dom-i (car d)) (dom-i (cdr d)))))
+
+;;=================================================================
+;; Here is a (useless) example of a transformation on formulas
+;; and a soundness theorem for it.  This can serve as a template
+;; for induction on the mutually rerecursive evaluation functions.
+
+(defun simpt (f)  ;; this does a trivial simplification
+  (declare (xargs :guard (wff f)))
+  (cond ((wfand f) (if (equal (a1 f) 'true)
+		       (simpt (a2 f))
+		     (list 'and (simpt (a1 f)) (simpt (a2 f)))))
+	((wfbinary f) (list (car f) (simpt (a1 f)) (simpt (a2 f))))
+	((wfquant f) (list (car f) (a1 f) (simpt (a2 f))))
+	((wfnot f) (list 'not (simpt (a1 f))))
+	(t f)))
+
+(defthm subst-free-true
+  (implies (not (equal f 'true))
+	   (not (equal (subst-free f x tm) 'true))))
+
+(defthm simpt-subst
+  (equal (simpt (subst-free f x tm))
+	 (subst-free (simpt f) x tm)))
+
+(defthm simpt-fsound-flg
+  (if flg
+      (equal (feval (simpt f) i)
+	     (feval f i))
+      (implies (wfquant f)
+	       (equal (feval-d (simpt f) dom i)
+		      (feval-d f dom i))))
+  :hints (("Goal"
+	   :induct (feval-i flg f dom i)
+	   ))
+  :rule-classes nil)
+
+(defthm simpt-fsound
+  (equal (feval (simpt f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :by (:instance simpt-fsound-flg (flg t)))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/close.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/close.lisp
new file mode 100644
index 0000000..287e3a2
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/close.lisp
@@ -0,0 +1,374 @@
+(in-package "ACL2")
+
+;; Several theorems we need are about universal closures of formulas:
+;; (alls (free-vars f) f).  These will be proved first for an arbitrary
+;; set of variables that closes the formulas.  But when we go to prove
+;; the theorems in terms of universal closure, the variables aren't
+;; necessarily in the correct order, and there might me too many variables.
+;;
+;; The main theorem in this file (xeval-alls-subset) brings things together:
+;;
+;; If A is a subset of variable-set B, and if (ALLS A F) is closed,
+;; then (ALLS A F) is equivalent to (ALLS B F).
+;;
+;; The proof uses the special-purpose evaluation function keval.
+
+(include-book "keval")
+(include-book "permutations")
+(include-book "../../../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+(local (include-book "arithmetic"))
+
+(local (in-theory (enable domain-term)))
+
+;; Note that this book uses both remove-equal and remove1-equal.  We could
+;; probably use one or the other exclusively, because we are dealing
+;; with var-set.
+
+(defthm var-set-remove1-equal
+  (implies (var-set v)
+	   (var-set (remove1-equal x v))))
+
+(defthm idx-cancel-not-member
+  (implies (equal (+ 1 (idx a1 b2)) 1)
+	   (not (member-equal a1 b2))))
+
+;; Many of the following theorems are separated into two cases:
+;; whether or not (car b) is equal to a1.
+;;
+;; Comment added long after these proofs were done:  I just learned
+;; about the :cases hint;  I guess it could be used to clean this
+;; up quite a bit.
+
+;;-----------------  closer
+
+(defthm closer-1
+  (implies (and (integerp e)
+		(<= 0 e)
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(equal (car b) a1))
+	   (equal (xeval (alls (remove1-equal a1 b)
+			       (subst-free f a1 e))
+			 (domain i) i)
+		  (keval b f (domain i) (idx a1 b)
+			 e i)))
+  :hints (("goal"
+	   :do-not-induct t))
+  :rule-classes nil)
+
+; JSM: I added these two events when I eliminated the worse-than test
+; in ancestors-check.  Member-equal-append, especially, is a real
+; killer if you take a brute force approach to backchain cutoff.
+
+(in-theory (disable  member-append-right
+                     member-append-left
+                     member-equal-append))
+
+(defthm member-equal-append-strong
+  (iff (member-equal x (append a b))
+       (or (member-equal x a)
+           (member-equal x b))))
+
+(defthm closer-2
+  (implies (and (integerp e)
+		(<= 0 e)
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(not (equal (car b) a1))
+		(domain-term-list (fringe dm)))
+	   (equal (xeval (alls (remove1-equal a1 b) (subst-free f a1 e))
+			 dm i)
+		  (keval b f dm (idx a1 b)
+			 e i)))
+  :hints (("goal"
+	   :induct (keval-i b f dm (idx a1 b) e i)
+	   :expand ((keval (list* b1 b3 b4) f dm 2 e i))))
+  :rule-classes nil)
+
+(defthm closer
+  (implies (and (integerp e)
+		(<= 0 e)
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b))
+	   (equal (xeval (alls (remove1-equal a1 b) (subst-free f a1 e))
+			 (domain i) i)
+		  (keval b f (domain i) (idx a1 b)
+			 e i)))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance closer-1)
+		 (:instance closer-2 (dm (domain i)))))))
+
+;;---------------- side step to prove xeval-alls-free
+
+(in-theory (enable not-free-not-change-2))
+
+(defthm no-vars-subst-free
+  (implies (not (free-vars f))
+	   (equal (subst-free f x tm) f)))
+
+(defthm not-free-quant-xeval-2
+  (implies (and (domain-term-list (fringe dom))
+		(variable-term x)
+                (not (free-vars f)))
+           (equal (xeval (list 'all x f) dom i)
+                  (xeval f (domain i) i)))
+  :hints (("goal"
+           :in-theory (disable domain-term)
+           :induct (dom-i dom))))
+
+(in-theory (disable not-free-not-change-2 no-vars-subst-free))
+
+(defthm xeval-alls-free
+  (implies (and (var-list b)
+		(not (free-vars f)))
+	   (equal (xeval (alls b f) (domain i) i)
+		  (xeval f (domain i) i)))
+  :hints (("goal"
+	   :induct (alls b f)
+	   :in-theory (disable domain-term))))
+
+;;---------------- end of side step
+
+(defthm xeval-alls-free-expanded
+  (implies (and (var-list b)
+                (not (free-vars f)))
+           (equal (xeval (alls b f) (domain i) i)
+                  (xeval f (domain i) i)))
+  :hints (("goal"
+	   :use ((:instance xeval-alls-free (i i))))))
+
+(defthm base-1
+  (implies (and (integerp dom)
+		(<= 0 dom)
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(not (remove-equal a1 (free-vars f)))
+		(equal (car b) a1))
+	   (equal (keval b f (domain i) (idx a1 b) dom i)
+		  (xeval (subst-free f a1 dom) (domain i) i)))
+  :hints (("goal"
+           :do-not-induct t))
+  :rule-classes nil)
+
+(defthm if-x-is-only-member-then-something-else-isnt-member  ;; duh
+  (implies (and (not (equal x y))
+		(not (remove-equal x a)))
+	   (not (member-equal y a)))
+  :rule-classes nil)
+
+(defthm not-free-not-change-remove
+  (implies (and (not (equal x y))
+		(not (remove-equal x (free-vars f))))
+	   (equal (subst-free f y tm) f))
+  :hints (("goal"
+	   :do-not-induct t
+	   :in-theory (enable not-free-not-change-2)
+           :use ((:instance if-x-is-only-member-then-something-else-isnt-member
+			    (a (free-vars f)))))))
+
+(defthm base-2
+  (implies (and (integerp dom)
+		(<= 0 dom)
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(not (remove-equal a1 (free-vars f)))
+		(not (equal (car b) a1))
+		(domain-term-list (fringe dm)))
+	   (equal (keval b f dm (idx a1 b) dom i)
+		  (xeval (subst-free f a1 dom) (domain i) i)))
+  :hints (("goal"
+	   :do-not generalize
+           :induct (keval-i b f dm (idx a1 b) dom i)))
+  :rule-classes nil)
+
+(defthm base  ;; important case of the big one.
+  (implies (and (integerp dom)
+		(<= 0 dom)
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(not (remove-equal a1 (free-vars f))))
+	   (equal (keval b f (domain i) (idx a1 b) dom i)
+		  (xeval (subst-free f a1 dom) (domain i) i)))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance base-1)
+		 (:instance base-2 (dm (domain i)))))))
+
+;;------------ ugly-a  Subgoal *1/2.10'7' of the big one
+
+(defthm ugly-a1
+  (implies (and (not (keval b f (domain i) (idx a1 b) dom1 i))
+		(equal (car b) a1))
+	   (not (keval b f (domain i) (idx a1 b) (cons dom1 dom2) i)))
+  :hints (("goal"
+	   :do-not-induct t))
+  :rule-classes nil)
+
+(defthm ugly-a2
+  (implies (and (domain-term-list (append (fringe dom1) (fringe dom2)))
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(not (keval b f dm (idx a1 b) dom1 i))
+		(not (equal (car b) a1))
+		(domain-term-list (fringe dm)))
+	   (not (keval b f dm (idx a1 b) (cons dom1 dom2) i)))
+  :hints (("goal"
+	   :induct (keval-i b f dm (idx a1 b) dom1 i)
+	   :expand (keval (list* b1 b3 b4) f dm 2 (cons dom1 dom2)
+			  i)
+	   ))
+  :rule-classes nil)
+
+(defthm ugly-a
+  (implies (and (domain-term-list (append (fringe dom1) (fringe dom2)))
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(not (keval b f (domain i) (idx a1 b) dom1 i)))
+	   (not (keval b f (domain i) (idx a1 b) (cons dom1 dom2) i)))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance ugly-a1)
+		 (:instance ugly-a2 (dm (domain i)))))))
+
+;;---------- ugly-d
+
+(defthm ugly-d1
+  (implies (and (keval b f (domain i) (idx a1 b) dom1 i)
+		(equal (car b) a1))
+	   (equal
+	    (keval b f (domain i) (idx a1 b) (cons dom1 dom2) i)
+	    (keval b f (domain i) (idx a1 b) dom2 i)))
+  :hints (("goal"
+	   :do-not-induct t))
+  :rule-classes nil)
+
+(defthm ugly-d2
+  (implies (and (domain-term-list (append (fringe dom1) (fringe dom2)))
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(keval b f dm (idx a1 b) dom1 i)
+		(not (equal (car b) a1))
+		(domain-term-list (fringe dm)))
+	   (equal
+	    (keval b f dm (idx a1 b) (cons dom1 dom2) i)
+	    (keval b f dm (idx a1 b) dom2 i)))
+  :hints (("goal"
+	   :induct (keval-i b f dm (idx a1 b) dom1 i)
+	   :in-theory (disable ugly-a)
+	   :expand ((keval (list* b1 b3 b4) f dm 2 (cons dom1 dom2)
+			   i))))
+  :rule-classes nil)
+
+(defthm ugly-d
+  (implies (and (domain-term-list (append (fringe dom1) (fringe dom2)))
+		(variable-term a1)
+		(var-set b)
+		(member-equal a1 b)
+		(keval b f (domain i) (idx a1 b) dom1 i)
+		)
+	   (equal
+	    (keval b f (domain i) (idx a1 b) (cons dom1 dom2) i)
+	    (keval b f (domain i) (idx a1 b) dom2 i)))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance ugly-d1)
+		 (:instance ugly-d2 (dm (domain i)))))))
+
+;; Induction scheme for the big one.
+
+(defun giv2 (v w f dom i)
+  (declare (xargs :measure (cons (+ 1 (acl2-count v)) (acl2-count dom))
+                  :guard (and (var-list v) (var-list w) (wff f)
+                              (domain-term-list (fringe dom)))))
+  (if (atom v)
+      nil
+      (if (atom dom)
+          (giv2 (cdr v) (remove1-equal (car v) w)
+		(subst-free f (car v) dom) (domain i) i)
+          (cons (giv2 v w f (car dom) i)
+                (giv2 v w f (cdr dom) i)))))
+
+;;-------------------------------
+;; The big one: first the cons case, then the atom case, then put
+;; together those 2 cases, then get it in final form.
+
+(defthm keval-alls-subset-cons
+  (implies (and (domain-term-list (fringe dom))
+		(var-set a)
+		(var-set b)
+		(subsetp-equal a b)
+		(not (free-vars (alls a f)))
+		(consp a))
+	   (equal (xeval (alls a f) dom i)
+		  (keval b f (domain i) (idx (car a) b) dom i)))
+  :hints (("goal"
+	   :induct (giv2 a b f dom i)
+	   ))
+  :rule-classes nil)
+
+(defthm keval-alls-subset-atom
+  (implies (and (var-set a)
+		(var-set b)
+		(subsetp-equal a b)
+		(not (free-vars (alls a f)))
+		(atom a))
+	   (equal (xeval (alls a f) (domain i) i)
+		  (keval b f (domain i) (idx (car a) b) (domain i) i)))
+  :hints (("goal"
+	   :do-not-induct t))
+  :rule-classes nil)
+
+(defthm keval-alls-subset-2
+  (implies (and (var-set a)
+		(var-set b)
+		(subsetp-equal a b)
+		(not (free-vars (alls a f))))
+	   (equal (xeval (alls a f) (domain i) i)
+		  (keval b f (domain i) (idx (car a) b) (domain i) i)))
+  :hints (("goal"
+	   :do-not-induct t
+	   :hands-off (keval xeval)
+	   :use ((:instance keval-alls-subset-cons (dom (domain i)))
+		 (:instance keval-alls-subset-atom)))
+	  )
+  :rule-classes nil)
+
+;;---- The main events
+
+(defthm xeval-alls-subset
+  (implies (and (var-set a)
+		(var-set b)
+		(subsetp-equal a b)
+		(not (free-vars (alls a f))))
+	   (equal (xeval (alls a f) (domain i) i)
+		  (xeval (alls b f) (domain i) i)))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance keval-alls-subset-2)))
+	  )
+  :rule-classes nil)
+
+(defthm feval-alls-subset
+  (implies (and (var-set a)
+		(var-set b)
+		(subsetp-equal a b)
+		(not (free-vars (alls a f))))
+	   (equal (feval (alls a f) i)
+		  (feval (alls b f) i)))
+  :hints (("Goal" :use ((:instance xeval-feval (f (alls a f)))
+			(:instance xeval-feval (f (alls b f)))
+			xeval-alls-subset)))
+  :rule-classes nil)
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/cnf.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/cnf.lisp
new file mode 100644
index 0000000..e42bbc7
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/cnf.lisp
@@ -0,0 +1,178 @@
+(in-package "ACL2")
+
+;; Conjunctive normal form (CNF): definition, syntactic correctness
+;; theorem, soundness theorem, and some preservation-of-property theorems.
+
+(include-book "wfftype")
+
+;; ------------------------------------------------
+;; CNF - conjunctive normal form
+
+(defun dist-or-and-2 (p q)
+  (declare (xargs :guard (and (wff p) (wff q))))
+  (if (wfand q)
+      (list 'and (dist-or-and-2 p (a1 q)) (dist-or-and-2 p (a2 q)))
+      (list 'or p q)))
+
+(defun dist-or-and (p q)
+  (declare (xargs :guard (and (wff p) (wff q))))
+  (if (wfand p)
+      (list 'and (dist-or-and (a1 p) q) (dist-or-and (a2 p) q))
+      (dist-or-and-2 p q)))
+
+(defthm dist-or-and-2-wff  ; helps verify guards for cnf below
+  (implies (and (wff p)
+		(wff q))
+	   (wff (dist-or-and-2 p q))))
+
+(defthm dist-or-and-wff    ; helps verify guards for cnf below
+  (implies (and (wff p)
+		(wff q))
+	   (wff (dist-or-and p q))))
+
+(defun cnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfbinary f)
+	 (cond ((equal (car f) 'and) (list 'and (cnf (a1 f)) (cnf (a2 f))))
+	       ((equal (car f) 'or) (dist-or-and (cnf (a1 f)) (cnf (a2 f))))
+	       (t f)))
+	((wfquant f) (list (car f) (a1 f) (cnf (a2 f))))
+	(t f)))
+
+;; Prove that cnf preserves well-formedness.
+
+(defthm cnf-wff
+  (implies (wff f)
+	   (wff (cnf f))))
+
+;; Prove that cnf rewrites an nnfp formula into cnfp.
+
+(defthm dist-or-and-2-cnfp
+  (implies (and (cnfp p)
+		(cnfp q)
+		(not (wfand p)))
+	   (cnfp (dist-or-and-2 p q))))
+
+(defthm dist-or-and-cnfp
+  (implies (and (cnfp p)
+		(cnfp q))
+	   (cnfp (dist-or-and p q))))
+
+(defthm cnf-cnfp
+  (implies (nnfp f)
+	   (cnfp (cnf f))))
+
+;;---------------------------------
+;; Soundness of CNF.  We use feval.  I think xeval would have been as easy.
+
+(defthm subst-dist-dist-2
+  (equal (subst-free (dist-or-and-2 p q) x tm)
+	 (dist-or-and-2 (subst-free p x tm)
+			(subst-free q x tm))))
+
+(defthm subst-dist-dist
+  (equal (subst-free (dist-or-and p q) x tm)
+	 (dist-or-and (subst-free p x tm)
+		      (subst-free q x tm))))
+
+(defthm subst-cnf-commute
+  (equal (subst-free (cnf f) x tm)
+	 (cnf (subst-free f x tm))))
+
+(defthm dist-or-and-2-fsound
+  (equal (feval (dist-or-and-2 p q) i)
+	 (feval (list 'or p q) i)))
+
+(defthm dist-or-and-fsound
+  (equal (feval (dist-or-and p q) i)
+	 (feval (list 'or p q)  i)))
+
+(defthm cnf-fsound-flg
+  (if flg
+      (equal (feval (cnf f) i)
+	     (feval f i))
+      (implies (wfquant f)
+	       (equal (feval-d (cnf f) dom i)
+		      (feval-d f dom i))))
+  :hints (("Goal"
+	   :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm cnf-fsound
+  (equal (feval (cnf f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :by (:instance cnf-fsound-flg (flg t)))))
+
+;;-------------------------------
+;; Prove that cnf preserves closedness.
+;; (If you need a theorem that cnf preserves the
+;; set of free variables, see normal-forms in the m series.)
+
+(defthm dist-or-and-2-doesnt-introduce-free-vars
+  (implies (not (free-occurrence x (list 'or f g)))
+	   (not (free-occurrence x (dist-or-and-2 f g)))))
+
+(defthm dist-or-and-doesnt-introduce-free-vars
+  (implies (not (free-occurrence x (list 'or f g)))
+	   (not (free-occurrence x (dist-or-and f g)))))
+
+(defthm cnf-doesnt-introduce-free-vars
+  (implies (not (free-occurrence x f))
+	   (not (free-occurrence x (cnf f)))))
+
+(defthm cnf-preserves-closedness-almost
+  (implies (not (member-equal x (free-vars f)))
+	   (not (member-equal x (free-vars (cnf f)))))
+  :hints (("Goal"
+	   :use ((:instance free-free)
+		 (:instance free-free (f (cnf f)))))))
+
+(defthm cnf-preserves-closedness
+  (implies (not (free-vars f))
+	   (not (free-vars (cnf f))))
+  :hints (("Goal"
+	   :use ((:instance member-equal
+			    (x (car (free-vars (cnf f))))
+			    (lst (free-vars (cnf f))))
+		 (:instance member-equal
+			    (x (car (free-vars f)))
+			    (lst (free-vars f)))))))
+
+;;----------------------
+;; cnf preserves quantifier-free
+
+(defthm dist-or-and-2-preserves-quantifier-free
+  (implies (and (quantifier-free f)
+		(quantifier-free g))
+	   (quantifier-free (dist-or-and-2 f g))))
+
+(defthm dist-or-and-preserves-quantifier-free
+  (implies (and (quantifier-free f)
+		(quantifier-free g))
+	   (quantifier-free (dist-or-and f g))))
+
+(defthm cnf-preserves-quantifier-free
+  (implies (quantifier-free f)
+	   (quantifier-free (cnf f))))
+
+;;--------------------
+;; cnf preserves leading-alls
+
+(defthm leading-alls-dist-or-and-2
+  (not (leading-alls (dist-or-and-2 f g))))
+
+(defthm leading-alls-dist-or-and
+  (not (leading-alls (dist-or-and f g))))
+
+(defthm leading-alls-cnf
+  (equal (leading-alls (cnf f)) (leading-alls f)))
+
+;;----------------------
+
+(defthm cnf-of-universal-prefix-nnf-is-universal-prefix-cnf
+  (implies (universal-prefix-nnf f)
+	   (universal-prefix-cnf (cnf f)))
+  :hints (("Goal"
+	   :induct (universal-prefix-nnf f))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/derive.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/derive.lisp
new file mode 100644
index 0000000..ce2ade4
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/derive.lisp
@@ -0,0 +1,777 @@
+(in-package "ACL2")
+
+;; This book has the interface to the program (say external-prover) that
+;; searches for a refutation of a list of clauses.
+;;
+;; External-prover receives a list of annotated clauses (the initial proof)
+;; and returns a list of annotated clauses (the proof object).
+;; The annotations are clause identifiers and justifications.
+;; Function check-proof below checks the soundness of each
+;; clause in the proof object.  (If we are lucky, one of the clauses
+;; in the proof object is 'false.)
+;;
+;; Function refute-n-check below is at the center of things.  It takes
+;; a closed wff in universal-prefix-cnf, strips the universal
+;; quantifiers, constructs an initial proof object, calls Otter,
+;; checks Otter's answer, then converts Otter's proof object
+;; into a wff.  Theorem refute-n-check-sound below shows that refute-n-check
+;; returns a formula equivalent to its input.
+
+(include-book "uc-conj")
+(include-book "prop-subsume")
+(include-book "substitution")
+(include-book "resolve")
+(include-book "paramod")
+(include-book "flip")
+
+;;----------------------
+;; Well-formed proof.
+
+(defmacro just (s) ;; Extract the justification from a proof step.
+  (list 'cadr s))  ;; second member
+
+(defmacro prf-clause (s)  ;; Extract the clause from a proof step.
+  (list 'caddr s))  ;; third member
+
+(defmacro prf-rule (s)  ;; Extract the inference rule name from a proof step.
+  (list 'car (list 'just s)))
+
+(defmacro parent-1-id (s)  ;; ID of 1st parent of unary or binary step.
+  (list 'cadr (list 'just s)))
+
+(defmacro position-1 (s)   ;; 1st position of a unary or binary step.
+  (list 'caddr (list 'just s)))
+
+(defmacro parent-2-id (s)  ;; Get the ID of the 2nd parent from a binary step.
+  (list 'cadddr (list 'just s)))
+
+(defmacro position-2 (s)   ;; Get the 2nd position from a binary step.
+  (list 'car (list 'cddddr (list 'just s))))
+
+(defmacro prf-subst (s)  ;; Get the substitution from an 'instantiate step.
+  (list 'caddr (list 'just s)))
+
+;; Well-formed justification.
+
+(defun wfjust (j)
+  (declare (xargs :guard t))
+  (cond ((atom j) nil)
+	((equal (car j) 'input)         (equal (len j) 1))
+	((equal (car j) 'resolve)       (equal (len j) 5))
+	((equal (car j) 'paramod)       (equal (len j) 5))
+	((equal (car j) 'flip)          (equal (len j) 3))
+	((equal (car j) 'propositional) (equal (len j) 2))
+	((equal (car j) 'instantiate)   (and (equal (len j) 3)
+					     (wfsubst (caddr j))))
+	(t nil)))
+
+;; Well-formed proof step.
+
+(defun wfproof-step (s)
+  (declare (xargs :guard t))
+  (and (>= (len s) 3)
+       (wff (prf-clause s))
+       (quantifier-free (prf-clause s))
+       (wfjust (just s))))
+
+;; Well-formed proof.
+
+(defun wfproof (prf)
+  (declare (xargs :guard t))
+  (and (alistp prf)
+       (if (atom prf) t
+	   (and (wfproof-step (car prf))
+		(wfproof (cdr prf))))))
+
+;;------------------------
+;; Extract all steps from a wfproof, conjoin them, and return a wff.
+
+(defun extract-all-steps (prf)
+  (declare (xargs :guard (wfproof prf)))
+  (if (atom prf)
+      'true
+      (list 'and
+	    (prf-clause (car prf))
+	    (extract-all-steps (cdr prf)))))
+
+;; Extract the input steps from a wfproof, conjoin them, and return a wff.
+
+(defun extract-input-steps (prf)
+  (declare (xargs :guard (wfproof prf)))
+  (cond ((atom prf) 'true)
+	((equal (prf-rule (car prf)) 'input)
+	 (list 'and
+	       (prf-clause (car prf))
+	       (extract-input-steps (cdr prf))))
+	(t (extract-input-steps (cdr prf)))))
+
+;; Extract a particular step from a wfproof (wff or nil returned).
+
+(defun extract-step (id prf)
+  (declare (xargs :guard (wfproof prf)))
+  (if (assoc-equal id prf)
+      (prf-clause (assoc-equal id prf))
+      nil))
+
+(defthm extract-all-wff
+  (implies (wfproof prf)
+	   (wff (extract-all-steps prf))))
+
+(defthm extract-input-wff
+  (implies (wfproof prf)
+	   (wff (extract-input-steps prf))))
+
+(defthm extract-step-wff
+  (implies (and (wfproof prf)
+		(extract-step id prf))
+	   (wff (prf-clause (assoc-equal id prf)))))
+
+(defthm quantifier-free-extract-step
+  (implies (and (wfproof prf)
+		(extract-step id prf))
+	   (quantifier-free (prf-clause (assoc-equal id prf)))))
+
+;;---------  check one step of a proof
+
+;; Function check-resolve checks if the conjunction of all resolvents
+;; propositionally subsumes the claimed resolvent.
+
+(defun check-resolve (par1 pos1 par2 pos2 resolvent)
+  (declare (xargs :guard (and (or (not par1) (wff par1))
+			      (or (not par2) (wff par2))
+			      (wff resolvent))))
+  (and par1
+       par2
+       (integer-listp pos1)
+       (integer-listp pos2)
+       ;; We use prop-subsume instead of equal, in case the
+       ;; clauses are associated differently.  Also, resolve
+       ;; is allowed to leave some extraneous 'false literals.
+       (prop-subsume (resolve par1 pos1 par2 pos2) resolvent)))
+
+(defun check-paramod (par1 pos1 par2 pos2 paramodulant)
+  (declare (xargs :guard (and (or (not par1) (wff par1))
+			      (or (not par2) (wff par2))
+			      (wff paramodulant))))
+  (and par1
+       par2
+       (integer-listp pos1)
+       (integer-listp pos2)
+       ;; We use prop-subsume instead of equal, in case the
+       ;; clauses are associated differently.
+       (prop-subsume (paramod par1 pos1 par2 pos2) paramodulant)))
+
+(defun check-propositional (parent child)
+  (declare (xargs :guard (and (or (not parent) (wff parent))
+			      (wff child))))
+  (and parent
+       (prop-subsume parent child)))
+
+;; Function check-instantiate.
+
+(defun check-instantiate (parent subst child)
+  (declare (xargs :guard (and (or (not parent) (wff parent))
+			      (wfsubst subst)
+			      (wff child))))
+  (and parent
+       (equal (sequential-apply subst parent) child)))
+
+;; Function check-flip.
+
+(defun check-flip (parent pos child)
+  (declare (xargs :guard (and (or (not parent) (wff parent))
+			      (wff child))))
+  (and parent
+       (integer-listp pos)
+       (equal (flip-eq parent pos) child)))
+
+(defun check-step (checked s)
+  (declare (xargs :guard (and (wfproof checked)
+			      (wfproof-step s))))
+  (and (wff (prf-clause s))
+       (cond ((equal (prf-rule s) 'input) t)
+	     ((equal (prf-rule s) 'resolve)
+	      ;; Note that check-resolve does not use positions.
+	      (check-resolve (extract-step (parent-1-id s) checked)
+			     (position-1 s)
+			     (extract-step (parent-2-id s) checked)
+			     (position-2 s)
+			     (prf-clause s)))
+	     ((equal (prf-rule s) 'paramod)
+	      (check-paramod (extract-step (parent-1-id s) checked)
+			     (position-1 s)
+			     (extract-step (parent-2-id s) checked)
+			     (position-2 s)
+			     (prf-clause s)))
+	     ((equal (prf-rule s) 'flip)
+	      (check-flip (extract-step (parent-1-id s) checked)
+			  (position-1 s)
+			  (prf-clause s)))
+	     ((equal (prf-rule s) 'propositional)
+	      (check-propositional (extract-step (parent-1-id s) checked)
+			   (prf-clause s)))
+	     ((equal (prf-rule s) 'instantiate)
+	      (check-instantiate (extract-step (parent-1-id s) checked)
+				 (prf-subst s)
+				 (prf-clause s)))
+	     (t nil))))
+
+;; ---------- check all steps of a proof.
+
+(defun check-proof (done todo)
+  (declare (xargs :guard (and (wfproof done) (wfproof todo))
+		  :measure (acl2-count todo)))
+  (if (atom todo) t
+      (and (check-step done (car todo))
+	   (check-proof (cons (car todo) done) (cdr todo)))))
+
+;;------------------------------------------
+;; Now, prove that if check-proof succeeds, the proof is sound.
+
+(defthm step-extract-xsound-closure
+  (implies (and
+	    (xeval (universal-closure (extract-all-steps prf)) (domain i) i)
+	    (assoc-equal id prf))
+	   (xeval (universal-closure (prf-clause (assoc-equal id prf)))
+		  (domain i) i))
+  :hints (("Goal"
+	   :induct (assoc-equal id prf)
+           :in-theory (disable xeval alls))
+	  ("Subgoal *1/2''"
+	   :expand ((extract-all-steps prf))
+	   :use ((:instance uc-conj-left
+			    (f (caddar prf))
+			    (g (extract-all-steps (cdr prf))))))
+
+	  ("Subgoal *1/3'"
+	   :use ((:instance uc-conj-right
+			    (f (caddar prf))
+			    (g (extract-all-steps (cdr prf)))))))
+  :rule-classes nil)
+
+(defthm instantiate-step-xsound
+  (implies (and (wfproof prf)
+		(wfproof-step s)
+		(check-step prf s)
+		(equal (prf-rule s) 'instantiate)
+		(xeval (universal-closure (extract-all-steps prf))
+		       (domain i) i))
+	   (xeval (universal-closure (prf-clause s)) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance step-extract-xsound-closure (id (parent-1-id s)))))
+	  ("Subgoal 4.1'" ; subgoal number changed by Matt K. for v2-9
+                          ; (probably caused by call-stack change)
+	   :use ((:instance instance-gsound-for-subst
+			    (f (caddr (assoc-equal s7 prf)))
+			    (s s9)))))
+  :rule-classes nil)
+
+(defthm propositional-step-xsound
+  (implies (and (wfproof prf)
+		(wfproof-step s)
+		(check-step prf s)
+		(equal (prf-rule s) 'propositional)
+		(xeval (universal-closure (extract-all-steps prf))
+		       (domain i) i))
+	   (xeval (universal-closure (prf-clause s)) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance step-extract-xsound-closure (id (parent-1-id s)))))
+	  ("Subgoal 4'"  ;; I don't know why this is necessary.
+	   :use ((:instance prop-subsume-xsound
+			    (c (caddr (assoc-equal (cadadr s) prf)))
+			    (d (caddr s)))))
+	  )
+  :rule-classes nil)
+
+(defthm check-resolve-xsound
+  (implies (and (check-resolve par1 pos1 par2 pos2 res)
+		(xeval (universal-closure par1) (domain i) i)
+		(xeval (universal-closure par2) (domain i) i))
+	   (xeval (universal-closure res) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t))
+  :rule-classes nil)
+
+(defthm resolve-step-xsound
+  (implies (and (wfproof prf)
+		(wfproof-step s)
+		(check-step prf s)
+		(equal (prf-rule s) 'resolve)
+		(xeval (universal-closure (extract-all-steps prf))
+			      (domain i) i))
+	   (xeval (universal-closure (prf-clause s)) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance step-extract-xsound-closure (id (parent-1-id s)))
+		 (:instance step-extract-xsound-closure (id (parent-2-id s)))
+		 (:instance check-resolve-xsound
+			    (par1 (extract-step (parent-1-id s) prf))
+			    (par2 (extract-step (parent-2-id s) prf))
+			    (res (prf-clause s))))))
+  :rule-classes nil)
+
+(defthm check-paramod-xsound
+  (implies (and (check-paramod par1 pos1 par2 pos2 paramodulant)
+		(xeval (universal-closure par1) (domain i) i)
+		(xeval (universal-closure par2) (domain i) i))
+	   (xeval (universal-closure paramodulant) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t))
+  :rule-classes nil)
+
+(defthm paramod-step-xsound
+  (implies (and (wfproof prf)
+		(wfproof-step s)
+		(check-step prf s)
+		(equal (prf-rule s) 'paramod)
+		(xeval (universal-closure (extract-all-steps prf))
+		       (domain i) i))
+	   (xeval (universal-closure (prf-clause s)) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance step-extract-xsound-closure (id (parent-1-id s)))
+		 (:instance step-extract-xsound-closure (id (parent-2-id s)))
+		 (:instance check-paramod-xsound
+			    (par1 (extract-step (parent-1-id s) prf))
+			    (par2 (extract-step (parent-2-id s) prf))
+			    (paramodulant (prf-clause s))))))
+  :rule-classes nil)
+
+(defthm flip-step-xsound
+  (implies (and (wfproof prf)
+		(wfproof-step s)
+		(check-step prf s)
+		(equal (prf-rule s) 'flip)
+		(xeval (universal-closure (extract-all-steps prf))
+		       (domain i) i))
+	   (xeval (universal-closure (prf-clause s)) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance step-extract-xsound-closure (id (parent-1-id s)))))
+	  )
+  :rule-classes nil)
+
+;;--------------
+
+(defthm step-xsound
+  (implies (and (wfproof prf)
+		(wfproof-step s)
+		(check-step prf s)
+		(not (equal (prf-rule s) 'input))
+		(xeval (universal-closure (extract-all-steps prf))
+			      (domain i) i))
+	   (xeval (universal-closure (prf-clause s)) (domain i) i))
+  :hints (("Goal"
+	   :in-theory (disable xeval free-vars alls)
+	   :do-not-induct t
+	   )
+
+; Subgoal numbers changed by Matt K. for v2-9 (probably caused by call-stack
+; change)
+
+; fcd/Satriani v3.7 Moore - used to be Subgoal 20
+	  ("Subgoal 12"
+	   :use ((:instance resolve-step-xsound)))
+	  ("Subgoal 16"
+	   :use ((:instance flip-step-xsound)))
+; fcd/Satriani v3.7 Moore - used to be Subgoal 14
+	  ("Subgoal 8"
+	   :use ((:instance instantiate-step-xsound)))
+; fcd/Satriani v3.7 Moore - used to be Subgoal 10
+	  ("Subgoal 20"
+	   :use ((:instance propositional-step-xsound)))
+	  ("Subgoal 4"
+	   :use ((:instance paramod-step-xsound)))
+	  )
+  :rule-classes nil)
+
+;;--------------
+
+(defthm check-proof-xsound-almost
+  (implies (and (wfproof done)
+		(wfproof todo)
+		(xeval (universal-closure (extract-all-steps done))
+		       (domain i) i)
+		(xeval (universal-closure (extract-input-steps todo))
+		       (domain i) i)
+		(check-proof done todo))
+	   (xeval (universal-closure (extract-all-steps todo)) (domain i) i))
+  :hints (("Goal"
+	   :in-theory (disable xeval free-vars alls check-step)
+	   :induct (check-proof done todo))
+	  ("Subgoal *1/2"
+	   :use ((:instance step-xsound
+			    (prf done)
+			    (s (car todo)))
+		 (:instance uc-conj-left
+			    (f (caddar todo))
+			    (g (extract-input-steps (cdr todo))))
+		 (:instance uc-conj-right
+			    (f (caddar todo))
+			    (g (extract-input-steps (cdr todo))))
+		 )))
+  :rule-classes nil)
+
+(defthm xeval-true
+  (xeval 'true dom i))
+
+(defthm check-proof-xsound
+  (implies (and (wfproof prf)
+		(xeval (universal-closure (extract-input-steps prf))
+			      (domain i) i)
+		(check-proof nil prf))
+	   (xeval (universal-closure (extract-all-steps prf)) (domain i) i))
+  :hints (("Goal"
+	   :in-theory (disable xeval free-vars alls)
+	   :do-not-induct t
+	   :use ((:instance check-proof-xsound-almost
+			    (todo prf)
+			    (done nil)))))
+  :rule-classes nil)
+
+;;-------------
+
+(defthm quant-free-remove-alls
+  (implies (universal-prefix-cnf f)
+	   (quantifier-free (remove-leading-alls f))))
+
+(defun initial-proof (f)
+  (declare (xargs :guard (and (wff f) (quantifier-free f))
+		  :verify-guards nil))
+  (if (wfand f)
+      (append (initial-proof (a1 f))
+	      (initial-proof (a2 f)))
+      (list (list 0 (list 'input) f))))
+
+(defthm initial-proof-true-listp
+  (true-listp (initial-proof f)))
+
+(verify-guards initial-proof)
+
+(defthm wfproof-append
+  (implies (and (wfproof a)
+		(wfproof b))
+	   (wfproof (append a b))))
+
+(defthm initial-proof-wf
+  (implies (and (wff f)
+		(quantifier-free f))
+	   (wfproof (initial-proof f))))
+
+(defun assign-ids-to-prf (prf i)
+  (declare (xargs :guard (and (wfproof prf) (natp i))))
+  (if (atom prf)
+      prf
+      (cons (cons i (cdr (car prf)))
+	    (assign-ids-to-prf (cdr prf) (+ 1 i)))))
+
+(defthm assign-ids-to-prf-preserves-wfproof
+  (implies (wfproof prf)
+	   (wfproof (assign-ids-to-prf prf i)))
+  :hints (("Goal"
+           :in-theory (disable wfjust))))
+
+(defstub external-prover (prf) t)  ;; This is the theorem prover!!
+
+(defthm assign-ids-to-prf-preserves-formula
+  (equal (extract-all-steps (assign-ids-to-prf prf i))
+	 (extract-all-steps prf)))
+
+(defthm assign-ids-to-prf-preserves-input-formula
+  (equal (extract-input-steps (assign-ids-to-prf prf i))
+	 (extract-input-steps prf)))
+
+;;-----------------------------
+;; Function fix-substs-in-prf fixes an incompatibility between
+;; Otter proof objects and IVY proof objects.  Otter proof objects
+;; have simultaneous substitutions (the conventional type),
+;; and IVY expects sequential substitutions.
+
+(defun fix-subst-in-step (step all-vars)
+  (declare (xargs :guard (and (wfproof-step step)
+			      (var-list all-vars))))
+  (if (equal (prf-rule step) 'instantiate)
+      (list* (car step)
+	     (list (car (cadr step))
+		   (cadr (cadr step))
+		   (seqify (caddr (cadr step))
+			   all-vars
+			   ))
+	     (cddr step))
+    step))
+
+(defun fix-substs-in-prf (prf all-vars)
+  (declare (xargs :guard (and (wfproof prf)
+			      (var-list all-vars))))
+  (if (atom prf)
+      prf
+      (cons (fix-subst-in-step (car prf) all-vars)
+	    (fix-substs-in-prf (cdr prf) all-vars))))
+
+(defthm fix-substs-in-prf-preserves-wfproof
+  (implies (wfproof prf)
+	   (wfproof (fix-substs-in-prf prf all-vars))))
+
+;;---------------------------------------------------------------
+;; Function (refute-n-check f) takes a closed universal-prefix-cnf formula
+;; (that is, a conjunction of clauses with universal quants on top),
+;; and adds derivable clauses to the conjunction.  (If we are lucky,
+;; one of the new clauses is 'false.)   Some untrusted program (say
+;; Otter) may be called to make the inferences.  If anything goes
+;; wrong, the formula f is returned unchanged.
+;;
+;; The (right-assoc-p f) guard is there because of a deficiency
+;; in Otter.  We need the clauses (disjunctions) to be right associated,
+;; because Otter always right associates clauses in its proof objects,
+;; and we have the equality condition on extract-input-steps below.
+
+(defun refute-n-check (f)
+  (declare (xargs :guard (and (wff f)
+			      (not (free-vars f))
+			      (universal-prefix-cnf f)
+			      (var-set (leading-alls f))
+			      (right-assoc-p f))))
+
+  ;; Put these checks here instead of on the soundness theorem.
+
+  (if (or (free-vars f) (not (var-set (leading-alls f))))
+      f
+    (let* ((clauses (remove-leading-alls f))
+	   (otter-input (assign-ids-to-prf (initial-proof clauses) 1))
+	   (otter-result (external-prover otter-input)))
+      (if (not (wfproof otter-result))
+	  f
+	(let ((fixed-result (fix-substs-in-prf
+			     otter-result
+			     (free-vars (extract-all-steps otter-result)))))
+	  (if (and (equal (extract-input-steps fixed-result)
+			  (extract-input-steps otter-input))
+		   (check-proof nil fixed-result))
+	      (universal-closure (extract-all-steps fixed-result))
+	    f))))))
+
+;;------------
+
+(defthm extract-input-append-xsound-1
+  (implies (xeval (extract-input-steps prf1) dom i)
+	   (equal (xeval (extract-input-steps (append prf1 prf2)) dom i)
+		  (xeval (extract-input-steps prf2) dom i))))
+
+(defthm extract-input-append-xsound-2
+  (implies (not (xeval (extract-input-steps prf1) dom i))
+	   (not (xeval (extract-input-steps (append prf1 prf2)) dom i))))
+
+(defthm extract-initial-xsound-ground
+  (equal (xeval (extract-input-steps (initial-proof f)) dom i)
+	 (xeval f dom i))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i))))
+
+(defun and-append (f g)
+  (declare (xargs :guard (and (wff f) (wff g))))
+  (cond ((wfand f) (list 'and (a1 f) (and-append (a2 f) g)))
+	((equal f 'true) g)
+	(t (list 'and f g))))
+
+(defthm extract-append-and-append
+  (equal (extract-input-steps (append a b))
+	 (and-append (extract-input-steps a)
+		     (extract-input-steps b))))
+
+(defthm subst-free-distributes-over-and-append
+  (equal (subst-free (and-append a b) x tm)
+	 (and-append (subst-free a x tm)
+		     (subst-free b x tm)))
+  :hints (("Subgoal *1/6"
+	   :in-theory (disable wfatomtop))))
+
+(defthm subst-free-across-extract-initial
+  (equal (subst-free (extract-input-steps (initial-proof f)) x tm)
+	 (extract-input-steps (initial-proof (subst-free f x tm))))
+  :hints (("goal"
+	   :do-not generalize)))
+
+(in-theory (disable extract-append-and-append))
+
+(defthm extract-initial-xsound-alls
+  (implies (var-set vars)
+	   (equal (xeval (alls vars (extract-input-steps (initial-proof f)))
+			 dom i)
+		  (xeval (alls vars f) dom i)))
+  :hints (("Goal"
+	   :induct (var-induct vars f dom i)
+           :in-theory (disable extract-input-steps))
+	  ))
+
+(defthm extract-initial-preserves-free-vars
+  (equal (free-vars (extract-input-steps (initial-proof f)))
+	 (free-vars f)))
+
+;;-------------------
+
+(defthm vars-strip-minus-leads-is-vars
+  (equal (set-difference-equal (free-vars (remove-leading-alls f))
+			       (leading-alls f))
+	 (free-vars f)))
+
+(defthm set-diff-nil-subset  ;; move to set book?
+  (implies (equal (set-difference-equal a b) nil)
+	   (subsetp-equal a b))
+  :rule-classes nil)
+
+(defthm subst-vars-remove-lead
+  (implies (not (free-vars f))
+	   (subsetp-equal (free-vars (remove-leading-alls f))
+			  (leading-alls f)))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance set-diff-nil-subset
+			    (a (free-vars (remove-leading-alls f)))
+			    (b (leading-alls f)))))))
+;;-------------------
+
+(defthm extract-initial-xsound
+  (implies (and (var-set (leading-alls f))
+		(not (free-vars f))
+		(xeval (alls (leading-alls f) (remove-leading-alls f))
+			      (domain i) i))
+	   (xeval (universal-closure
+			  (extract-input-steps
+			   (initial-proof
+			    (remove-leading-alls f))))
+			 (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance xeval-alls-subset
+			    (f (remove-leading-alls f))
+			    (a (free-vars (extract-input-steps
+					   (initial-proof
+					    (remove-leading-alls f)))))
+			    (b (leading-alls f)))))
+	  )
+  :rule-classes nil)
+
+(defthm refute-n-check-xsound-1
+  (implies (xeval f (domain i) i)
+	   (xeval (refute-n-check f) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance check-proof-xsound
+			    (prf (fix-substs-in-prf
+				  (external-prover
+				   (assign-ids-to-prf
+				    (initial-proof
+				     (remove-leading-alls f))
+				    1))
+				  (free-vars
+				   (extract-all-steps
+				    (external-prover
+				     (assign-ids-to-prf
+				      (initial-proof
+				       (remove-leading-alls f))
+				      1)))))))
+		 (:instance extract-initial-xsound)
+		 )
+	   ))
+  :otf-flg t
+  :rule-classes nil)
+
+;;------------------
+;; Now prove the other direction.  First, two preliminary theorems.
+
+(defthm uc-extract-all-extract-input-xsound
+  (implies (and (wfproof prf)
+		(xeval (universal-closure (extract-all-steps prf))
+		       (domain i) i))
+	   (xeval (universal-closure (extract-input-steps prf)) (domain i) i))
+  :hints (("Goal"
+	   :do-not generalize
+	   :hands-off (free-vars)
+	   :induct (extract-all-steps prf))
+	  ("Subgoal *1/2"
+	   :in-theory (disable uc-conj)
+	   :use ((:instance uc-conj-left
+			    (f (caddar prf))
+			    (g (extract-all-steps (cdr prf))))
+		 (:instance uc-conj
+			    (f (caddar prf))
+			    (g (extract-input-steps (cdr prf))))
+		 (:instance uc-conj-right
+			    (f (caddar prf))
+			    (g (extract-all-steps (cdr prf))))))))
+
+(defthm xeval-uc-lead-strip
+  (implies (and (var-set (leading-alls f))
+		(not (free-vars f)))
+	   (equal (xeval (universal-closure (remove-leading-alls f))
+			 (domain i) i)
+		  (xeval (alls (leading-alls f) (remove-leading-alls f))
+			 (domain i) i)))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance xeval-alls-subset
+                            (f (remove-leading-alls f))
+                            (a (free-vars (remove-leading-alls f)))
+                            (b (leading-alls f)))))))
+
+(defthm refute-n-check-xsound-2
+  (implies (xeval (refute-n-check f) (domain i) i)
+	   (xeval f (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+           :in-theory (disable xeval))
+	  ("Goal'"
+	   :use ((:instance uc-extract-all-extract-input-xsound
+			    (prf (fix-substs-in-prf
+				  (external-prover
+				   (assign-ids-to-prf
+				    (initial-proof
+				     (remove-leading-alls f))
+				    1))
+				  (free-vars
+				   (extract-all-steps
+				    (external-prover
+				     (assign-ids-to-prf
+				      (initial-proof
+				       (remove-leading-alls f))
+				      1)))))))))
+	  )
+  :rule-classes nil)
+
+;; Now put the two sides together.
+
+(defthm refute-n-check-xsound
+  (equal (xeval (refute-n-check f) (domain i) i)
+	 (xeval f (domain i) i))
+  :hints (("Goal"
+	   :in-theory (disable refute-n-check)
+	   :use ((:instance refute-n-check-xsound-1)
+		 (:instance refute-n-check-xsound-2)))))
+
+;;------------------
+;; In this section, show that (refute-n-check f) preserves wff and closedness.
+
+(defthm otter-check-wff
+  (implies (check-proof done prf)
+	   (wff (extract-all-steps prf))))
+
+(defthm refute-n-check-preserves-wff
+  (implies (wff f)
+	   (wff (refute-n-check f)))
+  :hints (("Goal"
+         :do-not-induct t)))
+
+(defthm refute-n-check-preserves-closedness
+  (implies (not (free-vars f)) (not (free-vars (refute-n-check f)))))
+
+(in-theory (disable refute-n-check))  ;; Because it is nonrecursive.
+
+(defthm refute-n-check-fsound
+  (equal (feval (refute-n-check f) i)
+	 (feval f i))
+  :hints (("Goal"
+           :in-theory (enable xeval-feval)
+           :do-not-induct t)))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/done b/books/workshops/1999/ivy/ivy-v2/ivy-sources/done
new file mode 100644
index 0000000..a0804dd
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/done
@@ -0,0 +1,57 @@
+arithmetic
+sets
+permutations
+base
+xeval
+variables
+alls
+wfftype
+stage
+
+keval
+close
+resolve
+paramod
+flip
+prop-subsume
+
+gensym-e
+
+instance
+instance-closure
+substitution
+simultaneous-d
+
+uc-conj
+derive
+simple-check
+
+cnf
+right-assoc
+nnf
+simplify
+
+rename
+rename-sound
+rename-unique
+rename-top
+
+pull
+pull-sound
+pull-pulls
+pull-top
+
+sk-misc-lemmas
+sk-useless
+sk-step
+sk-xbuild
+sk-step-sound
+skolem-top
+
+prover
+
+modeler
+
+top
+
+sugar
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/README b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/README
new file mode 100644
index 0000000..b5178bd
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/README
@@ -0,0 +1,34 @@
+To test Ivy on all of the examples, run (while in this directory)
+
+  ./test-all  ../util/ivy
+
+This should run 11 tests, and all should succeed.
+
+Note that you have to have write permission in the
+directory that contains the input files (this directory),
+because Ivy creates intermediate files there.
+If you don't have write permission, copy the whole
+directory, then run "./test-all <full-pathname-to-ivy>".
+
+To run just one test, say steam:
+
+  ../util/ivy  prove  steam
+
+(You have to have write-permssion for this as well.)
+
+Some of the input formulas are theorems, some are unsatisfiable,
+and some are neither.  There are 4 things you can try
+
+   prove        (calls Otter)
+   refute       (calls Otter)
+   disprove     (calls MACE)
+   model        (calls MACE)
+
+See test-all for the "correct" thing to try for each example.
+
+Also, there is a stand-alone proof checker that checks proof
+objects that already exist.  If you have a file that contains
+proof objects (for example, an Otter output file), say
+otter-cn.output you can check them like this:
+
+   ../util/checker otter-cn.output
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/cd-cn19 b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/cd-cn19
new file mode 100644
index 0000000..c314975
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/cd-cn19
@@ -0,0 +1,10 @@
+;; IVY operation: PROVE
+;;
+;; Theorem CN19 from the McCune/Wos Condensed Detachment paper (CADE-11).
+
+(imp (and (all x (all y (imp (and (p (i x y)) (p x)) (p y))))
+	  (all x (all y (all z (P (i (i x y) (i (i y z) (i x z)))))))
+	  (all x (P (i (i (n x) x) x)))
+	  (all x (all y (P (i x (i (n x) y))))))
+
+     (all a (all b (all c (P (i (i (i a b) c) (i b c)))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/comb-sk-w b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/comb-sk-w
new file mode 100644
index 0000000..ace5133
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/comb-sk-w
@@ -0,0 +1,10 @@
+;; IVY operation: PROVE
+;;
+;; From basis S and K, show that a combinator Wxy=xyy exists.
+
+(imp (and (all x (= x x))
+	  (all x (all y (all z (= (a (a (a (S) x) y) z)
+				  (a (a x z) (a y z))))))
+	  (all x (all y (= (a (a (K) x) y) x))))
+
+     (exists W (all x (all y (= (a (a W x) y) (a (a x y) y))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/comb-sw-not-weak b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/comb-sw-not-weak
new file mode 100644
index 0000000..ee91133
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/comb-sw-not-weak
@@ -0,0 +1,10 @@
+;; IVY operation: MODEL
+;;
+;; With basis S and W, show that not all combinators have fixed points.
+
+(and (= (a (a (a (S) x) y) z)
+	(a (a x z) (a y z)))
+     (= (a (a (W) x) y)
+	(a (a x y) y))
+     
+     (not (all f (exists y (= (a f y) y)))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-comm b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-comm
new file mode 100644
index 0000000..3ec7ae6
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-comm
@@ -0,0 +1,12 @@
+;; IVY operation: PROVE
+;;
+;; The group theory commutator problem: xxx=e => [[x,y],y]=e
+
+(imp (and (all x (= (f (e) x) x))
+	  (all x (= (f (g x) x) (e)))
+	  (all x (all y (all z (= (f (f x y) z) (f x (f y z))))))
+	  (all x (all y (= (h x y) (f x (f y (f (g x) (g y)))))))
+	  (all x (= (f x (f x x)) (e)))
+	  (all x (= x x)))
+
+     (all x (all y (= (h (h x y) y) (e)))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-noncomm b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-noncomm
new file mode 100644
index 0000000..7f3929e
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-noncomm
@@ -0,0 +1,9 @@
+;; IVY operation: DISPROVE
+;;
+;; Find a counterexample to "all groups are commutative".
+
+(imp (and (all x (= (f (e) x) x))
+	  (all x (= (f (g x) x) (e)))
+	  (all x (all y (all z (= (f (f x y) z) (f x (f y z)))))))
+
+     (all x (all y (= (f x y) (f y x)))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-noncomm-model b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-noncomm-model
new file mode 100644
index 0000000..759bbe2
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-noncomm-model
@@ -0,0 +1,9 @@
+;; IVY operation: MODEL
+;;
+;; Find a model of "there is a noncommutative group".
+
+(and (= (f (e) x) x)
+     (= (f (g x) x) (e))
+     (= (f (f x y) z) (f x (f y z)))
+
+     (exists x (exists y (not (= (f x y) (f y x))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-x2 b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-x2
new file mode 100644
index 0000000..9de9a69
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-x2
@@ -0,0 +1,11 @@
+;; IVY operation: PROVE
+;;
+;; xx=e groups are commutative.
+
+(imp (and (all x (= (f (e) x) x))
+	  (all x (= (f (g x) x) (e)))
+	  (all x (all y (all z (= (f (f x y) z) (f x (f y z))))))
+	  (all x (= (f x x) (e)))
+	  (all x (= x x)))
+
+     (all x (all y (= (f x y) (f y x)))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-x2-refute b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-x2-refute
new file mode 100644
index 0000000..acea5ac
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/group-x2-refute
@@ -0,0 +1,11 @@
+;; IVY operation: REFUTE
+;;
+;; Refute "there is a noncommutative xx=e group".
+
+(and (= (f (e) x) x)
+     (= (f (g x) x) (e))
+     (= (f (f x y) z) (f x (f y z)))
+     (= (f x x) (e))
+     (= x x)
+
+     (exists x (exists y (not (= (f x y) (f y x))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/lifsch b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/lifsch
new file mode 100644
index 0000000..d3b49a5
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/lifsch
@@ -0,0 +1,9 @@
+;; IVY operation: PROVE
+;;
+;; This is the Lifschitz theorem from the Otter examples.
+
+(exists x (exists x1 (all y (exists z (exists z1 
+
+   (and (or (not (p y y)) (p x x) (not (s z x)))
+	(or (s x y) (not (s y z)) (q z1 z1))
+        (or (q x1 y) (not (q y z1)) (s x1 x1))))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/otter-cn.input b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/otter-cn.input
new file mode 100644
index 0000000..5efcea3
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/otter-cn.input
@@ -0,0 +1,41 @@
+% The sentential calculus (CN).
+%
+% {CN1, CN2, CN3} (Lukasiewicz), along with condensed detachment,
+% axiomatizes the sentential calculus (the classical propositional calculus).
+%
+% Show that CN16, CN18, and CN19 can be derived.
+
+set(build_proof_object_2).
+
+set(hyper_res).
+clear(back_sub).
+assign(pick_given_ratio, 3).
+assign(max_proofs, 3).
+assign(max_weight, 16).
+clear(print_kept).
+set(order_history).
+
+assign(max_mem, 1500).       % 1.5 Megabytes
+
+% The symbols -> and - have built-in declarations, and they are used for
+% clauses and formulas.  When redeclaring them for use with terms, we
+% must be careful that they will still work for clauses and formulas.
+
+op(800, yfx, ->).  % left association
+
+list(usable).
+-P(x -> y) | -P(x) | P(y).    % condensed detachment
+end_of_list.
+
+list(sos).
+P(x -> y -> (y -> z -> (x -> z))).  % CN1
+P(-x -> x -> x).                      % CN2
+P(x -> (-x -> y)).                      % CN3
+end_of_list.
+
+list(passive).
+-P(a -> a).
+-P(b -> (a -> b)).
+-P(a -> b -> c -> (b -> c)).
+end_of_list.
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/otter-cn.output b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/otter-cn.output
new file mode 100644
index 0000000..4adc554
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/otter-cn.output
@@ -0,0 +1,702 @@
+----- Otter 3.0.6, Feb 2000 -----
+The process was started by mccune on lemma.mcs.anl.gov, Mon Feb 21 15:22:22 2000
+The command was "../../otter-3.0.6/source/otter".  The process ID is 27140.
+
+set(build_proof_object_2).
+   dependent: set(build_proof_object).
+   dependent: set(order_history).
+set(hyper_res).
+clear(back_sub).
+assign(pick_given_ratio,3).
+assign(max_proofs,3).
+assign(max_weight,16).
+clear(print_kept).
+WARNING: set(order_history) flag already set.
+set(order_history).
+assign(max_mem,1500).
+op(800,yfx,->).
+
+list(usable).
+1 [] -P(x->y)| -P(x)|P(y).
+end_of_list.
+
+list(sos).
+2 [] P(x->y-> (y->z-> (x->z))).
+3 [] P(-x->x->x).
+4 [] P(x-> (-x->y)).
+end_of_list.
+
+list(passive).
+5 [] -P(a->a).
+6 [] -P(b-> (a->b)).
+7 [] -P(a->b->c-> (b->c)).
+end_of_list.
+
+======= end of input processing =======
+
+=========== start of search ===========
+
+given clause #1: (wt=12) 2 [] P(x->y-> (y->z-> (x->z))).
+
+given clause #2: (wt=7) 3 [] P(-x->x->x).
+
+given clause #3: (wt=7) 4 [] P(x-> (-x->y)).
+
+given clause #4: (wt=10) 10 [hyper,1,4.1,4.1] P(-(x-> (-x->y))->z).
+
+given clause #5: (wt=16) 8 [hyper,1,2.1,2.1] P(x->y-> (z->y)->u-> (z->x->u)).
+
+given clause #6: (wt=10) 12 [hyper,1,4.1,3.1] P(-(-x->x->x)->y).
+
+given clause #7: (wt=11) 9 [hyper,1,2.1,3.1] P(x->y-> (-x->x->y)).
+
+given clause #8: (wt=10) 24 [hyper,1,9.1,4.1] P(-x->x-> (-x->y)).
+
+given clause #9: (wt=11) 11 [hyper,1,2.1,4.1] P(-x->y->z-> (x->z)).
+
+----> UNIT CONFLICT at   0.02 sec ----> 35 [binary,34.1,5.1] $F.
+
+Length of proof is 2.  Level of proof is 2.
+
+---------------- PROOF ----------------
+
+1 [] -P(x->y)| -P(x)|P(y).
+2 [] P(x->y-> (y->z-> (x->z))).
+3 [] P(-x->x->x).
+4 [] P(x-> (-x->y)).
+5 [] -P(a->a).
+11 [hyper,1,2.1,4.1] P(-x->y->z-> (x->z)).
+34 [hyper,1,11.1,3.1] P(x->x).
+35 [binary,34.1,5.1] $F.
+
+------------ end of proof -------------
+
+
+;; BEGINNING OF PROOF OBJECT
+(
+(1 (input) (or (not (P (-> v0 v1))) (or (not (P v0)) (P v1))) (1))
+(2 (input) (P (-> (-> v0 v1) (-> (-> v1 v2) (-> v0 v2)))) (2))
+(3 (input) (P (-> (-> (- v0) v0) v0)) (3))
+(4 (input) (P (-> v0 (-> (- v0) v1))) (4))
+(5 (input) (not (P (-> (a) (a)))) (5))
+(6 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(7 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(8 (resolve 6 (1) 7 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(9 (instantiate 8 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(10 (instantiate 9 ((v0 . v64)(v1 . (-> (- v64) v65)))) (or (not (P (-> v64 (-> (- v64) v65)))) (P (-> (-> (-> (- v64) v65) v2) (-> v64 v2)))) NIL)
+(11 (instantiate 4 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (- v64) v65))) NIL)
+(12 (resolve 10 (1) 11 ()) (P (-> (-> (-> (- v64) v65) v2) (-> v64 v2))) NIL)
+(13 (instantiate 12 ((v64 . v0)(v65 . v1))) (P (-> (-> (-> (- v0) v1) v2) (-> v0 v2))) (11))
+(14 (instantiate 1 ((v0 . (-> (-> (- v64) v65) v66))(v1 . (-> v64 v66)))) (or (not (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66)))) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66)))) NIL)
+(15 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66))) NIL)
+(16 (resolve 14 (1) 15 ()) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66))) NIL)
+(17 (instantiate 16 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> (-> (- v0) v1) v2))) (P (-> v0 v2))) NIL)
+(18 (instantiate 17 ((v0 . v64)(v1 . v64)(v2 . v64))) (or (not (P (-> (-> (- v64) v64) v64))) (P (-> v64 v64))) NIL)
+(19 (instantiate 3 ((v0 . v64))) (P (-> (-> (- v64) v64) v64)) NIL)
+(20 (resolve 18 (1) 19 ()) (P (-> v64 v64)) NIL)
+(21 (instantiate 20 ((v64 . v0))) (P (-> v0 v0)) (34))
+(22 (instantiate 21 ((v0 . (a)))) (P (-> (a) (a))) NIL)
+(23 (resolve 5 () 22 ()) false (35))
+)
+;; END OF PROOF OBJECT
+
+given clause #10: (wt=4) 34 [hyper,1,11.1,3.1] P(x->x).
+
+given clause #11: (wt=7) 37 [hyper,1,4.1,34.1] P(-(x->x)->y).
+
+given clause #12: (wt=10) 33 [hyper,1,11.1,4.1] P(x-> (-(-x->y)->z)).
+
+given clause #13: (wt=15) 13 [hyper,1,4.1,2.1] P(-(x->y-> (y->z-> (x->z)))->u).
+
+given clause #14: (wt=10) 39 [hyper,1,4.1,37.1] P(-(-(x->x)->y)->z).
+
+given clause #15: (wt=11) 29 [hyper,1,8.1,11.1] P(x-> -y-> (y-> (x->z))).
+
+given clause #16: (wt=9) 52 [hyper,1,11.1,29.1] P(x-> (y-> (-x->z))).
+
+given clause #17: (wt=13) 14 [hyper,1,4.1,10.1] P(-(-(x-> (-x->y))->z)->u).
+
+given clause #18: (wt=9) 56 [hyper,1,29.1,37.1] P(x-> (-(y->y)->z)).
+
+given clause #19: (wt=11) 32 [hyper,1,11.1,9.1] P(x-> (-(-x)-> -x->y)).
+
+given clause #20: (wt=11) 36 [hyper,1,11.1,2.1] P(x-> (y->z-> (-x->z))).
+
+given clause #21: (wt=14) 15 [hyper,1,2.1,10.1] P(x->y-> (-(z-> (-z->u))->y)).
+
+given clause #22: (wt=11) 40 [hyper,1,2.1,37.1] P(x->y-> (-(z->z)->y)).
+
+given clause #23: (wt=12) 55 [hyper,1,29.1,39.1] P(x-> (-(-(y->y)->z)->u)).
+
+given clause #24: (wt=12) 57 [hyper,1,29.1,12.1] P(x-> (-(-y->y->y)->z)).
+
+given clause #25: (wt=16) 16 [hyper,1,8.1,8.1] P(x-> (y->z)-> (u->y-> (x-> (u->z)))).
+
+given clause #26: (wt=12) 58 [hyper,1,29.1,10.1] P(x-> (-(y-> (-y->z))->u)).
+
+given clause #27: (wt=12) 61 [hyper,1,11.1,52.1] P(x-> (y-> (-(-x->z)->u))).
+
+given clause #28: (wt=12) 62 [hyper,1,9.1,52.1] P(-x->x-> (y-> (-x->z))).
+
+given clause #29: (wt=15) 17 [hyper,1,8.1,4.1] P(x->y-> (-(y->z-> (x->z))->u)).
+
+given clause #30: (wt=12) 63 [hyper,1,4.1,52.1] P(-(x-> (y-> (-x->z)))->u).
+
+given clause #31: (wt=12) 75 [hyper,1,4.1,56.1] P(-(x-> (-(y->y)->z))->u).
+
+given clause #32: (wt=13) 19 [hyper,1,4.1,12.1] P(-(-(-x->x->x)->y)->z).
+
+given clause #33: (wt=16) 18 [hyper,1,8.1,2.1] P(x->y-> (x->z->u-> (y->z->u))).
+
+given clause #34: (wt=13) 25 [hyper,1,9.1,3.1] P(-(-x->x)-> (-x->x)->x).
+
+given clause #35: (wt=13) 27 [hyper,1,4.1,24.1] P(-(-x->x-> (-x->y))->z).
+
+given clause #36: (wt=13) 38 [hyper,1,9.1,37.1] P(-(-(x->x))-> -(x->x)->y).
+
+given clause #37: (wt=14) 20 [hyper,1,2.1,12.1] P(x->y-> (-(-z->z->z)->y)).
+
+given clause #38: (wt=13) 42 [hyper,1,11.1,33.1] P(x-> (-(-(-x->y)->z)->u)).
+
+given clause #39: (wt=13) 43 [hyper,1,9.1,33.1] P(-x->x-> (-(-x->y)->z)).
+
+given clause #40: (wt=13) 44 [hyper,1,4.1,33.1] P(-(x-> (-(-x->y)->z))->u).
+
+given clause #41: (wt=16) 21 [hyper,1,9.1,9.1] P(-(x->y)-> (x->y)-> (-x->x->y)).
+
+given clause #42: (wt=13) 46 [hyper,1,33.1,37.1] P(-(-(-(x->x)->y)->z)->u).
+
+given clause #43: (wt=13) 64 [hyper,1,2.1,52.1] P(x-> (-y->z)->u-> (y->u)).
+
+given clause #44: (wt=12) 122 [hyper,1,64.1,4.1] P(x-> (-(y-> (-x->z))->u)).
+
+given clause #45: (wt=14) 22 [hyper,1,4.1,9.1] P(-(x->y-> (-x->x->y))->z).
+
+given clause #46: (wt=13) 76 [hyper,1,2.1,56.1] P(-(x->x)->y->z-> (u->z)).
+
+given clause #47: (wt=6) 132 [hyper,1,76.1,3.1] P(x-> (y->y)).
+
+given clause #48: (wt=9) 131 [hyper,1,76.1,21.1] P(x-> (-y->y->y)).
+
+given clause #49: (wt=15) 23 [hyper,1,2.1,9.1] P(-x->x->y->z-> (x->y->z)).
+
+given clause #50: (wt=9) 141 [hyper,1,4.1,132.1] P(-(x-> (y->y))->z).
+
+given clause #51: (wt=10) 140 [hyper,1,16.1,132.1] P(x->y-> (z-> (x->y))).
+
+given clause #52: (wt=8) 162 [hyper,1,140.1,132.1] P(x-> (y-> (z->z))).
+
+given clause #53: (wt=16) 26 [hyper,1,9.1,24.1] P(-(-x->x)-> (-x->x)-> (-x->y)).
+
+given clause #54: (wt=9) 181 [hyper,1,140.1,4.1] P(x-> (y-> (-y->z))).
+
+given clause #55: (wt=10) 142 [hyper,1,2.1,132.1] P(x->x->y-> (z->y)).
+
+given clause #56: (wt=10) 183 [hyper,1,140.1,162.1] P(x-> (y-> (z-> (u->u)))).
+
+given clause #57: (wt=14) 28 [hyper,1,2.1,24.1] P(-x->y->z-> (-x->x->z)).
+
+given clause #58: (wt=11) 129 [hyper,1,76.1,62.1] P(x-> (y-> (-(z->z)->u))).
+
+given clause #59: (wt=11) 135 [hyper,1,52.1,132.1] P(x-> (-(y-> (z->z))->u)).
+
+given clause #60: (wt=11) 154 [hyper,1,64.1,140.1] P(x-> (y-> (z-> (-x->u)))).
+
+given clause #61: (wt=14) 30 [hyper,1,4.1,11.1] P(-(-x->y->z-> (x->z))->u).
+
+given clause #62: (wt=11) 163 [hyper,1,140.1,131.1] P(x-> (y-> (-z->z->z))).
+
+given clause #63: (wt=11) 171 [hyper,1,140.1,52.1] P(x-> (y-> (z-> (-y->u)))).
+
+given clause #64: (wt=11) 190 [hyper,1,4.1,162.1] P(-(x-> (y-> (z->z)))->u).
+
+given clause #65: (wt=15) 31 [hyper,1,2.1,11.1] P(x->y->z-> (-x->u->y->z)).
+
+given clause #66: (wt=10) 249 [hyper,1,31.1,3.1] P(-(-x)->y->x->x).
+
+given clause #67: (wt=11) 192 [hyper,1,140.1,181.1] P(x-> (y-> (z-> (-z->u)))).
+
+given clause #68: (wt=12) 137 [hyper,1,33.1,132.1] P(-(-(x-> (y->y))->z)->u).
+
+given clause #69: (wt=16) 41 [hyper,1,33.1,33.1] P(-(-(x-> (-(-x->y)->z))->u)->v).
+
+given clause #70: (wt=12) 147 [hyper,1,4.1,131.1] P(-(x-> (-y->y->y))->z).
+
+given clause #71: (wt=12) 153 [hyper,1,140.1,140.1] P(x-> (y->z-> (u-> (y->z)))).
+
+given clause #72: (wt=12) 174 [hyper,1,140.1,33.1] P(x-> (y-> (-(-y->z)->u))).
+
+given clause #73: (wt=14) 45 [hyper,1,2.1,33.1] P(-(-x->y)->z->u-> (x->u)).
+
+given clause #74: (wt=12) 178 [hyper,1,140.1,24.1] P(x-> (-y->y-> (-y->z))).
+
+given clause #75: (wt=12) 191 [hyper,1,2.1,162.1] P(x-> (y->y)->z-> (u->z)).
+
+given clause #76: (wt=12) 197 [hyper,1,4.1,181.1] P(-(x-> (y-> (-y->z)))->u).
+
+given clause #77: (wt=16) 47 [hyper,1,33.1,24.1] P(-(-(-x->x-> (-x->y))->z)->u).
+
+given clause #78: (wt=12) 199 [hyper,1,140.1,142.1] P(x-> (y->y->z-> (u->z))).
+
+given clause #79: (wt=12) 202 [hyper,1,140.1,183.1] P(x-> (y-> (z-> (u-> (v->v))))).
+
+given clause #80: (wt=12) 251 [hyper,1,140.1,249.1] P(x-> (-(-y)->z->y->y)).
+
+given clause #81: (wt=16) 48 [hyper,1,33.1,12.1] P(-(-(-(-x->x->x)->y)->z)->u).
+
+given clause #82: (wt=12) 256 [hyper,1,8.1,249.1] P(x-> -(-(x->y))-> (x->y)).
+
+given clause #83: (wt=13) 87 [hyper,1,16.1,56.1] P(x-> -(y->y)-> (z-> (x->u))).
+
+given clause #84: (wt=13) 89 [hyper,1,16.1,52.1] P(x->y-> (z-> (x-> (-z->u)))).
+
+given clause #85: (wt=16) 49 [hyper,1,33.1,10.1] P(-(-(-(x-> (-x->y))->z)->u)->v).
+
+given clause #86: (wt=13) 121 [hyper,1,64.1,16.1] P(x-> (y-> -x-> (z-> (y->u)))).
+
+given clause #87: (wt=13) 123 [hyper,1,64.1,2.1] P(x-> (-x->y->z-> (u->z))).
+
+given clause #88: (wt=13) 139 [hyper,1,17.1,132.1] P(-(x->x->y-> (z->y))->u).
+
+given clause #89: (wt=16) 50 [hyper,1,33.1,39.1] P(-(-(-(-(x->x)->y)->z)->u)->v).
+
+given clause #90: (wt=13) 146 [hyper,1,16.1,131.1] P(x-> (-y->y)-> (z-> (x->y))).
+
+given clause #91: (wt=8) 308 [hyper,1,64.1,146.1] P(x-> (y-> (z->x))).
+
+given clause #92: (wt=8) 322 [hyper,1,146.1,308.1] P(x-> (y-> (z->y))).
+
+----> UNIT CONFLICT at   0.23 sec ----> 361 [binary,360.1,6.1] $F.
+
+Length of proof is 17.  Level of proof is 10.
+
+---------------- PROOF ----------------
+
+1 [] -P(x->y)| -P(x)|P(y).
+2 [] P(x->y-> (y->z-> (x->z))).
+3 [] P(-x->x->x).
+4 [] P(x-> (-x->y)).
+6 [] -P(b-> (a->b)).
+8 [hyper,1,2.1,2.1] P(x->y-> (z->y)->u-> (z->x->u)).
+9 [hyper,1,2.1,3.1] P(x->y-> (-x->x->y)).
+11 [hyper,1,2.1,4.1] P(-x->y->z-> (x->z)).
+16 [hyper,1,8.1,8.1] P(x-> (y->z)-> (u->y-> (x-> (u->z)))).
+21 [hyper,1,9.1,9.1] P(-(x->y)-> (x->y)-> (-x->x->y)).
+29 [hyper,1,8.1,11.1] P(x-> -y-> (y-> (x->z))).
+34 [hyper,1,11.1,3.1] P(x->x).
+37 [hyper,1,4.1,34.1] P(-(x->x)->y).
+52 [hyper,1,11.1,29.1] P(x-> (y-> (-x->z))).
+56 [hyper,1,29.1,37.1] P(x-> (-(y->y)->z)).
+64 [hyper,1,2.1,52.1] P(x-> (-y->z)->u-> (y->u)).
+76 [hyper,1,2.1,56.1] P(-(x->x)->y->z-> (u->z)).
+131 [hyper,1,76.1,21.1] P(x-> (-y->y->y)).
+146 [hyper,1,16.1,131.1] P(x-> (-y->y)-> (z-> (x->y))).
+308 [hyper,1,64.1,146.1] P(x-> (y-> (z->x))).
+322 [hyper,1,146.1,308.1] P(x-> (y-> (z->y))).
+360 [hyper,1,322.1,322.1] P(x-> (y->x)).
+361 [binary,360.1,6.1] $F.
+
+------------ end of proof -------------
+
+
+;; BEGINNING OF PROOF OBJECT
+(
+(1 (input) (or (not (P (-> v0 v1))) (or (not (P v0)) (P v1))) (1))
+(2 (input) (P (-> (-> v0 v1) (-> (-> v1 v2) (-> v0 v2)))) (2))
+(3 (input) (P (-> (-> (- v0) v0) v0)) (3))
+(4 (input) (P (-> v0 (-> (- v0) v1))) (4))
+(5 (input) (not (P (-> (b) (-> (a) (b))))) (6))
+(6 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(7 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(8 (resolve 6 (1) 7 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(9 (instantiate 8 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(10 (instantiate 9 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (P (-> (-> (-> (-> v65 v66) (-> v64 v66)) v2) (-> (-> v64 v65) v2)))) NIL)
+(11 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(12 (resolve 10 (1) 11 ()) (P (-> (-> (-> (-> v65 v66) (-> v64 v66)) v2) (-> (-> v64 v65) v2))) NIL)
+(13 (instantiate 12 ((v2 . v3)(v64 . v2)(v65 . v0)(v66 . v1))) (P (-> (-> (-> (-> v0 v1) (-> v2 v1)) v3) (-> (-> v2 v0) v3))) (8))
+(14 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(15 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(16 (resolve 14 (1) 15 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(17 (instantiate 16 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(18 (instantiate 17 ((v0 . (-> (- v64) v64))(v1 . v64))) (or (not (P (-> (-> (- v64) v64) v64))) (P (-> (-> v64 v2) (-> (-> (- v64) v64) v2)))) NIL)
+(19 (instantiate 3 ((v0 . v64))) (P (-> (-> (- v64) v64) v64)) NIL)
+(20 (resolve 18 (1) 19 ()) (P (-> (-> v64 v2) (-> (-> (- v64) v64) v2))) NIL)
+(21 (instantiate 20 ((v2 . v1)(v64 . v0))) (P (-> (-> v0 v1) (-> (-> (- v0) v0) v1))) (9))
+(22 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(23 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(24 (resolve 22 (1) 23 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(25 (instantiate 24 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(26 (instantiate 25 ((v0 . v64)(v1 . (-> (- v64) v65)))) (or (not (P (-> v64 (-> (- v64) v65)))) (P (-> (-> (-> (- v64) v65) v2) (-> v64 v2)))) NIL)
+(27 (instantiate 4 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (- v64) v65))) NIL)
+(28 (resolve 26 (1) 27 ()) (P (-> (-> (-> (- v64) v65) v2) (-> v64 v2))) NIL)
+(29 (instantiate 28 ((v64 . v0)(v65 . v1))) (P (-> (-> (-> (- v0) v1) v2) (-> v0 v2))) (11))
+(30 (instantiate 1 ((v0 . (-> (-> (-> v64 v65) (-> v66 v65)) v67))(v1 . (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67)))) NIL)
+(31 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67))) NIL)
+(32 (resolve 30 (1) 31 ()) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67))) NIL)
+(33 (instantiate 32 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> (-> v0 v1) (-> v2 v1)) v3))) (P (-> (-> v2 v0) v3))) NIL)
+(34 (instantiate 33 ((v0 . (-> v64 v65))(v1 . (-> v66 v65))(v3 . (-> (-> v66 v64) (-> v2 (-> v66 v65)))))) (or (not (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) (-> v2 (-> v66 v65))) (-> (-> v66 v64) (-> v2 (-> v66 v65)))))) (P (-> (-> v2 (-> v64 v65)) (-> (-> v66 v64) (-> v2 (-> v66 v65)))))) NIL)
+(35 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . (-> v2 (-> v66 v65))))) (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) (-> v2 (-> v66 v65))) (-> (-> v66 v64) (-> v2 (-> v66 v65))))) NIL)
+(36 (resolve 34 (1) 35 ()) (P (-> (-> v2 (-> v64 v65)) (-> (-> v66 v64) (-> v2 (-> v66 v65))))) NIL)
+(37 (instantiate 36 ((v2 . v0)(v64 . v1)(v65 . v2)(v66 . v3))) (P (-> (-> v0 (-> v1 v2)) (-> (-> v3 v1) (-> v0 (-> v3 v2))))) (16))
+(38 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> (- v64) v64) v65)))) (or (not (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65)))) (or (not (P (-> v64 v65))) (P (-> (-> (- v64) v64) v65)))) NIL)
+(39 (instantiate 21 ((v0 . v64)(v1 . v65))) (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65))) NIL)
+(40 (resolve 38 (1) 39 ()) (or (not (P (-> v64 v65))) (P (-> (-> (- v64) v64) v65))) NIL)
+(41 (instantiate 40 ((v64 . v0)(v65 . v1))) (or (not (P (-> v0 v1))) (P (-> (-> (- v0) v0) v1))) NIL)
+(42 (instantiate 41 ((v0 . (-> v64 v65))(v1 . (-> (-> (- v64) v64) v65)))) (or (not (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65)))) (P (-> (-> (- (-> v64 v65)) (-> v64 v65)) (-> (-> (- v64) v64) v65)))) NIL)
+(43 (instantiate 21 ((v0 . v64)(v1 . v65))) (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65))) NIL)
+(44 (resolve 42 (1) 43 ()) (P (-> (-> (- (-> v64 v65)) (-> v64 v65)) (-> (-> (- v64) v64) v65))) NIL)
+(45 (instantiate 44 ((v64 . v0)(v65 . v1))) (P (-> (-> (- (-> v0 v1)) (-> v0 v1)) (-> (-> (- v0) v0) v1))) (21))
+(46 (instantiate 1 ((v0 . (-> (-> (-> v64 v65) (-> v66 v65)) v67))(v1 . (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67)))) NIL)
+(47 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67))) NIL)
+(48 (resolve 46 (1) 47 ()) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67))) NIL)
+(49 (instantiate 48 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> (-> v0 v1) (-> v2 v1)) v3))) (P (-> (-> v2 v0) v3))) NIL)
+(50 (instantiate 49 ((v0 . (- v64))(v1 . v65)(v3 . (-> v64 (-> v2 v65))))) (or (not (P (-> (-> (-> (- v64) v65) (-> v2 v65)) (-> v64 (-> v2 v65))))) (P (-> (-> v2 (- v64)) (-> v64 (-> v2 v65))))) NIL)
+(51 (instantiate 29 ((v0 . v64)(v1 . v65)(v2 . (-> v2 v65)))) (P (-> (-> (-> (- v64) v65) (-> v2 v65)) (-> v64 (-> v2 v65)))) NIL)
+(52 (resolve 50 (1) 51 ()) (P (-> (-> v2 (- v64)) (-> v64 (-> v2 v65)))) NIL)
+(53 (instantiate 52 ((v2 . v0)(v64 . v1)(v65 . v2))) (P (-> (-> v0 (- v1)) (-> v1 (-> v0 v2)))) (29))
+(54 (instantiate 1 ((v0 . (-> (-> (- v64) v65) v66))(v1 . (-> v64 v66)))) (or (not (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66)))) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66)))) NIL)
+(55 (instantiate 29 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66))) NIL)
+(56 (resolve 54 (1) 55 ()) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66))) NIL)
+(57 (instantiate 56 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> (-> (- v0) v1) v2))) (P (-> v0 v2))) NIL)
+(58 (instantiate 57 ((v0 . v64)(v1 . v64)(v2 . v64))) (or (not (P (-> (-> (- v64) v64) v64))) (P (-> v64 v64))) NIL)
+(59 (instantiate 3 ((v0 . v64))) (P (-> (-> (- v64) v64) v64)) NIL)
+(60 (resolve 58 (1) 59 ()) (P (-> v64 v64)) NIL)
+(61 (instantiate 60 ((v64 . v0))) (P (-> v0 v0)) (34))
+(62 (instantiate 1 ((v0 . v64)(v1 . (-> (- v64) v65)))) (or (not (P (-> v64 (-> (- v64) v65)))) (or (not (P v64)) (P (-> (- v64) v65)))) NIL)
+(63 (instantiate 4 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (- v64) v65))) NIL)
+(64 (resolve 62 (1) 63 ()) (or (not (P v64)) (P (-> (- v64) v65))) NIL)
+(65 (instantiate 64 ((v64 . v0)(v65 . v1))) (or (not (P v0)) (P (-> (- v0) v1))) NIL)
+(66 (instantiate 65 ((v0 . (-> v64 v64)))) (or (not (P (-> v64 v64))) (P (-> (- (-> v64 v64)) v1))) NIL)
+(67 (instantiate 61 ((v0 . v64))) (P (-> v64 v64)) NIL)
+(68 (resolve 66 (1) 67 ()) (P (-> (- (-> v64 v64)) v1)) NIL)
+(69 (instantiate 68 ((v64 . v0))) (P (-> (- (-> v0 v0)) v1)) (37))
+(70 (instantiate 1 ((v0 . (-> (-> (- v64) v65) v66))(v1 . (-> v64 v66)))) (or (not (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66)))) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66)))) NIL)
+(71 (instantiate 29 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66))) NIL)
+(72 (resolve 70 (1) 71 ()) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66))) NIL)
+(73 (instantiate 72 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> (-> (- v0) v1) v2))) (P (-> v0 v2))) NIL)
+(74 (instantiate 73 ((v1 . (- v65))(v2 . (-> v65 (-> (- v0) v66))))) (or (not (P (-> (-> (- v0) (- v65)) (-> v65 (-> (- v0) v66))))) (P (-> v0 (-> v65 (-> (- v0) v66))))) NIL)
+(75 (instantiate 53 ((v0 . (- v0))(v1 . v65)(v2 . v66))) (P (-> (-> (- v0) (- v65)) (-> v65 (-> (- v0) v66)))) NIL)
+(76 (resolve 74 (1) 75 ()) (P (-> v0 (-> v65 (-> (- v0) v66)))) NIL)
+(77 (instantiate 76 ((v65 . v1)(v66 . v2))) (P (-> v0 (-> v1 (-> (- v0) v2)))) (52))
+(78 (instantiate 1 ((v0 . (-> v64 (- v65)))(v1 . (-> v65 (-> v64 v66))))) (or (not (P (-> (-> v64 (- v65)) (-> v65 (-> v64 v66))))) (or (not (P (-> v64 (- v65)))) (P (-> v65 (-> v64 v66))))) NIL)
+(79 (instantiate 53 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 (- v65)) (-> v65 (-> v64 v66)))) NIL)
+(80 (resolve 78 (1) 79 ()) (or (not (P (-> v64 (- v65)))) (P (-> v65 (-> v64 v66)))) NIL)
+(81 (instantiate 80 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 (- v1)))) (P (-> v1 (-> v0 v2)))) NIL)
+(82 (instantiate 81 ((v0 . (- (-> v64 v64))))) (or (not (P (-> (- (-> v64 v64)) (- v1)))) (P (-> v1 (-> (- (-> v64 v64)) v2)))) NIL)
+(83 (instantiate 69 ((v0 . v64)(v1 . (- v1)))) (P (-> (- (-> v64 v64)) (- v1))) NIL)
+(84 (resolve 82 (1) 83 ()) (P (-> v1 (-> (- (-> v64 v64)) v2))) NIL)
+(85 (instantiate 84 ((v1 . v0)(v64 . v1))) (P (-> v0 (-> (- (-> v1 v1)) v2))) (56))
+(86 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(87 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(88 (resolve 86 (1) 87 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(89 (instantiate 88 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(90 (instantiate 89 ((v0 . v64)(v1 . (-> v65 (-> (- v64) v66))))) (or (not (P (-> v64 (-> v65 (-> (- v64) v66))))) (P (-> (-> (-> v65 (-> (- v64) v66)) v2) (-> v64 v2)))) NIL)
+(91 (instantiate 77 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> v65 (-> (- v64) v66)))) NIL)
+(92 (resolve 90 (1) 91 ()) (P (-> (-> (-> v65 (-> (- v64) v66)) v2) (-> v64 v2))) NIL)
+(93 (instantiate 92 ((v2 . v3)(v64 . v1)(v65 . v0)(v66 . v2))) (P (-> (-> (-> v0 (-> (- v1) v2)) v3) (-> v1 v3))) (64))
+(94 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(95 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(96 (resolve 94 (1) 95 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(97 (instantiate 96 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(98 (instantiate 97 ((v0 . v64)(v1 . (-> (- (-> v65 v65)) v66)))) (or (not (P (-> v64 (-> (- (-> v65 v65)) v66)))) (P (-> (-> (-> (- (-> v65 v65)) v66) v2) (-> v64 v2)))) NIL)
+(99 (instantiate 85 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> (- (-> v65 v65)) v66))) NIL)
+(100 (resolve 98 (1) 99 ()) (P (-> (-> (-> (- (-> v65 v65)) v66) v2) (-> v64 v2))) NIL)
+(101 (instantiate 100 ((v64 . v3)(v65 . v0)(v66 . v1))) (P (-> (-> (-> (- (-> v0 v0)) v1) v2) (-> v3 v2))) (76))
+(102 (instantiate 1 ((v0 . (-> (-> (- (-> v64 v64)) v65) v66))(v1 . (-> v67 v66)))) (or (not (P (-> (-> (-> (- (-> v64 v64)) v65) v66) (-> v67 v66)))) (or (not (P (-> (-> (- (-> v64 v64)) v65) v66))) (P (-> v67 v66)))) NIL)
+(103 (instantiate 101 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> (- (-> v64 v64)) v65) v66) (-> v67 v66))) NIL)
+(104 (resolve 102 (1) 103 ()) (or (not (P (-> (-> (- (-> v64 v64)) v65) v66))) (P (-> v67 v66))) NIL)
+(105 (instantiate 104 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> (- (-> v0 v0)) v1) v2))) (P (-> v3 v2))) NIL)
+(106 (instantiate 105 ((v0 . v65)(v1 . (-> v65 v65))(v2 . (-> (-> (- v65) v65) v65)))) (or (not (P (-> (-> (- (-> v65 v65)) (-> v65 v65)) (-> (-> (- v65) v65) v65)))) (P (-> v3 (-> (-> (- v65) v65) v65)))) NIL)
+(107 (instantiate 45 ((v0 . v65)(v1 . v65))) (P (-> (-> (- (-> v65 v65)) (-> v65 v65)) (-> (-> (- v65) v65) v65))) NIL)
+(108 (resolve 106 (1) 107 ()) (P (-> v3 (-> (-> (- v65) v65) v65))) NIL)
+(109 (instantiate 108 ((v3 . v0)(v65 . v1))) (P (-> v0 (-> (-> (- v1) v1) v1))) (131))
+(110 (instantiate 1 ((v0 . (-> v64 (-> v65 v66)))(v1 . (-> (-> v67 v65) (-> v64 (-> v67 v66)))))) (or (not (P (-> (-> v64 (-> v65 v66)) (-> (-> v67 v65) (-> v64 (-> v67 v66)))))) (or (not (P (-> v64 (-> v65 v66)))) (P (-> (-> v67 v65) (-> v64 (-> v67 v66)))))) NIL)
+(111 (instantiate 37 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> v64 (-> v65 v66)) (-> (-> v67 v65) (-> v64 (-> v67 v66))))) NIL)
+(112 (resolve 110 (1) 111 ()) (or (not (P (-> v64 (-> v65 v66)))) (P (-> (-> v67 v65) (-> v64 (-> v67 v66))))) NIL)
+(113 (instantiate 112 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> v0 (-> v1 v2)))) (P (-> (-> v3 v1) (-> v0 (-> v3 v2))))) NIL)
+(114 (instantiate 113 ((v0 . v64)(v1 . (-> (- v65) v65))(v2 . v65))) (or (not (P (-> v64 (-> (-> (- v65) v65) v65)))) (P (-> (-> v3 (-> (- v65) v65)) (-> v64 (-> v3 v65))))) NIL)
+(115 (instantiate 109 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (-> (- v65) v65) v65))) NIL)
+(116 (resolve 114 (1) 115 ()) (P (-> (-> v3 (-> (- v65) v65)) (-> v64 (-> v3 v65)))) NIL)
+(117 (instantiate 116 ((v3 . v0)(v64 . v2)(v65 . v1))) (P (-> (-> v0 (-> (- v1) v1)) (-> v2 (-> v0 v1)))) (146))
+(118 (instantiate 1 ((v0 . (-> (-> v64 (-> (- v65) v66)) v67))(v1 . (-> v65 v67)))) (or (not (P (-> (-> (-> v64 (-> (- v65) v66)) v67) (-> v65 v67)))) (or (not (P (-> (-> v64 (-> (- v65) v66)) v67))) (P (-> v65 v67)))) NIL)
+(119 (instantiate 93 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> v64 (-> (- v65) v66)) v67) (-> v65 v67))) NIL)
+(120 (resolve 118 (1) 119 ()) (or (not (P (-> (-> v64 (-> (- v65) v66)) v67))) (P (-> v65 v67))) NIL)
+(121 (instantiate 120 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> v0 (-> (- v1) v2)) v3))) (P (-> v1 v3))) NIL)
+(122 (instantiate 121 ((v0 . v64)(v1 . v65)(v2 . v65)(v3 . (-> v66 (-> v64 v65))))) (or (not (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65))))) (P (-> v65 (-> v66 (-> v64 v65))))) NIL)
+(123 (instantiate 117 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65)))) NIL)
+(124 (resolve 122 (1) 123 ()) (P (-> v65 (-> v66 (-> v64 v65)))) NIL)
+(125 (instantiate 124 ((v64 . v2)(v65 . v0)(v66 . v1))) (P (-> v0 (-> v1 (-> v2 v0)))) (308))
+(126 (instantiate 1 ((v0 . (-> v64 (-> (- v65) v65)))(v1 . (-> v66 (-> v64 v65))))) (or (not (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65))))) (or (not (P (-> v64 (-> (- v65) v65)))) (P (-> v66 (-> v64 v65))))) NIL)
+(127 (instantiate 117 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65)))) NIL)
+(128 (resolve 126 (1) 127 ()) (or (not (P (-> v64 (-> (- v65) v65)))) (P (-> v66 (-> v64 v65)))) NIL)
+(129 (instantiate 128 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 (-> (- v1) v1)))) (P (-> v2 (-> v0 v1)))) NIL)
+(130 (instantiate 129 ((v0 . v64)(v1 . (-> v66 v64)))) (or (not (P (-> v64 (-> (- (-> v66 v64)) (-> v66 v64))))) (P (-> v2 (-> v64 (-> v66 v64))))) NIL)
+(131 (instantiate 125 ((v0 . v64)(v1 . (- (-> v66 v64)))(v2 . v66))) (P (-> v64 (-> (- (-> v66 v64)) (-> v66 v64)))) NIL)
+(132 (resolve 130 (1) 131 ()) (P (-> v2 (-> v64 (-> v66 v64)))) NIL)
+(133 (instantiate 132 ((v2 . v0)(v64 . v1)(v66 . v2))) (P (-> v0 (-> v1 (-> v2 v1)))) (322))
+(134 (instantiate 1 ((v0 . v64)(v1 . (-> v65 (-> v66 v65))))) (or (not (P (-> v64 (-> v65 (-> v66 v65))))) (or (not (P v64)) (P (-> v65 (-> v66 v65))))) NIL)
+(135 (instantiate 133 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> v65 (-> v66 v65)))) NIL)
+(136 (resolve 134 (1) 135 ()) (or (not (P v64)) (P (-> v65 (-> v66 v65)))) NIL)
+(137 (instantiate 136 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P v0)) (P (-> v1 (-> v2 v1)))) NIL)
+(138 (instantiate 137 ((v0 . (-> v64 (-> v65 (-> v66 v65)))))) (or (not (P (-> v64 (-> v65 (-> v66 v65))))) (P (-> v1 (-> v2 v1)))) NIL)
+(139 (instantiate 133 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> v65 (-> v66 v65)))) NIL)
+(140 (resolve 138 (1) 139 ()) (P (-> v1 (-> v2 v1))) NIL)
+(141 (instantiate 140 ((v1 . v0)(v2 . v1))) (P (-> v0 (-> v1 v0))) (360))
+(142 (instantiate 141 ((v0 . (b))(v1 . (a)))) (P (-> (b) (-> (a) (b)))) NIL)
+(143 (resolve 5 () 142 ()) false (361))
+)
+;; END OF PROOF OBJECT
+
+given clause #93: (wt=14) 51 [hyper,1,2.1,39.1] P(x->y-> (-(-(z->z)->u)->y)).
+
+given clause #94: (wt=6) 360 [hyper,1,322.1,322.1] P(x-> (y->x)).
+
+----> UNIT CONFLICT at   0.26 sec ----> 387 [binary,386.1,7.1] $F.
+
+Length of proof is 18.  Level of proof is 11.
+
+---------------- PROOF ----------------
+
+1 [] -P(x->y)| -P(x)|P(y).
+2 [] P(x->y-> (y->z-> (x->z))).
+3 [] P(-x->x->x).
+4 [] P(x-> (-x->y)).
+7 [] -P(a->b->c-> (b->c)).
+8 [hyper,1,2.1,2.1] P(x->y-> (z->y)->u-> (z->x->u)).
+9 [hyper,1,2.1,3.1] P(x->y-> (-x->x->y)).
+11 [hyper,1,2.1,4.1] P(-x->y->z-> (x->z)).
+16 [hyper,1,8.1,8.1] P(x-> (y->z)-> (u->y-> (x-> (u->z)))).
+21 [hyper,1,9.1,9.1] P(-(x->y)-> (x->y)-> (-x->x->y)).
+29 [hyper,1,8.1,11.1] P(x-> -y-> (y-> (x->z))).
+34 [hyper,1,11.1,3.1] P(x->x).
+37 [hyper,1,4.1,34.1] P(-(x->x)->y).
+52 [hyper,1,11.1,29.1] P(x-> (y-> (-x->z))).
+56 [hyper,1,29.1,37.1] P(x-> (-(y->y)->z)).
+64 [hyper,1,2.1,52.1] P(x-> (-y->z)->u-> (y->u)).
+76 [hyper,1,2.1,56.1] P(-(x->x)->y->z-> (u->z)).
+131 [hyper,1,76.1,21.1] P(x-> (-y->y->y)).
+146 [hyper,1,16.1,131.1] P(x-> (-y->y)-> (z-> (x->y))).
+308 [hyper,1,64.1,146.1] P(x-> (y-> (z->x))).
+322 [hyper,1,146.1,308.1] P(x-> (y-> (z->y))).
+360 [hyper,1,322.1,322.1] P(x-> (y->x)).
+386 [hyper,1,2.1,360.1] P(x->y->z-> (y->z)).
+387 [binary,386.1,7.1] $F.
+
+------------ end of proof -------------
+
+
+;; BEGINNING OF PROOF OBJECT
+(
+(1 (input) (or (not (P (-> v0 v1))) (or (not (P v0)) (P v1))) (1))
+(2 (input) (P (-> (-> v0 v1) (-> (-> v1 v2) (-> v0 v2)))) (2))
+(3 (input) (P (-> (-> (- v0) v0) v0)) (3))
+(4 (input) (P (-> v0 (-> (- v0) v1))) (4))
+(5 (input) (not (P (-> (-> (-> (a) (b)) (c)) (-> (b) (c))))) (7))
+(6 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(7 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(8 (resolve 6 (1) 7 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(9 (instantiate 8 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(10 (instantiate 9 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (P (-> (-> (-> (-> v65 v66) (-> v64 v66)) v2) (-> (-> v64 v65) v2)))) NIL)
+(11 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(12 (resolve 10 (1) 11 ()) (P (-> (-> (-> (-> v65 v66) (-> v64 v66)) v2) (-> (-> v64 v65) v2))) NIL)
+(13 (instantiate 12 ((v2 . v3)(v64 . v2)(v65 . v0)(v66 . v1))) (P (-> (-> (-> (-> v0 v1) (-> v2 v1)) v3) (-> (-> v2 v0) v3))) (8))
+(14 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(15 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(16 (resolve 14 (1) 15 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(17 (instantiate 16 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(18 (instantiate 17 ((v0 . (-> (- v64) v64))(v1 . v64))) (or (not (P (-> (-> (- v64) v64) v64))) (P (-> (-> v64 v2) (-> (-> (- v64) v64) v2)))) NIL)
+(19 (instantiate 3 ((v0 . v64))) (P (-> (-> (- v64) v64) v64)) NIL)
+(20 (resolve 18 (1) 19 ()) (P (-> (-> v64 v2) (-> (-> (- v64) v64) v2))) NIL)
+(21 (instantiate 20 ((v2 . v1)(v64 . v0))) (P (-> (-> v0 v1) (-> (-> (- v0) v0) v1))) (9))
+(22 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(23 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(24 (resolve 22 (1) 23 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(25 (instantiate 24 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(26 (instantiate 25 ((v0 . v64)(v1 . (-> (- v64) v65)))) (or (not (P (-> v64 (-> (- v64) v65)))) (P (-> (-> (-> (- v64) v65) v2) (-> v64 v2)))) NIL)
+(27 (instantiate 4 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (- v64) v65))) NIL)
+(28 (resolve 26 (1) 27 ()) (P (-> (-> (-> (- v64) v65) v2) (-> v64 v2))) NIL)
+(29 (instantiate 28 ((v64 . v0)(v65 . v1))) (P (-> (-> (-> (- v0) v1) v2) (-> v0 v2))) (11))
+(30 (instantiate 1 ((v0 . (-> (-> (-> v64 v65) (-> v66 v65)) v67))(v1 . (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67)))) NIL)
+(31 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67))) NIL)
+(32 (resolve 30 (1) 31 ()) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67))) NIL)
+(33 (instantiate 32 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> (-> v0 v1) (-> v2 v1)) v3))) (P (-> (-> v2 v0) v3))) NIL)
+(34 (instantiate 33 ((v0 . (-> v64 v65))(v1 . (-> v66 v65))(v3 . (-> (-> v66 v64) (-> v2 (-> v66 v65)))))) (or (not (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) (-> v2 (-> v66 v65))) (-> (-> v66 v64) (-> v2 (-> v66 v65)))))) (P (-> (-> v2 (-> v64 v65)) (-> (-> v66 v64) (-> v2 (-> v66 v65)))))) NIL)
+(35 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . (-> v2 (-> v66 v65))))) (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) (-> v2 (-> v66 v65))) (-> (-> v66 v64) (-> v2 (-> v66 v65))))) NIL)
+(36 (resolve 34 (1) 35 ()) (P (-> (-> v2 (-> v64 v65)) (-> (-> v66 v64) (-> v2 (-> v66 v65))))) NIL)
+(37 (instantiate 36 ((v2 . v0)(v64 . v1)(v65 . v2)(v66 . v3))) (P (-> (-> v0 (-> v1 v2)) (-> (-> v3 v1) (-> v0 (-> v3 v2))))) (16))
+(38 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> (- v64) v64) v65)))) (or (not (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65)))) (or (not (P (-> v64 v65))) (P (-> (-> (- v64) v64) v65)))) NIL)
+(39 (instantiate 21 ((v0 . v64)(v1 . v65))) (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65))) NIL)
+(40 (resolve 38 (1) 39 ()) (or (not (P (-> v64 v65))) (P (-> (-> (- v64) v64) v65))) NIL)
+(41 (instantiate 40 ((v64 . v0)(v65 . v1))) (or (not (P (-> v0 v1))) (P (-> (-> (- v0) v0) v1))) NIL)
+(42 (instantiate 41 ((v0 . (-> v64 v65))(v1 . (-> (-> (- v64) v64) v65)))) (or (not (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65)))) (P (-> (-> (- (-> v64 v65)) (-> v64 v65)) (-> (-> (- v64) v64) v65)))) NIL)
+(43 (instantiate 21 ((v0 . v64)(v1 . v65))) (P (-> (-> v64 v65) (-> (-> (- v64) v64) v65))) NIL)
+(44 (resolve 42 (1) 43 ()) (P (-> (-> (- (-> v64 v65)) (-> v64 v65)) (-> (-> (- v64) v64) v65))) NIL)
+(45 (instantiate 44 ((v64 . v0)(v65 . v1))) (P (-> (-> (- (-> v0 v1)) (-> v0 v1)) (-> (-> (- v0) v0) v1))) (21))
+(46 (instantiate 1 ((v0 . (-> (-> (-> v64 v65) (-> v66 v65)) v67))(v1 . (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67)))) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67)))) NIL)
+(47 (instantiate 13 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> (-> v64 v65) (-> v66 v65)) v67) (-> (-> v66 v64) v67))) NIL)
+(48 (resolve 46 (1) 47 ()) (or (not (P (-> (-> (-> v64 v65) (-> v66 v65)) v67))) (P (-> (-> v66 v64) v67))) NIL)
+(49 (instantiate 48 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> (-> v0 v1) (-> v2 v1)) v3))) (P (-> (-> v2 v0) v3))) NIL)
+(50 (instantiate 49 ((v0 . (- v64))(v1 . v65)(v3 . (-> v64 (-> v2 v65))))) (or (not (P (-> (-> (-> (- v64) v65) (-> v2 v65)) (-> v64 (-> v2 v65))))) (P (-> (-> v2 (- v64)) (-> v64 (-> v2 v65))))) NIL)
+(51 (instantiate 29 ((v0 . v64)(v1 . v65)(v2 . (-> v2 v65)))) (P (-> (-> (-> (- v64) v65) (-> v2 v65)) (-> v64 (-> v2 v65)))) NIL)
+(52 (resolve 50 (1) 51 ()) (P (-> (-> v2 (- v64)) (-> v64 (-> v2 v65)))) NIL)
+(53 (instantiate 52 ((v2 . v0)(v64 . v1)(v65 . v2))) (P (-> (-> v0 (- v1)) (-> v1 (-> v0 v2)))) (29))
+(54 (instantiate 1 ((v0 . (-> (-> (- v64) v65) v66))(v1 . (-> v64 v66)))) (or (not (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66)))) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66)))) NIL)
+(55 (instantiate 29 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66))) NIL)
+(56 (resolve 54 (1) 55 ()) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66))) NIL)
+(57 (instantiate 56 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> (-> (- v0) v1) v2))) (P (-> v0 v2))) NIL)
+(58 (instantiate 57 ((v0 . v64)(v1 . v64)(v2 . v64))) (or (not (P (-> (-> (- v64) v64) v64))) (P (-> v64 v64))) NIL)
+(59 (instantiate 3 ((v0 . v64))) (P (-> (-> (- v64) v64) v64)) NIL)
+(60 (resolve 58 (1) 59 ()) (P (-> v64 v64)) NIL)
+(61 (instantiate 60 ((v64 . v0))) (P (-> v0 v0)) (34))
+(62 (instantiate 1 ((v0 . v64)(v1 . (-> (- v64) v65)))) (or (not (P (-> v64 (-> (- v64) v65)))) (or (not (P v64)) (P (-> (- v64) v65)))) NIL)
+(63 (instantiate 4 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (- v64) v65))) NIL)
+(64 (resolve 62 (1) 63 ()) (or (not (P v64)) (P (-> (- v64) v65))) NIL)
+(65 (instantiate 64 ((v64 . v0)(v65 . v1))) (or (not (P v0)) (P (-> (- v0) v1))) NIL)
+(66 (instantiate 65 ((v0 . (-> v64 v64)))) (or (not (P (-> v64 v64))) (P (-> (- (-> v64 v64)) v1))) NIL)
+(67 (instantiate 61 ((v0 . v64))) (P (-> v64 v64)) NIL)
+(68 (resolve 66 (1) 67 ()) (P (-> (- (-> v64 v64)) v1)) NIL)
+(69 (instantiate 68 ((v64 . v0))) (P (-> (- (-> v0 v0)) v1)) (37))
+(70 (instantiate 1 ((v0 . (-> (-> (- v64) v65) v66))(v1 . (-> v64 v66)))) (or (not (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66)))) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66)))) NIL)
+(71 (instantiate 29 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> (-> (- v64) v65) v66) (-> v64 v66))) NIL)
+(72 (resolve 70 (1) 71 ()) (or (not (P (-> (-> (- v64) v65) v66))) (P (-> v64 v66))) NIL)
+(73 (instantiate 72 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> (-> (- v0) v1) v2))) (P (-> v0 v2))) NIL)
+(74 (instantiate 73 ((v1 . (- v65))(v2 . (-> v65 (-> (- v0) v66))))) (or (not (P (-> (-> (- v0) (- v65)) (-> v65 (-> (- v0) v66))))) (P (-> v0 (-> v65 (-> (- v0) v66))))) NIL)
+(75 (instantiate 53 ((v0 . (- v0))(v1 . v65)(v2 . v66))) (P (-> (-> (- v0) (- v65)) (-> v65 (-> (- v0) v66)))) NIL)
+(76 (resolve 74 (1) 75 ()) (P (-> v0 (-> v65 (-> (- v0) v66)))) NIL)
+(77 (instantiate 76 ((v65 . v1)(v66 . v2))) (P (-> v0 (-> v1 (-> (- v0) v2)))) (52))
+(78 (instantiate 1 ((v0 . (-> v64 (- v65)))(v1 . (-> v65 (-> v64 v66))))) (or (not (P (-> (-> v64 (- v65)) (-> v65 (-> v64 v66))))) (or (not (P (-> v64 (- v65)))) (P (-> v65 (-> v64 v66))))) NIL)
+(79 (instantiate 53 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 (- v65)) (-> v65 (-> v64 v66)))) NIL)
+(80 (resolve 78 (1) 79 ()) (or (not (P (-> v64 (- v65)))) (P (-> v65 (-> v64 v66)))) NIL)
+(81 (instantiate 80 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 (- v1)))) (P (-> v1 (-> v0 v2)))) NIL)
+(82 (instantiate 81 ((v0 . (- (-> v64 v64))))) (or (not (P (-> (- (-> v64 v64)) (- v1)))) (P (-> v1 (-> (- (-> v64 v64)) v2)))) NIL)
+(83 (instantiate 69 ((v0 . v64)(v1 . (- v1)))) (P (-> (- (-> v64 v64)) (- v1))) NIL)
+(84 (resolve 82 (1) 83 ()) (P (-> v1 (-> (- (-> v64 v64)) v2))) NIL)
+(85 (instantiate 84 ((v1 . v0)(v64 . v1))) (P (-> v0 (-> (- (-> v1 v1)) v2))) (56))
+(86 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(87 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(88 (resolve 86 (1) 87 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(89 (instantiate 88 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(90 (instantiate 89 ((v0 . v64)(v1 . (-> v65 (-> (- v64) v66))))) (or (not (P (-> v64 (-> v65 (-> (- v64) v66))))) (P (-> (-> (-> v65 (-> (- v64) v66)) v2) (-> v64 v2)))) NIL)
+(91 (instantiate 77 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> v65 (-> (- v64) v66)))) NIL)
+(92 (resolve 90 (1) 91 ()) (P (-> (-> (-> v65 (-> (- v64) v66)) v2) (-> v64 v2))) NIL)
+(93 (instantiate 92 ((v2 . v3)(v64 . v1)(v65 . v0)(v66 . v2))) (P (-> (-> (-> v0 (-> (- v1) v2)) v3) (-> v1 v3))) (64))
+(94 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(95 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(96 (resolve 94 (1) 95 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(97 (instantiate 96 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(98 (instantiate 97 ((v0 . v64)(v1 . (-> (- (-> v65 v65)) v66)))) (or (not (P (-> v64 (-> (- (-> v65 v65)) v66)))) (P (-> (-> (-> (- (-> v65 v65)) v66) v2) (-> v64 v2)))) NIL)
+(99 (instantiate 85 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> (- (-> v65 v65)) v66))) NIL)
+(100 (resolve 98 (1) 99 ()) (P (-> (-> (-> (- (-> v65 v65)) v66) v2) (-> v64 v2))) NIL)
+(101 (instantiate 100 ((v64 . v3)(v65 . v0)(v66 . v1))) (P (-> (-> (-> (- (-> v0 v0)) v1) v2) (-> v3 v2))) (76))
+(102 (instantiate 1 ((v0 . (-> (-> (- (-> v64 v64)) v65) v66))(v1 . (-> v67 v66)))) (or (not (P (-> (-> (-> (- (-> v64 v64)) v65) v66) (-> v67 v66)))) (or (not (P (-> (-> (- (-> v64 v64)) v65) v66))) (P (-> v67 v66)))) NIL)
+(103 (instantiate 101 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> (- (-> v64 v64)) v65) v66) (-> v67 v66))) NIL)
+(104 (resolve 102 (1) 103 ()) (or (not (P (-> (-> (- (-> v64 v64)) v65) v66))) (P (-> v67 v66))) NIL)
+(105 (instantiate 104 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> (- (-> v0 v0)) v1) v2))) (P (-> v3 v2))) NIL)
+(106 (instantiate 105 ((v0 . v65)(v1 . (-> v65 v65))(v2 . (-> (-> (- v65) v65) v65)))) (or (not (P (-> (-> (- (-> v65 v65)) (-> v65 v65)) (-> (-> (- v65) v65) v65)))) (P (-> v3 (-> (-> (- v65) v65) v65)))) NIL)
+(107 (instantiate 45 ((v0 . v65)(v1 . v65))) (P (-> (-> (- (-> v65 v65)) (-> v65 v65)) (-> (-> (- v65) v65) v65))) NIL)
+(108 (resolve 106 (1) 107 ()) (P (-> v3 (-> (-> (- v65) v65) v65))) NIL)
+(109 (instantiate 108 ((v3 . v0)(v65 . v1))) (P (-> v0 (-> (-> (- v1) v1) v1))) (131))
+(110 (instantiate 1 ((v0 . (-> v64 (-> v65 v66)))(v1 . (-> (-> v67 v65) (-> v64 (-> v67 v66)))))) (or (not (P (-> (-> v64 (-> v65 v66)) (-> (-> v67 v65) (-> v64 (-> v67 v66)))))) (or (not (P (-> v64 (-> v65 v66)))) (P (-> (-> v67 v65) (-> v64 (-> v67 v66)))))) NIL)
+(111 (instantiate 37 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> v64 (-> v65 v66)) (-> (-> v67 v65) (-> v64 (-> v67 v66))))) NIL)
+(112 (resolve 110 (1) 111 ()) (or (not (P (-> v64 (-> v65 v66)))) (P (-> (-> v67 v65) (-> v64 (-> v67 v66))))) NIL)
+(113 (instantiate 112 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> v0 (-> v1 v2)))) (P (-> (-> v3 v1) (-> v0 (-> v3 v2))))) NIL)
+(114 (instantiate 113 ((v0 . v64)(v1 . (-> (- v65) v65))(v2 . v65))) (or (not (P (-> v64 (-> (-> (- v65) v65) v65)))) (P (-> (-> v3 (-> (- v65) v65)) (-> v64 (-> v3 v65))))) NIL)
+(115 (instantiate 109 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> (-> (- v65) v65) v65))) NIL)
+(116 (resolve 114 (1) 115 ()) (P (-> (-> v3 (-> (- v65) v65)) (-> v64 (-> v3 v65)))) NIL)
+(117 (instantiate 116 ((v3 . v0)(v64 . v2)(v65 . v1))) (P (-> (-> v0 (-> (- v1) v1)) (-> v2 (-> v0 v1)))) (146))
+(118 (instantiate 1 ((v0 . (-> (-> v64 (-> (- v65) v66)) v67))(v1 . (-> v65 v67)))) (or (not (P (-> (-> (-> v64 (-> (- v65) v66)) v67) (-> v65 v67)))) (or (not (P (-> (-> v64 (-> (- v65) v66)) v67))) (P (-> v65 v67)))) NIL)
+(119 (instantiate 93 ((v0 . v64)(v1 . v65)(v2 . v66)(v3 . v67))) (P (-> (-> (-> v64 (-> (- v65) v66)) v67) (-> v65 v67))) NIL)
+(120 (resolve 118 (1) 119 ()) (or (not (P (-> (-> v64 (-> (- v65) v66)) v67))) (P (-> v65 v67))) NIL)
+(121 (instantiate 120 ((v64 . v0)(v65 . v1)(v66 . v2)(v67 . v3))) (or (not (P (-> (-> v0 (-> (- v1) v2)) v3))) (P (-> v1 v3))) NIL)
+(122 (instantiate 121 ((v0 . v64)(v1 . v65)(v2 . v65)(v3 . (-> v66 (-> v64 v65))))) (or (not (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65))))) (P (-> v65 (-> v66 (-> v64 v65))))) NIL)
+(123 (instantiate 117 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65)))) NIL)
+(124 (resolve 122 (1) 123 ()) (P (-> v65 (-> v66 (-> v64 v65)))) NIL)
+(125 (instantiate 124 ((v64 . v2)(v65 . v0)(v66 . v1))) (P (-> v0 (-> v1 (-> v2 v0)))) (308))
+(126 (instantiate 1 ((v0 . (-> v64 (-> (- v65) v65)))(v1 . (-> v66 (-> v64 v65))))) (or (not (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65))))) (or (not (P (-> v64 (-> (- v65) v65)))) (P (-> v66 (-> v64 v65))))) NIL)
+(127 (instantiate 117 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 (-> (- v65) v65)) (-> v66 (-> v64 v65)))) NIL)
+(128 (resolve 126 (1) 127 ()) (or (not (P (-> v64 (-> (- v65) v65)))) (P (-> v66 (-> v64 v65)))) NIL)
+(129 (instantiate 128 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 (-> (- v1) v1)))) (P (-> v2 (-> v0 v1)))) NIL)
+(130 (instantiate 129 ((v0 . v64)(v1 . (-> v66 v64)))) (or (not (P (-> v64 (-> (- (-> v66 v64)) (-> v66 v64))))) (P (-> v2 (-> v64 (-> v66 v64))))) NIL)
+(131 (instantiate 125 ((v0 . v64)(v1 . (- (-> v66 v64)))(v2 . v66))) (P (-> v64 (-> (- (-> v66 v64)) (-> v66 v64)))) NIL)
+(132 (resolve 130 (1) 131 ()) (P (-> v2 (-> v64 (-> v66 v64)))) NIL)
+(133 (instantiate 132 ((v2 . v0)(v64 . v1)(v66 . v2))) (P (-> v0 (-> v1 (-> v2 v1)))) (322))
+(134 (instantiate 1 ((v0 . v64)(v1 . (-> v65 (-> v66 v65))))) (or (not (P (-> v64 (-> v65 (-> v66 v65))))) (or (not (P v64)) (P (-> v65 (-> v66 v65))))) NIL)
+(135 (instantiate 133 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> v65 (-> v66 v65)))) NIL)
+(136 (resolve 134 (1) 135 ()) (or (not (P v64)) (P (-> v65 (-> v66 v65)))) NIL)
+(137 (instantiate 136 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P v0)) (P (-> v1 (-> v2 v1)))) NIL)
+(138 (instantiate 137 ((v0 . (-> v64 (-> v65 (-> v66 v65)))))) (or (not (P (-> v64 (-> v65 (-> v66 v65))))) (P (-> v1 (-> v2 v1)))) NIL)
+(139 (instantiate 133 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> v64 (-> v65 (-> v66 v65)))) NIL)
+(140 (resolve 138 (1) 139 ()) (P (-> v1 (-> v2 v1))) NIL)
+(141 (instantiate 140 ((v1 . v0)(v2 . v1))) (P (-> v0 (-> v1 v0))) (360))
+(142 (instantiate 1 ((v0 . (-> v64 v65))(v1 . (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66))))) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66))))) NIL)
+(143 (instantiate 2 ((v0 . v64)(v1 . v65)(v2 . v66))) (P (-> (-> v64 v65) (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(144 (resolve 142 (1) 143 ()) (or (not (P (-> v64 v65))) (P (-> (-> v65 v66) (-> v64 v66)))) NIL)
+(145 (instantiate 144 ((v64 . v0)(v65 . v1)(v66 . v2))) (or (not (P (-> v0 v1))) (P (-> (-> v1 v2) (-> v0 v2)))) NIL)
+(146 (instantiate 145 ((v0 . v64)(v1 . (-> v65 v64)))) (or (not (P (-> v64 (-> v65 v64)))) (P (-> (-> (-> v65 v64) v2) (-> v64 v2)))) NIL)
+(147 (instantiate 141 ((v0 . v64)(v1 . v65))) (P (-> v64 (-> v65 v64))) NIL)
+(148 (resolve 146 (1) 147 ()) (P (-> (-> (-> v65 v64) v2) (-> v64 v2))) NIL)
+(149 (instantiate 148 ((v64 . v1)(v65 . v0))) (P (-> (-> (-> v0 v1) v2) (-> v1 v2))) (386))
+(150 (instantiate 149 ((v0 . (a))(v1 . (b))(v2 . (c)))) (P (-> (-> (-> (a) (b)) (c)) (-> (b) (c)))) NIL)
+(151 (resolve 5 () 150 ()) false (387))
+)
+;; END OF PROOF OBJECT
+
+Search stopped by max_proofs option.
+
+============ end of search ============
+
+-------------- statistics -------------
+clauses given                 94
+clauses generated           5345
+  hyper_res generated       5345
+demod & eval rewrites          0
+clauses wt,lit,sk delete    1477
+tautologies deleted            0
+clauses forward subsumed    3491
+  (subsumed by sos)          447
+unit deletions                 0
+factor simplifications         0
+clauses kept                 377
+new demodulators               0
+empty clauses                  3
+clauses back demodulated       0
+clauses back subsumed          0
+usable size                   95
+sos size                     286
+demodulators size              0
+passive size                   3
+hot size                       0
+Kbytes malloced              766
+
+----------- times (seconds) -----------
+user CPU time          0.28          (0 hr, 0 min, 0 sec)
+system CPU time        0.09          (0 hr, 0 min, 0 sec)
+wall-clock time        0             (0 hr, 0 min, 0 sec)
+input time             0.00
+  clausify time        0.00
+hyper_res time         0.09
+pre_process time       0.16
+  renumber time        0.02
+  demod time           0.03
+  order equalities     0.00
+  unit deleletion      0.00
+  factor simplify      0.00
+  weigh cl time        0.01
+  hints keep time      0.00
+  sort lits time       0.00
+  forward subsume      0.01
+  delete cl time       0.02
+  keep cl time         0.00
+    hints time         0.00
+  print_cl time        0.00
+  conflict time        0.04
+  new demod time       0.00
+post_process time      0.00
+  back demod time      0.00
+  back subsume         0.00
+  factor time          0.00
+  unindex time         0.00
+
+That finishes the proof of the theorem.
+
+Process 27140 finished Mon Feb 21 15:22:22 2000
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/steam b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/steam
new file mode 100644
index 0000000..1d890af
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/steam
@@ -0,0 +1,35 @@
+;; IVY operation: PROVE
+;;
+;; Schubert's Steamroller.
+
+(imp (and (all x (imp (Wolf x) (animal x)))
+	  (all x (imp (Fox x) (animal x)))
+	  (all x (imp (Bird x) (animal x)))
+	  (all x (imp (Snail x) (animal x)))
+	  (all x (imp (Grain x) (plant x)))
+	  (exists x (Wolf x))
+	  (exists x (Fox x))
+	  (exists x (Bird x))
+	  (exists x (Snail x))
+	  (exists x (Grain x))
+	  (all x (all y (imp (and (Snail x) (Bird y)) (Smaller x y))))
+	  (all x (all y (imp (and (Bird x) (Fox y)) (Smaller x y))))
+	  (all x (all y (imp (and (Fox x) (Wolf y)) (Smaller x y))))
+	  (all x (imp (Snail x) (exists y (and (plant y) (eats x y)))))
+	  (all x (all y (imp (and (Wolf x) (Fox y)) (not (eats x y)))))
+	  (all x (all y (imp (and (Wolf x) (Grain y)) (not (eats x y)))))
+	  (all x (all y (imp (and (Bird x) (Snail y)) (not (eats x y)))))
+	  (all x (imp (animal x)
+		      (or (all y (imp (plant y) (eats x y)))
+			  (all z (imp (and (animal z)
+					   (Smaller z x)
+					   (exists u (and (plant u)
+							  (eats z u))))
+				      (eats x z)))))))
+
+     (exists x (exists y (and (animal x)
+			      (animal y)
+			      (eats x y)
+			      (all z (imp (grain z) (eats y z)))))))
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/steam-x b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/steam-x
new file mode 100644
index 0000000..e065c9f
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/steam-x
@@ -0,0 +1,35 @@
+;; IVY operation: DISPROVE
+;;
+;; Schubert's Steamroller, without one of the essential hypotheses.
+
+(imp (and (all x (imp (Wolf x) (animal x)))
+	  (all x (imp (Fox x) (animal x)))
+	  (all x (imp (Bird x) (animal x)))
+	  (all x (imp (Snail x) (animal x)))
+	  (all x (imp (Grain x) (plant x)))
+	  (exists x (Wolf x))
+	  (exists x (Fox x))
+	  (exists x (Bird x))
+	  (exists x (Snail x))
+	  (exists x (Grain x))
+	  (all x (all y (imp (and (Snail x) (Bird y)) (Smaller x y))))
+	  (all x (all y (imp (and (Bird x) (Fox y)) (Smaller x y))))
+       ;; (all x (all y (imp (and (Fox x) (Wolf y)) (Smaller x y))))
+	  (all x (imp (Snail x) (exists y (and (plant y) (eats x y)))))
+	  (all x (all y (imp (and (Wolf x) (Fox y)) (not (eats x y)))))
+	  (all x (all y (imp (and (Wolf x) (Grain y)) (not (eats x y)))))
+	  (all x (all y (imp (and (Bird x) (Snail y)) (not (eats x y)))))
+	  (all x (imp (animal x)
+		      (or (all y (imp (plant y) (eats x y)))
+			  (all z (imp (and (animal z)
+					   (Smaller z x)
+					   (exists u (and (plant u)
+							  (eats z u))))
+				      (eats x z)))))))
+
+     (exists x (exists y (and (animal x)
+			      (animal y)
+			      (eats x y)
+			      (all z (imp (grain z) (eats y z)))))))
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/test-all b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/test-all
new file mode 100755
index 0000000..1154a7a
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/examples/test-all
@@ -0,0 +1,20 @@
+#!/bin/csh
+
+if ($#argv != 1) then
+    echo "Need 1 arg: ivy or sivy script"
+    exit(1)
+endif
+
+$1 prove     cd-cn19             |& egrep "We are trying|has been|failed"
+$1 prove     comb-sk-w           |& egrep "We are trying|has been|failed"
+$1 model     comb-sw-not-weak    |& egrep "We are trying|has been|failed"
+$1 prove     group-comm          |& egrep "We are trying|has been|failed"
+$1 disprove  group-noncomm       |& egrep "We are trying|has been|failed"
+$1 model     group-noncomm-model |& egrep "We are trying|has been|failed"
+$1 prove     group-x2            |& egrep "We are trying|has been|failed"
+$1 refute    group-x2-refute     |& egrep "We are trying|has been|failed"
+$1 prove     lifsch              |& egrep "We are trying|has been|failed"
+$1 prove     steam               |& egrep "We are trying|has been|failed"
+$1 disprove  steam-x             |& egrep "We are trying|has been|failed"
+
+../util/checker otter-cn.output |& egrep "We are checking|have been|failed"
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/README b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/README
new file mode 100644
index 0000000..5e4cb6f
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/README
@@ -0,0 +1,5 @@
+This directory contains exercises from the chapter
+
+   Ivy: A Preprocessor and Proof Checker for First-order Logic
+
+and the solutions.
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/certify-all b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/certify-all
new file mode 100755
index 0000000..e5836dd
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/certify-all
@@ -0,0 +1,7 @@
+#!/bin/csh
+
+foreach i (solution*.lisp)
+	echo ""
+	echo "certifying $i ... "
+	../util/cert $i:r
+	end
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise1.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise1.lsp
new file mode 100644
index 0000000..cb7d993
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise1.lsp
@@ -0,0 +1,16 @@
+;; Exercise file to accompany 
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Startup file for exercise 1.
+;;
+;; Define a function to check whether a given variable occurs
+;; freely in a formula.  Prove that substitution for a variable
+;; that does not occur in the formula has no effect.
+
+;; All neccesary definitions are in:
+(include-book "../base")
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise2.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise2.lsp
new file mode 100644
index 0000000..0cb8388
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise2.lsp
@@ -0,0 +1,52 @@
+;; Exercise file to accompany 
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Startup file for exercise 2.
+;;
+;; Prove that if an interpretation contains a function func, 
+;; and if a formula does not contain the corresponding function 
+;; symbol, then evaluation of the formula in the interpretation is
+;; independent of the occurrence of func.  Assume that func
+;; is the first function in the interpretation.
+
+;; Note 1: the intent of this exercise is to foster a
+;; fuller understanding of the evaluation function. 
+;; We spare the reader from the tedious task of
+;; proving supporting lemmas by providing them in the
+;; following book:
+
+(include-book "../sk-misc-lemmas")
+
+;; Note 2: funcs-in-formula (f) computes the list of functions
+;; symbols that appear in f.  Its definition may be found in
+;; book wfftype.
+
+;; Hint: the following lemma might be useful:
+(defthm not-member-union-forward-right
+  (implies (not (member-equal x (union-equal a b)))
+           (not (member-equal x b)))
+  :rule-classes :forward-chaining)
+
+;; The exercise asks the reader to prove the following conjecture
+(defthm feval-with-useless-function
+  (implies (not (member-equal func (funcs-in-formula f)))
+	   (if flg
+	       (equal (feval f (list* (domain i) (relations i)
+				      (cons (cons func n) func)
+				      (functions i)))
+		      (feval f i ))
+	     (implies (and (domain-term-list (fringe dom))
+			   (wfquant f))
+		      (equal (feval-d f dom (list* (domain i) (relations i)
+						   (cons (cons func n) func)
+						   (functions i)))
+			     (feval-d f dom i))))) 
+  :rule-classes nil)
+
+
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise3.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise3.lsp
new file mode 100644
index 0000000..453a14b
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise3.lsp
@@ -0,0 +1,25 @@
+;; Exercise file to accompany 
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Startup file for exercise 3.
+;;
+;; Define a function cnf that converts negation normal form 
+;; formulas to conjunctive normal form and a predicate cnfp 
+;; that recognizes conjunctive normal form formulas.  Prove
+;; correctness of the conversion function.
+
+;; Note 1: See book nnf for the predicate nnfp, a recognizer of 
+;; in negation normal form.
+
+;; Note: to prove correctness in this case means to prove that cnf
+;; 	(1) preserves the property wff
+;;	(2) converts nnfp formulas to cnfp, and
+;;	(3) is sound.
+
+;; All neccesary definitions are in:
+(include-book "../wfftype")
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise4.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise4.lsp
new file mode 100644
index 0000000..5b94757
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise4.lsp
@@ -0,0 +1,32 @@
+;; Exercise file to accompany 
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Startup file for exercise 4.
+;;
+;; Define a resolution function that takes two formulas and
+;; two specifications of subformulas within the formulas,
+;; and computes a resolvent, if possible, of the two formulas
+;; on the specified literals.
+;;
+;; Prove that the function is sound.
+
+;; All neccesary definitions are in:
+(include-book "../base")
+
+;; Hint: the following lemma might be useful:
+(encapsulate 
+ nil
+ (local (include-book "../close"))
+ (defthm feval-alls-subset
+   (implies (and (var-set a)
+                 (var-set b)
+                 (subsetp-equal a b)
+                 (not (free-vars (alls a f))))
+            (equal (feval (alls a f) i)
+                   (feval (alls b f) i)))
+   :rule-classes nil)
+ )
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise5.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise5.lsp
new file mode 100644
index 0000000..903a611
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise5.lsp
@@ -0,0 +1,15 @@
+;; Exercise file to accompany 
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Startup file for exercise 5.
+;;
+;; Conjunctions and disjunctions are binary, which makes it inconvenient
+;; to write conjectures with several hypotheses.  Define a function 
+;; to convert a formula with multiple-arity conjunctions and
+;; disjunctions to a formula with binary conjunctions and disjunctions.
+;; Decide what properties have to be proved to demonstrate that your 
+;; approach is acceptable, and prove those properties.
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise6.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise6.lsp
new file mode 100644
index 0000000..c700e4b
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/exercise6.lsp
@@ -0,0 +1,21 @@
+;; Exercise file to accompany 
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Startup file for exercise 6.
+;;
+;; We rely on the ability to generate a new symbol with respect to a
+;; given symbol list in steps 2 and 3 of the search procedure.  In
+;; variable renaming, step 2, we generate a new variable.  In
+;; Skolemization, step 3, we generate a Skolem function name.  Common
+;; Lisp has a function gensym, but it is state dependent and therefore 
+;; not available in ACL2.  Define an ACL2 function that generates a 
+;; symbol that is not in a given list of symbols, and prove its 
+;; correctness.
+
+;; Hint: ACL2 defines functions "coerce" and 
+;; "intern-in-package-of-symbol."  See ACL2 documentation for more
+;; information.
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.lisp
new file mode 100644
index 0000000..0f353d5
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution1.lisp
@@ -0,0 +1,75 @@
+;; Exercise file to accompany
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Solution for exercise 1.
+;;
+;; Define a function to check whether a given variable occurs
+;; freely in a formula.  Prove that substitution for a variable
+;; that does not occur in the formula has no effect.
+
+(in-package "ACL2")
+
+;; All neccesary definitions are in:
+(include-book "../base")
+
+;; Function var-occurrence-term-list (x l) checks if list of
+;; terms l contains a variable x
+
+(defun var-occurrence-term-list (x l)
+  (declare (xargs :guard (and (variable-term x)
+                              (wft-list l))))
+  (if (atom l)
+      nil
+    (or (cond ((variable-term (car l)) (equal (car l) x))
+	      ((domain-term (car l)) nil)
+	      ((wf-ap-term-top (car l)) (var-occurrence-term-list x (cdar l)))
+	      (t nil))  ;; non-term
+	(var-occurrence-term-list x (cdr l)))))
+
+;; Function free-occurrence (x f) checks if formula f contains
+;; x as a free varible.
+
+(defun free-occurrence (x f)
+  (declare (xargs :guard (and (variable-term x) (wff f))))
+  (cond ((wfnot f) (free-occurrence x (a1 f)))
+        ((wfbinary f) (or (free-occurrence x (a1 f))
+                          (free-occurrence x (a2 f))))
+        ((wfquant f) (if (equal x (a1 f))
+                         nil
+                         (free-occurrence x (a2 f))))
+        ((wfatomtop f) (var-occurrence-term-list x (cdr f)))
+        (t nil)))
+
+
+;; supporting lemma, domain term is a natural number,
+;; and therefore not a cons pair
+(defthm domain-term-is-not-cons
+  (not (domain-term (cons x y)))
+  :hints (("Goal"
+           :in-theory (enable domain-term))))
+
+;; substitution in term list preserves occurrences of
+;; other variables in term list
+(defthm var-occurrence-subst
+  (implies (and (var-occurrence-term-list y l)
+                (not (equal x y)))
+           (var-occurrence-term-list y (subst-term-list l x tm)))
+  :hints (("Goal" :do-not generalize)))
+
+;; substitution in formula preserves occurrences of other
+;; free variables in formula
+(defthm free-subst
+  (implies (and (free-occurrence y f)
+                (not (equal x y)))
+           (free-occurrence y (subst-free f x tm))))
+
+
+
+
+
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.lisp
new file mode 100644
index 0000000..9b73688
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution2.lisp
@@ -0,0 +1,78 @@
+;; Exercise file to accompany
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Solution for exercise 2.
+;;
+;; Prove that if an interpretation contains a function func,
+;; and if a formula does not contain the corresponding function
+;; symbol, then evaluation of the formula in the interpretation is
+;; independent of the occurrence of func.  Assume that func
+;; is the first function in the interpretation.
+
+(in-package "ACL2")
+
+;; Note 1: the intent of this exercise is to foster a
+;; fuller understanding of the evaluation function.
+;; We spare the reader from the tedious task of
+;; proving supporting lemmas by providing them in the
+;; following book:
+
+(include-book "../sk-misc-lemmas")
+
+;; Note 2: funcs-in-formula (f) computes the list of functions
+;; symbols that appear in f.  Its definition may be found in
+;; book wfftype.
+
+;; Hint: the following lemma might be useful:
+(defthm not-member-union-forward-right
+  (implies (not (member-equal x (union-equal a b)))
+           (not (member-equal x b)))
+  :rule-classes :forward-chaining)
+
+;; ----------------------------------------------------------
+
+(defthm eval-term-list-with-useless-function
+  (implies (not (member-equal func (funcs-in-term-list l)))
+           (equal (eval-term-list l (list* i1 i3
+                                           (cons (cons func n) func)
+                                           i4))
+                  (eval-term-list l (list* i1 i3 i4))))
+  :hints (("Goal"
+           :in-theory (enable domain))))
+
+(defthm not-member-funcs-a
+  (implies (and (consp l)
+                (not (member-equal func (funcs-in-term-list l))))
+           (not (member-equal func (funcs-in-term-list (list (car l)))))))
+
+(defthm not-member-funcs-b
+  (implies (not (member-equal func (funcs-in-term-list (cons a l))))
+           (not (member-equal func (funcs-in-term-list (list a)))))
+  :hints (("Goal"
+         :use ((:instance not-member-funcs-a (l (cons a l)))))))
+
+;; The exercise asks the reader to prove the following conjecture
+(defthm feval-with-useless-function
+  (implies (not (member-equal func (funcs-in-formula f)))
+	   (if flg
+	       (equal (feval f (list* (domain i) (relations i)
+				      (cons (cons func n) func)
+				      (functions i)))
+		      (feval f i ))
+	     (implies (and (domain-term-list (fringe dom))
+			   (wfquant f))
+		      (equal (feval-d f dom (list* (domain i) (relations i)
+						   (cons (cons func n) func)
+						   (functions i)))
+			     (feval-d f dom i)))))
+  :hints (("Goal"
+	   :do-not generalize
+	   :in-theory (enable eval-atomic)
+	   :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.lisp
new file mode 100644
index 0000000..1bcbc0c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution3.lisp
@@ -0,0 +1,127 @@
+;; Exercise file to accompany
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Solution for exercise 3.
+;;
+;; Define a function cnf  that converts negation normal form
+;; formulas to conjunctive normal form and a predicate cnfp
+;; that recognizes conjunctive normal form formulas.  Prove
+;; correctness of the conversion function.
+
+;; Note 1: See book nnf for the predicate nnfp, a recognizer of
+;; in negation normal form.
+
+;; Note: to prove correctness in this case means to prove that cnf
+;; 	(1) preserves the property wff
+;;	(2) converts nnfp formulas to cnfp, and
+;;	(3) is sound.
+
+(in-package "ACL2")
+
+;; All neccesary definitions are in:
+(include-book "../wfftype")
+
+;; ------------------------------------------------
+;; CNF - conjunctive normal form
+
+(defun dist-or-and-2 (p q)
+  (declare (xargs :guard (and (wff p) (wff q))))
+  (if (wfand q)
+      (list 'and (dist-or-and-2 p (a1 q)) (dist-or-and-2 p (a2 q)))
+      (list 'or p q)))
+
+(defun dist-or-and (p q)
+  (declare (xargs :guard (and (wff p) (wff q))))
+  (if (wfand p)
+      (list 'and (dist-or-and (a1 p) q) (dist-or-and (a2 p) q))
+      (dist-or-and-2 p q)))
+
+(defthm dist-or-and-2-wff  ; helps verify guards for cnf below
+  (implies (and (wff p)
+		(wff q))
+	   (wff (dist-or-and-2 p q))))
+
+(defthm dist-or-and-wff    ; helps verify guards for cnf below
+  (implies (and (wff p)
+		(wff q))
+	   (wff (dist-or-and p q))))
+
+(defun cnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfbinary f)
+	 (cond ((equal (car f) 'and) (list 'and (cnf (a1 f)) (cnf (a2 f))))
+	       ((equal (car f) 'or) (dist-or-and (cnf (a1 f)) (cnf (a2 f))))
+	       (t f)))
+	((wfquant f) (list (car f) (a1 f) (cnf (a2 f))))
+	(t f)))
+
+;; Prove that cnf preserves well-formedness.
+
+(defthm cnf-wff
+  (implies (wff f)
+	   (wff (cnf f))))
+
+;; Prove that cnf rewrites an nnfp formula into cnfp.
+
+(defthm dist-or-and-2-cnfp
+  (implies (and (cnfp p)
+		(cnfp q)
+		(not (wfand p)))
+	   (cnfp (dist-or-and-2 p q))))
+
+(defthm dist-or-and-cnfp
+  (implies (and (cnfp p)
+		(cnfp q))
+	   (cnfp (dist-or-and p q))))
+
+(defthm cnf-cnfp
+  (implies (nnfp f)
+	   (cnfp (cnf f))))
+
+;;---------------------------------
+;; Soundness of CNF.
+
+(defthm subst-dist-dist-2
+  (equal (subst-free (dist-or-and-2 p q) x tm)
+	 (dist-or-and-2 (subst-free p x tm)
+			(subst-free q x tm))))
+
+(defthm subst-dist-dist
+  (equal (subst-free (dist-or-and p q) x tm)
+	 (dist-or-and (subst-free p x tm)
+		      (subst-free q x tm))))
+
+(defthm subst-cnf-commute
+  (equal (subst-free (cnf f) x tm)
+	 (cnf (subst-free f x tm))))
+
+(defthm dist-or-and-2-fsound
+  (equal (feval (dist-or-and-2 p q) i)
+	 (feval (list 'or p q) i)))
+
+(defthm dist-or-and-fsound
+  (equal (feval (dist-or-and p q) i)
+	 (feval (list 'or p q)  i)))
+
+(defthm cnf-fsound-flg
+  (if flg
+      (equal (feval (cnf f) i)
+	     (feval f i))
+      (implies (wfquant f)
+	       (equal (feval-d (cnf f) dom i)
+		      (feval-d f dom i))))
+  :hints (("Goal"
+	   :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm cnf-fsound
+  (equal (feval (cnf f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :by (:instance cnf-fsound-flg (flg t)))))
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.lisp
new file mode 100644
index 0000000..81de26d
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution4.lisp
@@ -0,0 +1,246 @@
+;; Exercise file to accompany
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Solution for exercise 4.
+;;
+;; The current proof checker for resolution steps generates all
+;; resolvents of the parent clauses and checks whether the clause from the
+;; proof object follows from the conjunction of all the resolvents.
+;; Define a proof-checking procedure that computes the specified
+;; resolvent directly.  Prove that the procedure is sound.
+
+(in-package "ACL2")
+
+;; All neccesary definitions are in:
+(include-book "../stage")
+(local (include-book "../../../../../../ordinals/e0-ordinal"))
+
+;; Hint: the following lemma might be useful:
+(encapsulate
+ nil
+ (local (include-book "../close"))
+ (defthm feval-alls-subset
+   (implies (and (var-set a)
+                 (var-set b)
+                 (subsetp-equal a b)
+                 (not (free-vars (alls a f))))
+            (equal (feval (alls a f) i)
+                   (feval (alls b f) i)))
+   :rule-classes nil)
+ )
+
+;; -------------- Resolution
+;; This is resolution on identical atoms; that is, no unification is
+;; involved.  The function (resolve f1 l1 f2 l2) computes the resolvent of
+;; f1 and f2 on literals specified in position lists l1 and l2.  If the
+;; specified literals (computed by literal-at-position) do not resolve,
+;; 'true is returned.
+;;
+;; We took a shortcut: the resolvent contains 'false literals
+;; corresponding to the resolved literals, and the resolvent is not right
+;; associated.  If you need nicer resolvents, you can apply functions
+;; right-assoc and simplify (defined elsewhere).
+
+(defun exists-literal-at-position (f l)
+  (declare (xargs :guard (and (wff f) (integer-listp l))))
+  (cond ((atom l) t)
+	((wfor f) (cond ((equal (car l) 1)
+			 (exists-literal-at-position (a1 f) (cdr l)))
+			((equal (car l) 2)
+			 (exists-literal-at-position (a2 f) (cdr l)))
+			(t nil)))
+	(t nil)))
+
+(defun literal-at-position (f l)
+  (declare (xargs :guard (and (wff f) (integer-listp l))))
+  (cond ((atom l) f)
+	((wfor f) (cond ((equal (car l) 1)
+			 (literal-at-position (a1 f) (cdr l)))
+			((equal (car l) 2)
+			 (literal-at-position (a2 f) (cdr l)))
+			(t nil)))
+	(t nil)))
+
+(defmacro complements (p q)
+  (list 'or
+	(list 'equal p (list 'list ''not q))
+        (list 'equal (list 'list ''not p) q)))
+
+(defun remove-literal (f l)
+  (declare (xargs :guard (and (wff f) (integer-listp l))))
+  (cond ((atom l) 'false)
+	((wfor f) (cond ((equal (car l) 1)
+			 (list 'or (remove-literal (a1 f) (cdr l)) (a2 f)))
+			((equal (car l) 2)
+			 (list 'or (a1 f) (remove-literal (a2 f) (cdr l))))
+			(t f)))
+	(t f)))
+
+(defthm remove-literal-wff
+  (implies (wff f)
+           (wff (remove-literal f pos))))
+
+(defun resolve (f1 l1 f2 l2)
+  (declare (xargs :guard (and (wff f1) (integer-listp l1)
+			      (wff f2) (integer-listp l2))))
+  (if (and (exists-literal-at-position f1 l1)
+	   (exists-literal-at-position f2 l2)
+	   (complements (literal-at-position f1 l1)
+			(literal-at-position f2 l2)))
+      (list 'or (remove-literal f1 l1) (remove-literal f2 l2))
+    'true))
+
+(defthm resolve-wff
+  (implies (and (wff par1)
+                (wff par2))
+           (wff (resolve par1 pos1 par2 pos2))))
+
+;;----------------------------------------------------------------------------
+;; Ground soundness of resolve
+;;
+
+(defthm remove-false-unit-gsound
+  (implies (and (exists-literal-at-position f pos)
+		(not (feval (literal-at-position f pos) i)))
+	   (equal (feval (remove-literal f pos) i)
+		  (feval f i))))
+
+(defthm resolve-ground-fsound-helper
+  (implies (and (feval f i)
+		(feval g i)
+		(exists-literal-at-position f pos1)
+		(exists-literal-at-position g pos2)
+		(complements (literal-at-position f pos1)
+			     (literal-at-position g pos2))
+		(not (feval (remove-literal f pos1) i)))
+	   (feval (remove-literal g pos2) i))
+  :hints (("goal" :induct (remove-literal f pos1))))
+
+(defthm resolve-ground-fsound
+  (implies (and (feval f i)
+		(feval g i))
+	   (feval (resolve f pos1 g pos2) i)))
+
+(in-theory (disable resolve-ground-fsound-helper))
+
+(in-theory (disable resolve))
+
+;;----------------------------------------------------------------------------
+;; Soundness of resolve under universal closure
+
+(defthm remove-literal-subst-free-commute
+  (equal (remove-literal (subst-free f x tm) l)
+	 (subst-free (remove-literal f l) x tm)))
+
+(defthm literal-at-position-subst-free-commute
+  (equal (literal-at-position (subst-free f x tm) l)
+	 (subst-free (literal-at-position f l) x tm)))
+
+(defthm exists-literal-at-position-subst
+  (implies (exists-literal-at-position f pos)
+	   (exists-literal-at-position (subst-free f x tm) pos)))
+
+;; Induction scheme for resolve-fsound-alls-aux
+
+(defun alls-i-2 (vars flg f g dom i)
+  (declare (xargs :guard (and (implies (not flg)
+                                       (domain-term-list (fringe dom)))
+                              (var-list vars)
+                              (wff f)
+			      (wff g))
+                  :measure (cons (cons (+ 1 (acl2-count vars))
+                                       (if flg 2 1))
+				 (acl2-count dom))))
+  (if flg
+      (if (atom vars)
+	  nil
+	  (alls-i-2 vars nil f g (domain i) i))
+      (if (atom vars)
+          nil
+	  (if (atom dom)
+              (alls-i-2 (cdr vars) t
+		      (subst-free f (car vars) dom)
+		      (subst-free g (car vars) dom)
+		      'junk i)
+              (cons (alls-i-2 vars nil f g (car dom) i)
+                    (alls-i-2 vars nil f g (cdr dom) i))))))
+
+
+;; Note: condition (**) below is added in the flg==nil case to avoid the
+;; inductive case
+;;
+;; (implies (and (feval-d f dom i)
+;;               (feval-d g dom i))
+;;          (feval-d (resolve f posf g posg) dom i))
+;;
+;; which does not hold.  We only use the feval part of this lemma.
+
+(defthm resolve-fsound-alls-aux
+  (implies (var-set vars)
+	   (if flg
+	       (implies (and (feval (alls vars f) i)
+			     (feval (alls vars g) i))
+			(feval (alls vars (resolve f posf g posg)) i))
+	       (implies (and (domain-term-list (fringe dom))
+                             (consp vars) ;; (**)
+			     (feval-d (alls vars f) dom i)
+			     (feval-d (alls vars g) dom i))
+			(feval-d (alls vars (resolve f posf g posg)) dom i))))
+  :hints (("Goal"
+	   :induct (alls-i-2 vars flg f g dom i))
+          ("Subgoal *1/3"
+	   :in-theory (enable resolve))
+          ("Subgoal *1/2"
+	   :in-theory (enable resolve)
+	   :expand (alls vars (list 'or
+				    (remove-literal f posf)
+				    (remove-literal g posg)))))
+  :rule-classes nil)
+
+(defthm resolve-fsound-alls
+  (implies (and (var-set vars)
+ 		(feval (alls vars f) i)
+		(feval (alls vars g) i))
+	   (feval (alls vars (resolve f posf g posg)) i))
+  :hints (("Goal" :by (:instance resolve-fsound-alls-aux (flg t)))))
+
+;;-----------------------------------------
+;; Main theorem
+
+(defthm resolve-fsound-closure
+  (implies (and (feval (universal-closure f) i)
+                (feval (universal-closure g) i))
+           (feval (universal-closure (resolve f l1 g l2)) i))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance
+		  feval-alls-subset
+		  (f f)
+		  (a (free-vars f))
+		  (b (union-equal
+		      (free-vars f)
+		      (union-equal (free-vars g)
+				   (free-vars (resolve f l1 g l2))))))
+                 (:instance
+		  feval-alls-subset
+		  (f g)
+		  (a (free-vars g))
+		  (b (union-equal
+		      (free-vars f)
+		      (union-equal (free-vars g)
+				   (free-vars (resolve f l1 g l2))))))
+                 (:instance
+		  feval-alls-subset
+		  (f (resolve f l1 g l2))
+		  (a (free-vars (resolve f l1 g l2)))
+		  (b (union-equal
+		      (free-vars f)
+		      (union-equal (free-vars g)
+				   (free-vars (resolve f l1 g l2))))))
+                 ))))
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.lisp
new file mode 100644
index 0000000..dd28d23
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution5.lisp
@@ -0,0 +1,341 @@
+;; Exercise file to accompany
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Solution for exercise 5.
+;;
+;; Conjunctions and disjunctions are binary, which makes it inconvenient
+;; to write conjectures with several hypotheses.  Define a function
+;; to convert a formula with multiple-arity conjunctions and
+;; disjunctions to a formula with binary conjunctions and disjunctions.
+;; Decide what properties have to be proved to demonstrate that your
+;; approach is acceptable, and prove those properties.
+
+(in-package "ACL2")
+
+;; We define a recognizer SWEET-WFF and functions UNSWEETEN
+;; and SWEETEN to translate between SWEET-WFF and WFF.
+;; I expect that sweet formulas will be used only for I/O.
+;; In order to prove that the translations give "equivalent" formulas
+;; we would have to define evaluation for sweet formulas;
+;; I don't see any other use for sweet-feval, so why bother?
+;;
+;; Sweetness is only for conjunctions and disjunctions.  Maybe we
+;; should sweeten quantified formulas as well, so we could write things
+;; like (all x y z (f)), (all x y exists z u all v (f)).
+;;
+;;  1. Define recognizer sweet-wff,
+;;  2. define functions sweeten and unsweeten,
+;;  3. prove that sweeten gives a sweet-wff,
+;;  4. prove that unsweeten gives a wff,
+;;  5. prove one of the invertibility statements:
+;;     (EQUAL (UNSWEETEN (SWEETEN F)) F)
+;;     (The other one won't hold.)
+;;  6. prove that sweetening a sweet-wff formula doesn't change it,
+;;  7. prove that unsweetening a wff doesn't change it.
+
+(include-book "../base")
+(local (include-book "../../../../../../ordinals/e0-ordinal"))
+(set-well-founded-relation e0-ord-<)
+
+;;------------------------------------------------------------
+;; A sweet-wff is like a wff, except that conjunctions and
+;; disjunctions can have any number (including 0 or 1) of arguments.
+;; The last argument of AND cannot be an AND formula.  However,
+;; other arguments of AND can be AND formulas.  When we sweeten
+;; formulas below, only the right branches will be sweetened.
+;; For example, (AND (AND a b) (AND c d)) becomes (AND (AND a b) c d).
+;;
+;; If you want more, you can use function right-assoc first.
+;;
+;; There is a tradeoff here.  I think the cleanest sweetening would
+;; change 'FALSE to '(OR) and 'TRUE to '(AND).  But 'FALSE
+;; is nicer than '(OR), and we have made it nice instead of clean.
+;;
+;; This means that (EQUAL (SWEETEN (UNSWEETEN F)) F) won't be a theorem,
+;; because (SWEETEN (UNSWEETEN '(OR))) will be 'FALSE.
+;;
+;; Even if 'FALSE sweetens to '(OR), there will be a problem with
+;; (EQUAL (SWEETEN (UNSWEETEN F)) F), because some simplification may
+;; occur.  For example, '(OR (A) FALSE) would sweeten to '(A).
+;; I think there is a theorem there if F is simplified in some ways.
+
+(defun swfand (p)  ;; sweet version of wfand
+  (declare (xargs :guard t))
+  (and (consp p) (equal (car p) 'and)))
+
+(defun swfor (p)  ;; sweet version of wfor
+  (declare (xargs :guard t))
+  (and (consp p) (equal (car p) 'or)))
+
+(mutual-recursion
+
+ (defun sweet-wff (f)
+   (declare (xargs :guard t))
+   (cond ((equal f 'true) t)
+	 ((equal f 'false) t)
+	 ((wfatom f) t)
+	 ((wfnot f) (sweet-wff (a1 f)))
+	 ((wfiff f) (and (sweet-wff (a1 f)) (sweet-wff (a2 f))))
+	 ((wfimp f) (and (sweet-wff (a1 f)) (sweet-wff (a2 f))))
+	 ((wfquant f) (sweet-wff (a2 f)))
+	 ((swfand f) (sweet-wff-list-and (cdr f)))
+	 ((swfor f)  (sweet-wff-list-or (cdr f)))
+	 (t nil)))
+
+ (defun sweet-wff-list-and (lst)  ;; last cannot be swfand
+   (declare (xargs :guard t))
+   (cond ((atom lst) (null lst))
+	 ((atom (cdr lst)) (and (null (cdr lst))
+				(not (swfand (car lst)))
+				(sweet-wff (car lst))))
+	 (t (and (sweet-wff (car lst))
+		 (sweet-wff-list-and (cdr lst))))))
+
+ (defun sweet-wff-list-or (lst)  ;; last cannot be swfor
+   (declare (xargs :guard t))
+   (cond ((atom lst) (null lst))
+	 ((atom (cdr lst)) (and (null (cdr lst))
+				(not (swfor (car lst)))
+				(sweet-wff (car lst))))
+	 (t (and (sweet-wff (car lst))
+		 (sweet-wff-list-or (cdr lst))))))
+ )
+
+;;--------------------------------------------------------------------
+;; Unsweeten takes a sweet-wff and returns a wff.
+
+(mutual-recursion
+
+ (defun unsweeten (f)
+   (declare (xargs :guard (sweet-wff f)
+		   :measure (acl2-count f)))
+   (cond ((wfnot f) (list 'not (unsweeten (a1 f))))
+	 ((wfbinary f) (list (car f) (unsweeten (a1 f)) (unsweeten (a2 f))))
+	 ((wfquant f) (list (car f) (a1 f) (unsweeten (a2 f))))
+	 ((swfand f) (unsweeten-and (cdr f)))
+	 ((swfor f)  (unsweeten-or  (cdr f)))
+	 (t f)))
+
+ (defun unsweeten-and (lst)
+   (declare (xargs :guard (sweet-wff-list-and lst)
+		   :measure (acl2-count lst)))
+   (cond ((atom lst) 'true)  ;; empty conjunction is 'true
+	 ((atom (cdr lst)) (unsweeten (car lst)))
+	 (t (list 'and
+		  (unsweeten (car lst))
+		  (unsweeten-and (cdr lst))))))
+
+ (defun unsweeten-or (lst)
+   (declare (xargs :guard (sweet-wff-list-or lst)
+		   :measure (acl2-count lst)))
+   (cond ((atom lst) 'false)  ;; empty disjunction is 'false
+	 ((atom (cdr lst)) (unsweeten (car lst)))
+	 (t (list 'or
+		  (unsweeten (car lst))
+		  (unsweeten-or (cdr lst))))))
+ )
+
+;;---------------------------------------------------------------
+;; This is an induction scheme that corresponds to sweet-wff and unsweeten.
+
+(defun unsweeten-i (flg x)
+  (declare (xargs :guard t))
+  (cond ((equal flg 'and) (cond ((atom x) 'junk)
+				((atom (cdr x)) (unsweeten-i 'wff (car x)))
+				(t (cons (unsweeten-i 'wff (car x))
+					 (unsweeten-i 'and (cdr x))))))
+	((equal flg 'or)  (cond ((atom x) 'junk)
+				((atom (cdr x)) (unsweeten-i 'wff (car x)))
+				(t (cons (unsweeten-i 'wff (car x))
+					 (unsweeten-i 'or (cdr x))))))
+	(t (cond ((wfnot x) (unsweeten-i t (a1 x)))
+		 ((wfbinary x) (cons (unsweeten-i t (a1 x))
+				     (unsweeten-i t (a2 x))))
+		 ((wfquant x) (unsweeten-i t (a2 x)))
+		 ((swfand x) (unsweeten-i 'and (cdr x)))
+		 ((swfor x)  (unsweeten-i 'or  (cdr x)))
+		 (t nil)))))
+
+;;------------------------------------------------------------------
+;; Prove that unsweetening a sweet-wff gives a wff.
+
+(defthm unsweeten-wff-flg
+  (cond ((equal flg 'and) (implies (sweet-wff-list-and x)
+				   (wff (unsweeten-and x))))
+	((equal flg 'or)  (implies (sweet-wff-list-or x)
+				   (wff (unsweeten-or x))))
+	(t (implies (sweet-wff x)
+		    (wff (unsweeten x)))))
+  :hints (("Goal"
+	   :induct (unsweeten-i flg x)))
+  :rule-classes nil)
+
+(defthm unsweeten-wff
+  (implies (sweet-wff x)
+	   (wff (unsweeten x)))
+  :hints (("Goal"
+	   :by (:instance unsweeten-wff-flg (flg 'junk)))))
+
+;;---------------------------------------------------------------
+;; Now, we sweeten formulas.  As far as I can see now, this will
+;; only be used for printing formulas.  (The measure is complicated,
+;; because sometimes the argument doesn't get smaller.)
+;;
+;; Note that only right associated conjunctions and disjunctions
+;; are sweetened.  If you want more, you can use function
+;; right-assoc first.
+
+(mutual-recursion
+
+ (defun sweeten (f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f)) 0)))
+   (cond ;; ((equal f 'true)  (list 'and))
+	 ;; ((equal f 'false) (list 'or))
+         ((wfnot f) (list 'not (sweeten (a1 f))))
+	 ((wfquant f) (list (car f) (a1 f) (sweeten (a2 f))))
+	 ((wfand f) (list* 'and (sweeten (a1 f)) (sweeten-and (a2 f))))
+	 ((wfor f) (list* 'or (sweeten (a1 f)) (sweeten-or (a2 f))))
+	 ((wfbinary f) (list (car f) (sweeten (a1 f)) (sweeten (a2 f))))
+	 (t f)))
+
+ (defun sweeten-and (f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f)) 1)))
+   (cond ;; ((equal f 'true) nil)
+         ((not (wfand f)) (list (sweeten f)))
+	 (t (cons (sweeten (a1 f)) (sweeten-and (a2 f))))))
+
+ (defun sweeten-or (f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f)) 1)))
+   (cond ;; ((equal f 'false) nil)
+         ((not (wfor f)) (list (sweeten f)))
+	 (t (cons (sweeten (a1 f)) (sweeten-or (a2 f))))))
+ )
+
+;;------------------------------------------------------------
+;; Now prove that sweeten gives a sweet formula.
+;;
+;; First, another induction scheme, corresponding to
+;; sweeten/sweeten-and/sweeten-or.
+
+(defun sweeten-i (flg f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f))
+				  (if (or (equal flg 'and)
+					  (equal flg 'or)) 1 0))))
+   (cond ((equal flg 'and) (cond ;; ((equal f 'true) 'junk)
+				 ((not (wfand f)) (sweeten-i 'wff f))
+				 (t (cons (sweeten-i 'wff (a1 f))
+					  (sweeten-i 'and (a2 f))))))
+	 ((equal flg 'or)  (cond ;; ((equal f 'false) 'junk)
+				 ((not (wfor f)) (sweeten-i 'wff f))
+				 (t (cons (sweeten-i 'wff (a1 f))
+					  (sweeten-i 'or (a2 f))))))
+	 (t (cond ((wfnot f) (sweeten-i 'wff (a1 f)))
+		  ((wfquant f) (sweeten-i 'wff (a2 f)))
+		  ((wfand f) (cons (sweeten-i 'wff (a1 f))
+				   (sweeten-i 'and (a2 f))))
+		  ((wfor f)  (cons (sweeten-i 'wff (a1 f))
+				   (sweeten-i 'or (a2 f))))
+		  ((wfbinary f) (cons (sweeten-i 'wff (a1 f))
+				      (sweeten-i 'wff (a2 f))))
+		  (t 'junk)))))
+
+;;----------------------------------------------------------------------
+;; Prove that sweetening a wff gives a sweet-wff.
+
+(defthm sweeten-car-flg
+  (equal (car (sweeten f)) (car f))
+  :hints (("Goal"
+	   :induct (sweeten-i flg f))))
+
+(defthm sweeten-wff-flg
+  (cond ((equal flg 'and) (implies (wff x)
+				   (sweet-wff-list-and (sweeten-and x))))
+	((equal flg 'or)  (implies (wff x)
+				   (sweet-wff-list-or (sweeten-or x))))
+	(t (implies (wff x)
+		    (sweet-wff (sweeten x)))))
+  :hints (("Goal"
+	   :induct (sweeten-i flg x)))
+  :rule-classes nil)
+
+(defthm sweeten-wff
+  (implies (wff x)
+	   (sweet-wff (sweeten x)))
+  :hints (("Goal"
+	   :by (:instance sweeten-wff-flg (flg 'junk)))))
+
+;;----------------------------------------------------------
+;; An invertibility theorem.
+
+(defthm unsweeten-sweeten-flg
+  (implies (wff f)
+	   (cond ((equal flg 'and) (equal (unsweeten-and (sweeten-and f)) f))
+		 ((equal flg 'or)  (equal (unsweeten-or (sweeten-or f)) f))
+		 (t (equal (unsweeten (sweeten f)) f))))
+  :hints (("Goal"
+	   :induct (sweeten-i flg f)))
+  :rule-classes nil)
+
+(defthm unsweeten-sweeten
+  (implies (wff f)
+	   (equal (unsweeten (sweeten f)) f))
+  :hints (("Goal"
+           :by (:instance unsweeten-sweeten-flg (flg 'junk)))))
+
+;;----------------------------------------------------------
+;; The other invertibility statement
+;;
+;; (defthm sweeten-unsweeten
+;;   (implies (sweet-wff f)
+;;            (equal (sweeten (unsweeten f)) f)))
+;;
+;; is not a theorem.  See comments at the beginning.
+
+;;---------------------------------------------------------------
+;; What happens if we unsweeten an ordinary wff?
+
+(defthm unsweeten-ordinary-wff
+  (implies (wff f)
+	   (equal (unsweeten f) f)))
+
+;; What if we sweeten a sweet formula?
+
+(defthm sweeten-sweet-wff-flg
+  (cond ((equal flg 'and) (implies (and (sweet-wff x)
+					(not (wfand x)))
+				   (equal (sweeten-and x) (list x))))
+	((equal flg 'or)  (implies (and (sweet-wff x)
+					(not (wfor x)))
+				   (equal (sweeten-or x) (list x))))
+	(t (implies (sweet-wff x)
+		    (equal (sweeten x) x))))
+  :hints (("Goal"
+	   :induct (sweeten-i flg x)))
+  :rule-classes nil)
+
+(defthm sweeten-sweet-wff
+  (implies (sweet-wff x)
+	   (equal (sweeten x) x))
+  :hints (("Goal"
+	   :by (:instance sweeten-sweet-wff-flg (flg 'junk)))))
+
+;; The following idempotence theorems are now trivial consequences.
+
+(defthm sweeten-idempotent
+  (implies (wff f)
+	   (equal (sweeten (sweeten f))
+		  (sweeten f))))
+
+(defthm unsweeten-idempotent
+  (implies (sweet-wff f)
+	   (equal (unsweeten (unsweeten f))
+		  (unsweeten f))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.lisp
new file mode 100644
index 0000000..dcbdfbe
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/exercises/solution6.lisp
@@ -0,0 +1,222 @@
+;; Exercise file to accompany
+;;
+;; Ivy: A Preprocessor and Proof Checker for First-order Logic
+;;
+;; William McCune (mccune@mcs.anl.gov)
+;; Olga Shumsky (shumsky@ece.nwu.edu)
+;;
+;; Solution for exercise 6.
+;;
+;; We rely on the ability to generate a new symbol with respect to a
+;; given symbol list in steps 2 and 3 of the search procedure.  In
+;; variable renaming, step 2, we generate a new variable.  In
+;; Skolemization, step 3, we generate a Skolem function name.  Common
+;; Lisp has a function gensym, but it is state dependent and therefore
+;; not available in ACL2.  Define an ACL2 function that generates a
+;; symbol that is not in a given list of symbols, and prove its
+;; correctness.
+
+;; Hint: ACL2 defines functions "coerce" and
+;; "intern-in-package-of-symbol."  See ACL2 documentation for more
+;; information.
+
+(in-package "ACL2")
+
+;; We assume that there is a list of symbols whose names are
+;; "l...ld...d" where l=letter, d=digit.  The string of d's in the
+;; symbol name is called an index.  If there is something other than
+;; a digit to the right of the leftmost digit in the symbol name,
+;; that character is ignored.   For example,
+;;
+;;        index of v12x3 = 123.
+;;
+;; How this works:  We used several functions suggested by
+;; Matt Kaufmann's functions.  If there is a list of characters that
+;; represents an integer the functions generate the list of characters
+;; that represents the successor of that integer.
+;;
+;; Given a list of symbols, we compute the index that represents the
+;; largest integer.  Gen-sym produces a symbol whose index is a
+;; successor to that integer.
+
+(defun next-int-char (char)
+  (declare (xargs :guard t))
+  (case char
+      (#\1 (mv #\2 nil))
+      (#\2 (mv #\3 nil))
+      (#\3 (mv #\4 nil))
+      (#\4 (mv #\5 nil))
+      (#\5 (mv #\6 nil))
+      (#\6 (mv #\7 nil))
+      (#\7 (mv #\8 nil))
+      (#\8 (mv #\9 nil))
+      (#\9 (mv #\0 t))
+      (otherwise ;; treat as #\0
+       (mv #\1 nil))))
+
+(defun next-int-char-list (chars)
+  (declare (xargs :guard t))
+  (if (atom chars)
+      (mv nil t)
+    (mv-let (next-chars carryp1)
+            (next-int-char-list (cdr chars))
+            (if carryp1
+                (mv-let (c carryp2)
+                        (next-int-char (car chars))
+                        (mv (cons c next-chars) carryp2))
+              (mv (cons (car chars) next-chars) nil)))))
+
+(defun int-char-listp (chars)
+  (declare (xargs :guard t))
+  (if (atom chars)
+      (null chars)
+    (and (member (car chars)
+                 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+         (int-char-listp (cdr chars)))))
+
+(defthm next-char-list-gives-charlist
+  (implies (character-listp x)
+	   (character-listp (car (next-int-char-list x)))))
+
+(defun charlist< (i1 i2)
+  (declare (xargs :guard (and (character-listp i1) (character-listp i2))))
+  (cond ((atom i2) nil)
+	((atom i1) t)
+	((> (len i1) (len i2)) nil)
+	((< (len i1) (len i2)) t)
+	(t (cond ((char< (car i1) (car i2)) t)
+		 ((char> (car i1) (car i2)) nil)
+		 (t (charlist< (cdr i1) (cdr i2)))))))
+
+(defun next-int-char-list-actual (chars)
+  (declare (xargs :guard t))
+  (mv-let (next carryp)
+          (next-int-char-list chars)
+          (if carryp
+              (cons #\1 next)
+            next)))
+
+(defthm carry-char-list
+  (implies (character-listp x)
+	   (character-listp (cons #\1 x))))
+
+(defthm next-char-list-actual-gives-charlist
+  (implies (character-listp x)
+	   (character-listp (next-int-char-list-actual x))))
+
+(defthm carry-int-char-list
+  (implies (int-char-listp x)
+	   (int-char-listp (cons #\1 x))))
+
+(defthm next-char-list-len
+  (equal (len (car (next-int-char-list x)))
+	 (len x)))
+
+(defthm next-char-list-actual-gives-greater-list
+  (implies (int-char-listp x)
+	   (charlist< x (next-int-char-list-actual x)))
+  :otf-flg t)
+
+(defun index (l)
+  (declare (xargs :guard (character-listp l)))
+  (cond ((atom l) nil)
+	((member (car l) '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+	 (cons (car l) (index (cdr l))))
+	(t (index (cdr l)))))
+
+(defthm index-gives-int-char-list
+  (int-char-listp (index l)))
+
+(defthm index-gives-charlist
+  (character-listp (index l)))
+
+(defun charlist-max (i1 i2)
+  (declare (xargs :guard (and (character-listp i1) (character-listp i2))))
+  (if (charlist< i1 i2) i2 i1))
+
+(defun max-index (l)
+  (declare (xargs :guard (symbol-listp l)))
+  (if (atom l)
+      nil
+      (charlist-max (index (coerce (symbol-name (car l)) 'list))
+		    (max-index (cdr l)))))
+
+(local (defthm greater-index-symbol-not-in-list ;; does 3 inductions
+	 (implies (and (symbolp sym)
+		       (charlist< (max-index l)
+				  (index (coerce (symbol-name sym) 'list))))
+		  (not (member-equal sym l)))))
+
+(defun gen-sym (sym l)
+  (declare (xargs :guard (and (symbolp sym)
+			      (character-listp l))))
+  (intern-in-package-of-symbol
+   (coerce (append (coerce (symbol-name sym) 'list)
+		   (next-int-char-list-actual l)) 'string)
+   sym))
+
+(defthm consp-index-append
+  (implies (and (character-listp x)
+		(character-listp y))
+	   (equal (index (append x y))
+		  (append (index x) (index y)))))
+
+(defthm charlist<-append
+  (implies (and (character-listp prefix)
+		(character-listp y)
+		(charlist< x y))
+	   (charlist< x (append prefix y)))
+  :hints (("Goal"
+	   :do-not generalize
+	   ;; When we went from ACL2-v2.3 to 2.4, we had to include the
+	   ;; following expand hints.  On the plus side, this reduced
+	   ;; the number of inductions from 7 to 1.
+	   :expand ((charlist< x (cons (car prefix) (append (cdr prefix) y)))
+		    (charlist< x (append prefix2 y))
+		    )
+	   )))
+
+(defthm intchar-list-next-index
+  (implies (int-char-listp l)
+	   (equal (index (next-int-char-list-actual l))
+		  (next-int-char-list-actual l))))
+
+(defthm max-index-lessthan-gensym-index
+  (implies (symbolp sym)
+	   (charlist<
+	    (max-index l)
+	    (index (coerce (symbol-name (gen-sym sym (max-index l))) 'list))))
+  :hints (("Goal" :do-not generalize
+	   :in-theory (disable next-int-char-list-actual))))
+
+;; top-level gensym: make a symbol (with a prefix sym)
+;; that does not occur in the given list l
+
+(defun gen-symbol (sym l)
+  (declare (xargs :guard (and (symbolp sym)
+			      (symbol-listp l))))
+  (gen-sym sym (max-index l)))
+
+;; Main theorem, gen-symbol really makes a NEW symbol
+
+(defthm new-symbol-not-in-list
+  (implies (symbolp sym)
+	   (not (member-equal (gen-symbol sym l) l)))
+  :hints (("Goal" :in-theory (disable gen-sym))))
+
+(in-theory (disable gen-symbol))
+
+;; a few examples
+;; (gen-symbol 'v nil) ;; => v1
+;; (gen-symbol 'v2- '(x1 v23 y1 x10)) ;; => v2-24
+;; (gen-symbol 'v '(x12 v99)) ;; => v100
+;; (gen-symbol 'v2 '(x1x3 x10)) ;; => v214
+
+
+
+
+
+
+
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/flip.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/flip.lisp
new file mode 100644
index 0000000..72f0d6c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/flip.lisp
@@ -0,0 +1,85 @@
+(in-package "ACL2")
+
+;; This book is for the proof rule "flip" which swaps the
+;; arguments of an equality (positive or negative).  For
+;; negated equalities, the position can point to either
+;; the 'not node or to the equality.
+
+(include-book "paramod")
+
+(defun flip-eq (f pos)
+  (declare (xargs :guard (and (wff f) (integer-listp pos))))
+  (cond ((atom pos) (cond ((wfeq f) (list (car f) (a2 f) (a1 f)))
+			  ;; also allow pos to point at negated equality
+			  ((and (wfnot f)
+				(wfeq (a1 f)))
+			   (list 'not (list (car (a1 f))
+					    (a2 (a1 f))
+					    (a1 (a1 f)))))
+			  (t f)))
+
+	((wfnot f) (if (equal (car pos) 1)
+		       (list 'not (flip-eq (a1 f) (cdr pos)))
+		       f))
+
+	((wfbinary f) (cond ((equal (car pos) 1)
+			     (list (car f)
+				   (flip-eq (a1 f) (cdr pos))
+				   (a2 f)))
+			    ((equal (car pos) 2)
+			     (list (car f)
+				   (a1 f)
+				   (flip-eq (a2 f) (cdr pos))))
+			    (t f)))
+
+	(t f)))
+
+(defthm flip-eq-xsound
+  (equal (xeval (flip-eq f pos) dom i)
+	 (xeval f dom i))
+  :hints (("Goal"
+	   :in-theory (enable eval-atomic)
+	   :induct (flip-eq f pos))))
+
+(defthm flip-eq-subst-commute
+  (equal (subst-free (flip-eq f pos) x tm)
+	 (flip-eq (subst-free f x tm) pos)))
+
+(defthm flipeq-xsound-alls
+  (implies (var-set vars)
+	   (equal (xeval (alls vars (flip-eq f pos)) dom i)
+		  (xeval (alls vars f) dom i)))
+  :hints (("Goal"
+	   :expand ((alls vars f))
+	   :induct (var-induct vars f dom i))))
+
+
+;;-----------------------------
+;; Now, get it in terms of universal-closure.
+
+(encapsulate
+ nil
+ (local (include-book "close"))
+ (defthm xeval-alls-subset
+   (implies (and (var-set a)
+		 (var-set b)
+		 (subsetp-equal a b)
+		 (not (free-vars (alls a f))))
+	    (equal (xeval (alls a f) (domain i) i)
+		   (xeval (alls b f) (domain i) i)))
+   :rule-classes nil)
+ )
+
+(defthm flip-eq-subset-vars
+  (subsetp-equal (free-vars (flip-eq f pos)) (free-vars f)))
+
+(defthm flip-eq-xsound-closure
+  (equal (xeval (universal-closure (flip-eq f pos)) (domain i) i)
+	 (xeval (universal-closure f) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance xeval-alls-subset
+			    (f (flip-eq f pos))
+			    (a (free-vars (flip-eq f pos)))
+			    (b (free-vars f)))
+		 ))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.lisp
new file mode 100644
index 0000000..4bd6b41
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/gensym-e.lisp
@@ -0,0 +1,199 @@
+(in-package "ACL2")
+
+;; This file deals with generation of a new symbol.  I assume that
+;; there is a list of symbols whose names are "l...ld...d" where l=letter,
+;; d=digit.  The string of d's in the symbol name is called an index.
+;; If there is something other than a digit to the right of the leftmost
+;; digit in the symbol name, that character is ignored.   For example,
+;; index of v12x3 = 123.
+;;
+;; How this works:  I used Matt Kaufmann's functions.  He assumed that
+;; we have a list of characters that represents an integer.  His functions
+;; generate the list of character that represent the successor of that
+;; integer.
+;;
+;; Given a list of symbols, I compute the index that represents the
+;; largest integer.  Gen-sym produces a symbol whose index is a
+;; successor to that integer.
+
+(defun next-int-char (char)
+  (declare (xargs :guard t))
+  (case char
+      (#\1 (mv #\2 nil))
+      (#\2 (mv #\3 nil))
+      (#\3 (mv #\4 nil))
+      (#\4 (mv #\5 nil))
+      (#\5 (mv #\6 nil))
+      (#\6 (mv #\7 nil))
+      (#\7 (mv #\8 nil))
+      (#\8 (mv #\9 nil))
+      (#\9 (mv #\0 t))
+      (otherwise ;; treat as #\0
+       (mv #\1 nil))))
+
+(defun next-int-char-list (chars)
+  (declare (xargs :guard t))
+  (if (atom chars)
+      (mv nil t)
+    (mv-let (next-chars carryp1)
+            (next-int-char-list (cdr chars))
+            (if carryp1
+                (mv-let (c carryp2)
+                        (next-int-char (car chars))
+                        (mv (cons c next-chars) carryp2))
+              (mv (cons (car chars) next-chars) nil)))))
+
+(defun int-char-listp (chars)
+  (declare (xargs :guard t))
+  (if (atom chars)
+      (null chars)
+    (and (member (car chars)
+                 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+         (int-char-listp (cdr chars)))))
+
+(defthm next-char-list-gives-charlist
+  (implies (character-listp x)
+	   (character-listp (car (next-int-char-list x)))))
+
+(defun charlist< (i1 i2)
+  (declare (xargs :guard (and (character-listp i1) (character-listp i2))))
+  (cond ((atom i2) nil)
+	((atom i1) t)
+	((> (len i1) (len i2)) nil)
+	((< (len i1) (len i2)) t)
+	(t (cond ((char< (car i1) (car i2)) t)
+		 ((char> (car i1) (car i2)) nil)
+		 (t (charlist< (cdr i1) (cdr i2)))))))
+
+(defun next-int-char-list-actual (chars)
+  (declare (xargs :guard t))
+  (mv-let (next carryp)
+          (next-int-char-list chars)
+          (if carryp
+              (cons #\1 next)
+            next)))
+
+(defthm carry-char-list
+  (implies (character-listp x)
+	   (character-listp (cons #\1 x))))
+
+(defthm next-char-list-actual-gives-charlist
+  (implies (character-listp x)
+	   (character-listp (next-int-char-list-actual x))))
+
+(defthm carry-int-char-list
+  (implies (int-char-listp x)
+	   (int-char-listp (cons #\1 x))))
+
+(defthm next-char-list-len
+  (equal (len (car (next-int-char-list x)))
+	 (len x)))
+
+(defthm next-char-list-actual-gives-greater-list
+  (implies (int-char-listp x)
+	   (charlist< x (next-int-char-list-actual x)))
+  :otf-flg t)
+
+(defun index (l)
+  (declare (xargs :guard (character-listp l)))
+  (cond ((atom l) nil)
+	((member (car l) '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+	 (cons (car l) (index (cdr l))))
+	(t (index (cdr l)))))
+
+(defthm index-gives-int-char-list
+  (int-char-listp (index l)))
+
+(defthm index-gives-charlist
+  (character-listp (index l)))
+
+(defun charlist-max (i1 i2)
+  (declare (xargs :guard (and (character-listp i1) (character-listp i2))))
+  (if (charlist< i1 i2) i2 i1))
+
+(defun max-index (l)
+  (declare (xargs :guard (symbol-listp l)))
+  (if (atom l)
+      nil
+      (charlist-max (index (coerce (symbol-name (car l)) 'list))
+		    (max-index (cdr l)))))
+
+(local (defthm greater-index-symbol-not-in-list ;; does 3 inductions
+	 (implies (and (symbolp sym)
+		       (charlist< (max-index l)
+				  (index (coerce (symbol-name sym) 'list))))
+		  (not (member-equal sym l)))))
+
+(defun gen-sym (sym l)
+  (declare (xargs :guard (and (symbolp sym)
+			      (character-listp l))))
+  (intern-in-package-of-symbol
+   (coerce (append (coerce (symbol-name sym) 'list)
+		   (next-int-char-list-actual l)) 'string)
+   sym))
+
+(defthm consp-index-append
+  (implies (and (character-listp x)
+		(character-listp y))
+	   (equal (index (append x y))
+		  (append (index x) (index y)))))
+
+(defthm charlist<-append
+  (implies (and (character-listp prefix)
+		(character-listp y)
+		(charlist< x y))
+	   (charlist< x (append prefix y)))
+  :hints (("Goal"
+	   :do-not generalize
+	   ;; When we went from ACL2-v2.3 to 2.4, we had to include the
+	   ;; following expand hints.  On the plus side, this reduced
+	   ;; the number of inductions from 7 to 1.
+	   :expand ((charlist< x (cons (car prefix) (append (cdr prefix) y)))
+		    (charlist< x (append prefix2 y))
+		    )
+	   )))
+
+(defthm intchar-list-next-index
+  (implies (int-char-listp l)
+	   (equal (index (next-int-char-list-actual l))
+		  (next-int-char-list-actual l))))
+
+(defthm max-index-lessthan-gensym-index
+  (implies (symbolp sym)
+	   (charlist<
+	    (max-index l)
+	    (index (coerce (symbol-name (gen-sym sym (max-index l))) 'list))))
+  :hints (("Goal" :do-not generalize
+	   :in-theory (disable next-int-char-list-actual))))
+
+;; top-level gensym: make a symbol (with a prefix sym)
+;; that does not occur in the given list l
+
+(defun gen-symbol (sym l)
+  (declare (xargs :guard (and (symbolp sym)
+			      (symbol-listp l))))
+  (gen-sym sym (max-index l)))
+
+;; Main theorem, gen-symbol really makes a NEW symbol
+
+(defthm new-symbol-not-in-list
+  (implies (symbolp sym)
+	   (not (member-equal (gen-symbol sym l) l)))
+  :hints (("Goal" :in-theory (disable gen-sym))))
+
+(in-theory (disable gen-symbol))
+
+;; a few examples
+;; (gen-symbol 'v nil) ;; => v1
+;; (gen-symbol 'v2- '(x1 v23 y1 x10)) ;; => v2-24
+;; (gen-symbol 'v '(x12 v99)) ;; => v100
+;; (gen-symbol 'v2 '(x1x3 x10)) ;; => v214
+
+
+
+
+
+
+
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.lisp
new file mode 100644
index 0000000..94ddf7f
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/instance-closure.lisp
@@ -0,0 +1,580 @@
+(in-package "ACL2")
+
+;; The main event of this book is the last event,
+;; instance-xsound-for-1-substitution, which says that
+;; if the universal closure of a quantifier-free formula f
+;; is true in some intepretation, and we substitute a
+;; (not necessarily ground) term for a variable, then
+;; the universal closure of the result is true in the
+;; interpretation.
+
+(include-book "instance")
+(include-book "../../../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+;;-------------
+;; If the formula is quantifier-free, the domain argument is irrelevant.
+
+(defthm quant-free-xeval
+  (implies (quantifier-free f)
+           (equal (xeval f dom1 i)
+                  (xeval f dom2 i)))
+  :hints (("Goal"
+	   :induct (quantifier-free f)))
+  :rule-classes nil)
+
+(defthm not-free-xeval-same
+  (implies (and (variable-term x)
+		(not (member-equal x (free-vars f))))
+           (equal (xeval (list 'all x f) dom i)
+                  (xeval f (domain i) i)))
+  :hints (("Goal"
+           :induct (dom-i dom))
+	  ("Subgoal *1/1"
+	   :in-theory (enable not-free-not-change-2)))
+  :rule-classes nil)
+
+;;------------------
+
+(defthm subst-flip-fix-quant-free
+  (implies (and (quantifier-free f)
+		(not (equal x y))
+		(domain-term e))
+	   (equal (subst-free (subst-free f x e) y (subst-term tm x e))
+		  (subst-free (subst-free f y tm) x e))))
+
+;;------------- for case 1.5 (base instance-ground)
+
+(defthm union-15
+  (implies (union-equal a nil)
+	   (union-equal a b)))
+
+(defthm member-vars-subst
+  (implies (and (member-equal x (vars-in-term-list l))
+		(vars-in-term-list (list tm)))
+	   (vars-in-term-list (subst-term-list l x tm))))
+
+(defthm member-vars-subst-free
+  (implies (and (vars-in-term-list (list tm))
+		(quantifier-free f)
+		(member-equal x (free-vars f)))
+	   (free-vars (subst-free f x tm))))
+
+;;-----------------------  Part 1
+;;
+;; Now get theorem instance-xsound-ground into a slightly different form.
+;; Note the (quantifier-free f) constraint (see note on thm
+;; instance-gxsound-alls-1 below).
+;; This is for the base case of theorem instance-xsound-alls-1 below.
+
+(in-theory (enable not-free-not-change-2))
+
+(local (defthm case-1-5
+  (implies (and (domain-term-list (fringe dom))
+		(quantifier-free f)
+		(variable-term x)
+		(not (remove-equal x (free-vars f)))
+		(not (free-vars (subst-free f x tm)))
+		(xeval (list 'all x f) (domain i) i))
+	   (xeval (subst-free f x tm) dom i))
+  :hints (("goal"
+	   :do-not-induct t
+	   :in-theory (disable instance-term-sound member-vars-subst-free)
+	   :use ((:instance instance-term-sound)
+		 (:instance member-vars-subst-free)
+		 (:instance quant-free-xeval
+			    (f (subst-free f x tm))
+			    (dom1 dom)
+			    (dom2 (domain i)))
+		 (:instance not-free-xeval-same
+			    (dom (domain i))))
+	   ))))
+
+(in-theory (disable not-free-not-change-2))
+
+;;------------------  for case 1.3 and 1.1
+
+(defthm x-diff-y-x-only-member-not-member-y
+  (implies (and (not (equal x y))
+		(not (remove-equal x a)))
+	   (not (member-equal y a)))
+  :rule-classes nil)
+
+;;------------------ for case 1.4
+
+(defthm subst-alls-commute-backward
+  (implies (and (not (member-equal x vars))
+                (var-list vars))
+           (equal (alls vars (subst-free f x e))
+		  (subst-free (alls vars f) x e)))
+  :rule-classes nil)
+
+(defthm not-free-vars-alls-subst-free
+  (implies (and (var-set v2)
+		(variable-term v1)
+		(not (member-equal v1 v2))
+		(not (remove-equal v1 (free-vars (alls v2 g))))
+		(domain-term e))
+	   (not (free-vars (alls v2 (subst-free g v1 e)))))
+  :hints (("Goal"
+	   :in-theory (disable subst-alls-commute vars-alls-free)
+	   :use ((:instance subst-alls-commute-backward
+			    (x v1) (vars v2) (f g))
+		 (:instance vars-alls-free
+			    (x v1) (f (alls v2 g))))
+	   :do-not-induct t)))
+
+;;------------------------ for a case
+
+(in-theory (enable not-free-not-change-2))
+
+(defthm flip-only-diff
+  (implies (and (quantifier-free f)
+		(domain-term e)
+		(not (remove-equal y (free-vars f)))
+		(not (equal x y))
+		)
+	   (equal (subst-free f y (subst-term tm x e))
+		  (subst-free (subst-free f y tm) x e)))
+  :hints (("Goal"
+         :do-not-induct t
+	 :in-theory (disable subst-flip-fix-quant-free)
+	 :use ((:instance subst-flip-fix-quant-free)
+	       (:instance x-diff-y-x-only-member-not-member-y
+			  (x y) (y x) (a (free-vars f))))))
+  :rule-classes nil)
+
+(in-theory (disable not-free-not-change-2))
+
+(defthm flip-same-term-list
+  (implies (domain-term e)
+	   (equal (subst-term-list f2 x (car (subst-term-list (list tm) x e)))
+		  (subst-term-list (subst-term-list f2 x tm) x e))))
+
+(defthm flip-only-same
+  (implies (and (quantifier-free f)
+		(domain-term e))
+	   (equal (subst-free f x (subst-term tm x e))
+		  (subst-free (subst-free f x tm) x e)))
+  :rule-classes nil)
+
+(defthm flip-only
+  (implies (and (quantifier-free f)
+		(domain-term e)
+		(not (remove-equal y (free-vars f))))
+	   (equal (subst-free f y (subst-term tm x e))
+		  (subst-free (subst-free f y tm) x e)))
+  :hints (("Goal"
+         :do-not-induct t
+	 :use ((:instance flip-only-diff)
+	       (:instance flip-only-same)))))
+
+;;------------------------
+;; This is the induction scheme for instance-xsound-alls-1b below.
+;; The difference from var-induct is that there is an extra argument tm
+;; that is instantiated along with the formula f.
+
+(defthm wft-list-subst-term-list  ;; for var-induct-tm guards
+  (implies (and (wft-list l)
+		(consp l)
+		(domain-term e))
+	   (wft-list (list (car (subst-term-list l x e))))))
+
+(defthm consp-subst-term-list  ;; for var-induct-tm guards
+  (implies (and (wft-list l)
+		(consp l))
+	   (consp (subst-term-list l x e))))
+
+(defun var-induct-tm (vars f tm dom i)
+  (declare (xargs :measure (cons (+ 1 (acl2-count vars)) (acl2-count dom))
+                  :guard (and (var-list vars) (wff f) (wft tm)
+                              (domain-term-list (fringe dom)))))
+  (if (atom vars)
+      nil
+      (if (atom dom)
+          (var-induct-tm (cdr vars)
+		      (subst-free f (car vars) dom)
+		      (car (subst-term-list (list tm) (car vars) dom))
+		      (domain i) i)
+          (cons (var-induct-tm vars f tm (car dom) i)
+                (var-induct-tm vars f tm (cdr dom) i)))))
+
+;; The following theorem has that hypothesis (quantifier-free f).  The
+;; two reasons (both due to the base case) are:
+;;   (1) The old (car i)/dom problem, which might be fixable by using feval.
+;;   (2) The proof fails because (vars-in-term tm) and (quantified-vars f)
+;;       are not disjoint.
+
+(defthm instance-xsound-alls-1b
+  (implies (and (domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+                (variable-term x)
+		(quantifier-free f)  ;; NOTE QUANTIFIER-FREE!
+		(not (free-vars (list 'all x f)))
+                (xeval (list 'all x f) (domain i) i)
+		(var-set v)
+		(equal (subst-free f x tm) g)
+                (not (free-vars (alls v g))))
+           (xeval (alls v g) dom i))
+  :hints (("Goal"
+	   :induct (var-induct-tm v g tm dom i))
+	  ("Subgoal *1/3"
+	   :expand ((ALLS V (SUBST-FREE F X TM))))
+	  )
+  :rule-classes nil)
+
+;;----------------------  Part 2
+;; Now, extend the preceding theorem by tacking sequences of universally
+;; quantified variables onto the fronts of the the formulas with "alls".
+
+;;------------------------  for a case of instance-xsound-alls-2 below
+
+(defthm unexpand-subst-free-all
+  (implies (and (variable-term y)
+                (not (equal x y)))
+           (equal (list 'all y (subst-free f x tm))
+                  (subst-free (list 'all y f) x tm)))
+  :rule-classes nil)
+
+(defthm var-alls-subst-2
+  (implies (and (domain-term e)
+                (variable-term x)
+                (variable-term y)
+                (not (equal x y))
+                (var-set v)
+                (not (member-equal x v))
+                (not (remove-equal x (free-vars (alls v (list 'all y f))))))
+           (not (free-vars (alls v (list 'all y (subst-free f x e))))))
+  :hints (("Goal"
+           :do-not-induct t
+           :in-theory (disable subst-free)
+           :use ((:instance unexpand-subst-free-all (tm e))))
+          ("Goal'4'"
+           :use ((:instance not-free-vars-alls-subst-free
+			    (g (list 'all y f))
+			    (v1 x) (v2 v))))))
+
+;;------------------------ For a case of instance-xsound-alls-2:
+
+(defthm not-member-append
+  (implies (and (not (member-equal x a))
+		(not (member-equal x b)))
+	   (not (member-equal x (append a b)))))
+
+(defthm xeval-alls-all-subst
+  (implies
+   (and (domain-term-list (fringe dom))
+        (domain-term e)
+        (member-equal e (fringe dom))
+        (variable-term x)
+        (variable-term w)
+        (not (equal x w))
+        (not (member-equal x w2))
+        (not (member-equal w w2))
+        (var-set w2)
+        (xeval (list 'all w (alls w2 (list 'all x f))) dom i))
+   (xeval (alls w2 (list 'all x (subst-free f w e))) (domain i) i))
+  :hints (("Goal"
+           :induct (dom-i dom))))
+
+;;------------------------
+
+;; This is the induction scheme for instance-xsound-alls-2b below.
+;; The difference from var-induct-tm is that there is an extra argument g
+;; that is instantiated along with the formula f and term tm.
+
+(defun var-induct-2-tm (vars f g tm dom i)
+  (declare (xargs :measure (cons (+ 1 (acl2-count vars)) (acl2-count dom))
+                  :guard (and (var-list vars) (wff f) (wff g) (wft tm)
+                              (domain-term-list (fringe dom)))))
+  (if (atom vars)
+      nil
+      (if (atom dom)
+          (var-induct-2-tm (cdr vars)
+		      (subst-free f (car vars) dom)
+		      (subst-free g (car vars) dom)
+		      (car (subst-term-list (list tm) (car vars) dom))
+		      (domain i) i)
+          (cons (var-induct-2-tm vars f g tm (car dom) i)
+                (var-induct-2-tm vars f g tm (cdr dom) i)))))
+
+(defthm instance-xsound-alls-2b
+  (implies (and (domain-term-list (fringe dom))
+                (subsetp-equal (fringe dom) (fringe (domain i)))
+                (variable-term x)
+                (quantifier-free f)   ;; ********* quantifier-free *******
+                (var-set w)
+		(not (member-equal x w))
+                (not (free-vars (alls w (list 'all x f))))
+                (xeval (alls w (list 'all x f)) (domain i) i)
+                (var-set (append w v))
+		(equal (subst-free f x tm) g)
+                (not (free-vars (alls (append w v) g))))
+           (xeval (alls (append w v) g) dom i))
+  :hints (("Goal"
+	   :induct (var-induct-2-tm w f g tm dom i))
+	  ("Subgoal *1/3"
+	   :expand ((append w v)))
+	  ("Subgoal *1/2.1''"
+	   :use ((:instance xeval-alls-all-subst
+			    (e dom)
+			    (dom (domain i))
+			    (w w1))))
+	  ("Subgoal *1/1'''"
+	   :use ((:instance instance-xsound-alls-1b
+			    (g (subst-free f x tm)))))
+	  )
+  :rule-classes nil)
+
+;;-------------------------- Part 3
+;; Get this thing in terms of universal closure.  This requires some
+;; set operations and the theorem xeval-alls-subset to get the
+;; leading universal quantifiers in right order (given by free-vars).
+
+(defthm var-set-append-remove-list
+  (implies (and (variable-term x)
+                (var-set vf))
+           (var-set (append (remove-equal x vf) (list x)))))
+
+(defthm alls-append
+  (equal (alls (append v (list x)) f)
+         (alls v (list 'all x f))))
+
+;;------------
+
+(defthm not-member-not-equal
+  (implies (and (not (member-equal x a))
+                (member-equal v1 a))
+           (not (equal x v1)))
+  :rule-classes nil)
+
+(defthm member-remove-free-vars-alls
+  (implies (and (member-equal x (free-vars (alls v2 f)))
+                (member-equal v1 w)
+                (member-equal x (free-vars (alls w f))))
+           (member-equal x (remove-equal v1 (free-vars (alls v2 f)))))
+ :hints (("goal"
+          :do-not-induct t
+          :in-theory (disable alls-eliminates-free-vars)
+          :use ((:instance alls-eliminates-free-vars (vars w))
+                (:instance not-member-not-equal (a w))))))
+
+(defthm subset-member-free-vars-alls
+  (implies (and (subsetp-equal v w)
+                (member-equal x (free-vars (alls w f))))
+           (member-equal x (free-vars (alls v f))))
+ :hints (("Goal"
+          :do-not generalize))
+ :rule-classes nil)
+
+(defthm subset-vars-not-member-closure
+  (implies (subsetp-equal (free-vars f) w)
+           (not (member-equal x (free-vars (alls w f)))))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance subset-member-free-vars-alls
+                            (v (free-vars f)))))))
+
+(defthm subset-vars-closed
+  (implies (subsetp-equal (free-vars f) w)
+           (not (free-vars (alls w f))))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance consp-has-member-equal
+                            (x (free-vars (alls w f))))))))
+
+(defthm not-vars-alls-remove-vars-all
+  (not (free-vars (alls (remove-equal x (free-vars f)) (list 'all x f))))
+  :hints (("Goal"
+           :do-not-induct t
+           :in-theory (disable alls-append)
+           :use ((:instance alls-append
+                            (v (remove-equal x (free-vars f))))))))
+
+;;---------------
+;; This section is just to prove something about set operations,
+;; theorem member-append-difference below.
+
+(defthm member-difference-cons
+  (implies (and (member-equal x (set-difference-equal b a2))
+                (not (equal x a1)))
+           (member-equal x (set-difference-equal b (cons a1 a2))))
+  :rule-classes nil)
+
+(defthm member-append-or
+  (implies (member-equal x (append a b))
+           (or (member-equal x a) (member-equal x b)))
+  :rule-classes nil)
+
+(defthm member-append-difference-cons-helper
+  (implies (and (member-equal x (set-difference-equal b a2))
+                (not (equal x a1)))
+           (member-equal x (append a2 (set-difference-equal b (cons a1 a2)))))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance member-difference-cons))))
+  :rule-classes nil)
+
+(defthm member-append-difference-cons
+  (implies (and (member-equal x (append a2 (set-difference-equal b a2)))
+                (not (equal x a1)))
+           (member-equal x (append a2 (set-difference-equal b (cons a1 a2)))))
+  :hints (("Goal"
+           :do-not-induct t
+           :in-theory (disable member-append-left)
+           :use ((:instance member-append-difference-cons-helper)
+                 (:instance member-append-left
+			    (a a2)
+                            (b (set-difference-equal b (cons a1 a2))))
+                 (:instance member-append-or
+			    (a a2)
+                            (b (set-difference-equal b (cons a1 a2))))))))
+
+(defthm member-append-difference
+  (implies (member-equal x (append a b))
+           (member-equal x (append a (set-difference-equal b a)))))
+
+;; Now get this in terms of subset.
+
+;; It might have been simpler to do this in terms of subset in the
+;; first place.  In  particular, the following is proved automatically.
+;;   (defthm lkj7
+;;     (subsetp-equal (append b a)
+;;                    (append (set-difference-equal b a) a)))
+;; but both appends have to be flipped, which is nontrivial (for me).
+
+;;------------------------------------
+
+(defthm member-append-difference-subset
+  (subsetp-equal (append a b) (append a (set-difference-equal b a)))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance subset-skolem-lemma
+                            (a (append a b))
+                            (b (append a (set-difference-equal b a))))))))
+
+;;------------------------------------
+
+(defthm vars-in-subst-term-list
+  (subsetp-equal (vars-in-term-list (subst-term-list l x tm))
+                 (union-equal (remove-equal x (vars-in-term-list l))
+                              (vars-in-term-list (list tm))))
+  :hints (("Goal"
+           :do-not generalize)))
+
+(defthm member-union-remove
+  (implies (and (member-equal f (union-equal r v))
+                (not (equal x f)))
+           (member-equal f (union-equal (remove-equal x r) v))))
+
+(defthm subset-remove-union-remove
+  (implies (subsetp-equal f (union-equal r v))
+           (subsetp-equal (remove-equal x f)
+                          (union-equal (remove-equal x r) v)))
+  :hints (("Goal"
+           :induct (remove-equal x f))))
+
+(defthm free-vars-in-subst
+  (subsetp-equal (free-vars (subst-free f x tm))
+                 (union-equal (remove-equal x (free-vars f))
+                              (vars-in-term tm))))
+
+;; Now, get this in terms of append instead of union-equal
+
+(defthm subset-union-append
+  (subsetp-equal (union-equal b c)
+                 (append b c)))
+
+(defthm subset-union-subset-append
+  (implies (subsetp-equal a (union-equal b c))
+           (subsetp-equal a (append b c))))
+
+(defthm free-vars-in-subst-append
+  (subsetp-equal (free-vars (subst-free f x tm))
+                 (append (remove-equal x (free-vars f))
+                         (vars-in-term tm))))
+
+;;---------------------------
+
+(defthm subset-free-subst-append-remove-etc
+  (subsetp-equal (free-vars (subst-free f x tm))
+                 (append (remove-equal x (free-vars f))
+                         (set-difference-equal
+                          (vars-in-term tm)
+                          (remove-equal x (free-vars f)))))
+  :hints (("Goal"
+           :use ((:instance subsetp-equal-transitive
+                            (x (free-vars (subst-free f x tm)))
+                            (y (append (remove-equal x (free-vars f))
+                                       (vars-in-term tm)))
+                            (z (append (remove-equal x (free-vars f))
+                                       (set-difference-equal
+                                        (vars-in-term tm)
+                                        (remove-equal x (free-vars f)))))
+                            ))
+           :do-not-induct t)))
+
+;;---------------
+
+(defthm not-vars-append-difference-subst
+  (not (free-vars
+        (alls (append (remove-equal x (free-vars f))
+                      (set-difference-equal (vars-in-term tm)
+                                            (remove-equal x (free-vars f))))
+              (subst-free f x tm))))
+  :hints (("Goal"
+           :do-not-induct t)))
+
+(defthm var-list-remove-free-vars
+  (var-list (remove-equal x (free-vars f))))
+
+(defthm var-list-append-difference
+  (implies (and (var-list a)
+		(var-list b))
+	   (var-list (append a (set-difference-equal b a)))))
+
+(defthm setp-append-difference-helper
+  (implies (and (setp (append a (set-difference-equal b a)))
+		(not (member-equal x a))
+		(not (member-equal x b)))
+	   (setp (append a (cons x (set-difference-equal b a))))))
+
+(defthm setp-append-difference
+  (implies (and (setp a)
+		(setp b))
+	   (setp (append a (set-difference-equal b a))))
+  :hints (("Goal"
+           :do-not generalize)))
+
+;;------------------- The main event
+
+(local (include-book "close"))  ;; for xeval-alls-subset
+
+(defthm instance-xsound-for-1-substitution
+  (implies (and (quantifier-free f)   ;; ********* quantifier-free *******
+                (xeval (universal-closure f) (domain i) i)
+                (variable-term x))
+	   (xeval (universal-closure (subst-free f x tm)) (domain i) i))
+  :hints (("Goal"
+           :do-not-induct t
+           :in-theory (disable quantifier-free free-vars subst-free xeval)
+           :use ((:instance instance-xsound-alls-2b
+			    (g (subst-free f x tm))
+			    (dom (domain i))
+                            (w (remove-equal x (free-vars f)))
+                            (v (set-difference-equal
+                                (vars-in-term tm)
+                                (remove-equal x (free-vars f)))))
+                 (:instance xeval-alls-subset
+                            (b (append (remove-equal x (free-vars f))
+                                       (list x)))
+                            (a (free-vars f)))
+                 (:instance xeval-alls-subset
+                            (b (append (remove-equal x (free-vars f))
+                                       (set-difference-equal
+                                        (vars-in-term tm)
+                                        (remove-equal x (free-vars f)))))
+                            (a (free-vars (subst-free f x tm)))
+                            (f (subst-free f x tm)))
+                 )))
+  :rule-classes nil)
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/instance.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/instance.lisp
new file mode 100644
index 0000000..82c381c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/instance.lisp
@@ -0,0 +1,107 @@
+(in-package "ACL2")
+
+;; In this book we show that a ground term can be
+;; substituted for a universally quantified variable.
+
+(include-book "stage")
+
+;; Substituting a member of the domain.
+
+(defthm instance-domain-term-sound
+  (implies (and (variable-term x)
+                (xeval (list 'all x f) dom i)
+		(member-equal e (fringe dom)))
+           (xeval (subst-free f x e) (domain i) i))
+  :hints (("Goal"
+	   :induct (dom-i dom))))
+
+;;--------------------------------------------------
+
+(defthm len-subst-term-list
+  (equal (len (subst-term-list l x tm)) (len l)))
+
+(defthm eval-term-list-idemp
+  (equal (eval-term-list (eval-term-list l i) i)
+	 (eval-term-list l i)))
+
+(defthm eval-term-idemp-helper
+  (implies (consp l)
+	   (equal (car (eval-term-list (list (car (eval-term-list l i))) i))
+		  (car (eval-term-list l i)))))
+
+(defthm eval-term-idemp
+  (equal (eval-term (eval-term tm i) i)
+	 (eval-term tm i)))
+
+;;--------------------------------------------------
+;; The following 3 lemmas are for the base case of ground-term-eval
+
+(defthm eval-subst-eval-equal-eval-subst
+  (equal (eval-term-list (subst-term-list l x (eval-term tm i)) i)
+         (eval-term-list (subst-term-list l x tm) i)))
+
+(defthm eval-subst-eval-equal-eval-subst-car
+  (equal (eval-term (car (subst-term-list l x (eval-term tm i))) i)
+         (eval-term (car (subst-term-list l x tm)) i)))
+
+(defthm eval-subst-eval-equal-eval-subst-cadr
+  (equal (eval-term (cadr (subst-term-list l x (eval-term tm i))) i)
+         (eval-term (cadr (subst-term-list l x tm)) i)))
+
+;;--------------------------------------------------
+
+(defthm not-vars-in-term-list-not-var-occurrence-term-list
+  (implies (not (vars-in-term-list l))
+           (not (var-occurrence-term-list x l))))
+
+(defthm not-var-occurrence-term-list-list-car-eval-term-list
+  (implies
+   (consp l)
+   (not (var-occurrence-term-list y (list (car (eval-term-list l i)))))))
+
+;;--------------------------------------------------
+
+(defthm ground-term-eval
+  (implies (and (variable-term x)
+		(domain-term-list (fringe dom))
+		(not (vars-in-term-list (list tm))))
+	   (equal (xeval (subst-free f x (eval-term tm i)) dom i)
+		  (xeval (subst-free f x tm) dom i)))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (xeval-i f dom i))
+	  ("Subgoal *1/7"
+	   :in-theory (enable eval-atomic))))
+
+(defthm eval-term-list-gives-domain-tuple
+  (subsetp-equal (eval-term-list l i) (fringe (domain i)))
+  :hints (("Goal"
+	   :in-theory (enable domain-term))))
+
+(defthm consp-eval-term-list
+  (implies (consp x)
+	   (consp (eval-term-list x i))))
+
+;;--------------------------------------------------
+
+(encapsulate
+ nil
+ (local (defthm lkj
+	  (implies (and (subsetp-equal a b) (consp a))
+		   (member-equal (car a) b))))
+
+ (defthm eval-term-gives-domain-member
+   (member-equal (eval-term tm i) (fringe (domain i))))
+)  ;; end encapsulate
+
+(defthm instance-term-sound
+  (implies (and (variable-term x)
+		(not (vars-in-term-list (list tm)))
+		(xeval (list 'all x f) (domain i) i))
+	   (xeval (subst-free f x tm) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance instance-domain-term-sound
+			    (dom (domain i))
+			    (e (eval-term tm i))
+			    )))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/keval.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/keval.lisp
new file mode 100644
index 0000000..f95408f
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/keval.lisp
@@ -0,0 +1,183 @@
+(in-package "ACL2")
+
+;; This book contains yet another evaluation function, keval.
+;;
+;; This one is for proving that we can permute universally
+;; quantified variables.
+;;
+;; This is ugly.
+
+(include-book "stage")
+(include-book "../../../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+;; ---------------------------------------------------------
+;; Function (keval vars f dom n d2 i) evaluates (alls vars f);; that is,
+;; it tacks on vars to f as universally quantified variables.  The arguments
+;; dom and i are the same as xeval, with the following exception.
+;; Index n says that when the n-th variable is reached, use d2 as the
+;; domain instead of dom.  This is used to prove that we can permute
+;; universally quantified variables.  (The analogous thing would work for
+;; existentially quantified variables.)
+
+(defun keval (vars f dom n d2 i)
+  (declare (xargs :measure (cons (cons (+ 1 (acl2-count vars))
+				       (acl2-count dom))
+				 (acl2-count d2))
+		  :guard (and (var-list vars)
+			      (setp vars)
+			      (wff f)
+			      (not (free-vars (alls vars f)))
+			      (integerp n)
+			      (domain-term-list (fringe dom))
+                              (subsetp-equal (fringe dom)
+                                             (fringe (domain i)))
+			      (domain-term-list (fringe d2))
+			      (subsetp-equal (fringe d2)
+                                             (fringe (domain i))))))
+  (cond ((atom vars)   (xeval f dom i))
+	((equal n 1)
+	 (if (atom d2) (keval (cdr vars)
+			      (subst-free f (car vars) d2)
+			      dom
+			      (- n 1)
+			      (domain i)
+			      i)
+	   (and (keval vars f dom n (car d2) i)
+		(keval vars f dom n (cdr d2) i))))
+	(t
+	 (if (atom dom) (keval (cdr vars)
+			       (subst-free f (car vars) dom)
+			       (domain i)
+			       (- n 1)
+			       d2
+			       i)
+	   (and (keval vars f (car dom) n d2 i)
+		(keval vars f (cdr dom) n d2 i))))))
+
+
+;;------------------ The relationship of keval to xeval.
+
+;; If n <= 0, d2 is ignored.
+
+(defthm keval-xeval-lt-1
+  (implies (and (var-list v)
+		(setp v)
+		(<= n 0))
+	   (equal (keval v f dom n d2 i)
+		  (xeval (alls v f) dom i)))
+  :hints (("Goal"
+	   :induct (keval v f dom n d2 i)
+	   :expand ((alls v f))
+	   )))
+
+(defthm keval-xeval-i-1
+  (implies (and (domain-term-list (fringe dom))
+		(var-list v)
+		(setp v)
+		(consp v))
+	   (equal (keval v f (domain i) 1 dom i)
+		  (xeval (alls v f) dom i)))
+  :hints (("Goal"
+	   :induct (var-induct v f dom i)
+	   :expand ((alls v f))
+	   ))
+  :rule-classes nil)
+
+(defthm keval-xeval-i-1a
+  (implies (and (var-list v)
+		(setp v))
+	   (equal (keval v f (domain i) 1 (domain i) i)
+		  (xeval (alls v f) (domain i) i)))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance keval-xeval-i-1 (dom (domain i)))))))
+
+(defun var-induct-n (vars f dom n i)
+  (declare (xargs :measure (cons (+ 1 (acl2-count vars)) (acl2-count dom))
+                  :guard (and (var-list vars) (wff f) (integerp n)
+                              (domain-term-list (fringe dom)))))
+  (if (atom vars)
+      nil
+      (if (atom dom)
+          (var-induct-n (cdr vars) (subst-free f (car vars) dom)
+			(domain i) (- n 1) i)
+          (cons (var-induct-n vars f (car dom) n i)
+                (var-induct-n vars f (cdr dom) n i)))))
+
+(defthm keval-xeval-i-x1
+  (implies (and (domain-term-list (fringe dom))
+		(var-list v)
+		(setp v)
+		(not (equal n 1)))
+	   (equal (keval v f dom n (domain i) i)
+		  (xeval (alls v f) dom i)))
+  :hints (("Goal"
+	   :induct (var-induct-n v f dom n i)
+	   :expand ((alls v f))
+	   ))
+  :rule-classes nil)
+
+(defthm keval-xeval-i
+  (implies (and (var-list v)
+		(setp v))
+	   (equal (keval v f (domain i) n (domain i) i)
+		  (xeval (alls v f) (domain i) i)))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance keval-xeval-i-1a)
+		 (:instance keval-xeval-i-x1 (dom (domain i))))
+	   :in-theory (disable keval-xeval-i-1a))))
+
+;; Function (idx x a) is used for the index argument of keval.
+;; It gives the index of the first occurrence of x in a, counting
+;; from 1 (or 0 if x is not in a).
+
+(defun idx (x a)
+  (declare (xargs :guard (true-listp a)))
+  (cond ((atom a) 0)
+	((equal (car a) x) 1)
+	((equal (idx x (cdr a)) 0) 0)
+	(t (+ 1 (idx x (cdr a))))))
+
+(defthm idx-not-zero
+  (implies (member-equal x a)
+	   (not (equal (idx x a) 0))))
+
+;;---------------
+;; An induction scheme for keval.
+
+(defun keval-i (vars f dom n d2 i)
+  (declare (xargs :measure (cons (cons (+ 1 (acl2-count vars))
+				       (acl2-count dom))
+				 (acl2-count d2))
+		  :guard (and (var-list vars)
+			      (setp vars)
+			      (wff f)
+			      (not (free-vars (alls vars f)))
+			      (integerp n)
+			      (domain-term-list (fringe dom))
+                              (subsetp-equal (fringe dom)
+                                             (fringe (domain i)))
+			      (domain-term-list (fringe d2))
+			      (subsetp-equal (fringe d2)
+                                             (fringe (domain i))))))
+  (cond ((atom vars) 'junk)
+	((equal n 1)
+	 (if (atom d2) (keval-i (cdr vars)
+			      (subst-free f (car vars) d2)
+			      dom
+			      (- n 1)
+			      (domain i)
+			      i)
+	   (cons (keval-i vars f dom n (car d2) i)
+		 (keval-i vars f dom n (cdr d2) i))))
+	(t
+	 (if (atom dom) (keval-i (cdr vars)
+			       (subst-free f (car vars) dom)
+			       (domain i)
+			       (- n 1)
+			       d2
+			       i)
+	   (cons (keval-i vars f (car dom) n d2 i)
+		 (keval-i vars f (cdr dom) n d2 i))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/modeler.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/modeler.lisp
new file mode 100644
index 0000000..5d54c8c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/modeler.lisp
@@ -0,0 +1,70 @@
+(in-package "ACL2")
+
+;; This book contains the top definitions and soundness theorems for
+;; the model and countermodel procedures.  This book is analogous
+;; to a combination of the refute-n-check and prover books for the
+;; refutation procedure, but it is much simpler, because the soundness
+;; proof here is trivial.
+
+(include-book "nnf")            ; nnf
+(include-book "rename-top")     ; rename-all
+(include-book "skolem-top")     ; skolemize
+(include-book "cnf")            ; cnf
+(include-book "pull-top")       ; pull-quants
+
+(include-book "derive")
+
+(defstub external-modeler (clauses) t)
+
+;; Function model-attempt is analogous to a combination of
+;; refute-n-check and refutation-attempt.  We compose all of the
+;; preprocessing steps, build an initial proof object, and
+;; call external-modeler, and check the result.
+
+(defun model-attempt (f)
+  (declare (xargs :guard (and (wff f) (not (free-vars f)))))
+  (if (not (and (wff f) (not (free-vars f))))
+      nil
+    (let* ((preprocessed
+            (cnf
+             (pull-quants (skolemize (rename-all (nnf f))))))
+           (mace-result
+            (external-modeler
+             (assign-ids-to-prf
+              (initial-proof
+               (remove-leading-alls preprocessed)) 1))))
+      (if (feval f mace-result)
+          mace-result
+        nil))))
+
+;; This "soundness" proof is really trivial, because model-attempt
+;; checks MACE's answer by calling feval.
+
+(defthm model-attempt-fsound  ;; Top Theorem #3
+  (implies (model-attempt f)
+	   (and (wff f)
+		(not (free-vars f))
+		(feval f (model-attempt f)))))
+
+(in-theory (disable model-attempt))
+
+;; Now state it positively.  That is, if we find a model of the negation
+;; of a formula, then we have a countermodel of the formula.
+;; This is a top function, so check the guard.
+
+(defun countermodel-attempt (f)
+  (declare (xargs :guard (and (wff f) (not (free-vars f)))))
+  (if (not (and (wff f) (not (free-vars f))))
+      nil
+    (model-attempt (list 'not f))))
+
+(defthm countermodel-attempt-fsound  ;; Top Theorem #4
+  (implies (countermodel-attempt f)
+	   (and (wff f)
+		(not (free-vars f))
+		(not (feval f (countermodel-attempt f)))))
+  :hints (("Goal"
+           :in-theory (enable model-attempt))))
+
+(in-theory (disable countermodel-attempt))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/nnf.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/nnf.lisp
new file mode 100644
index 0000000..5b03b9c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/nnf.lisp
@@ -0,0 +1,109 @@
+(in-package "ACL2")
+
+;; Negation normal form (NNF): definition, syntactic correctness
+;; theorem, soundness theorem, and some preservation-of-property theorems.
+
+(include-book "stage")
+
+(defmacro car-and (f)    (list 'equal (list 'car f) ''and))
+(defmacro car-or (f)     (list 'equal (list 'car f) ''or))
+(defmacro car-imp (f)    (list 'equal (list 'car f) ''imp))
+(defmacro car-iff (f)    (list 'equal (list 'car f) ''iff))
+(defmacro car-all (f)    (list 'equal (list 'car f) ''all))
+(defmacro car-exists (f) (list 'equal (list 'car f) ''exists))
+
+;;==================================================================
+;; Function nnf converts a formula to negation normal form.
+;; That is, in terms of and/or/not, where all nots are up against
+;; simple formulas.  ('true and 'false are not simplified away.)
+
+(defun nnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond
+   ((wfbinary f)
+    (cond ((car-and f) (list 'and (nnf (a1 f)) (nnf (a2 f))))
+	  ((car-or  f) (list 'or  (nnf (a1 f)) (nnf (a2 f))))
+	  ((car-imp f) (list 'or  (nnf (list 'not (a1 f))) (nnf (a2 f))))
+	  ((car-iff f) (list 'and
+			     (list 'or (nnf (list 'not (a1 f))) (nnf (a2 f)))
+			     (list 'or (nnf (a1 f)) (nnf (list 'not (a2 f))))))
+	  (t f)))  ; should not happen if (wff f)
+
+   ((wfquant f)
+    (cond ((car-all    f) (list 'all    (a1 f) (nnf (a2 f))))
+	  ((car-exists f) (list 'exists (a1 f) (nnf (a2 f))))
+	  (t f)))  ; should not happen if (wff f)
+
+   ((wfnot f)
+    (cond ((wfbinary (a1 f))
+	   (cond ((car-and (a1 f)) (list 'or
+					 (nnf (list 'not (a1 (a1 f))))
+					 (nnf (list 'not (a2 (a1 f))))))
+		 ((car-or (a1 f))  (list 'and
+					 (nnf (list 'not (a1 (a1 f))))
+					 (nnf (list 'not (a2 (a1 f))))))
+		 ((car-imp (a1 f)) (list 'and
+					 (nnf (a1 (a1 f)))
+					 (nnf (list 'not (a2 (a1 f))))))
+		 ((car-iff (a1 f)) (list 'and
+					 (list 'or
+					       (nnf (a1 (a1 f)))
+					       (nnf (a2 (a1 f))))
+					 (list 'or
+					       (nnf (list 'not (a1 (a1 f))))
+					       (nnf (list 'not (a2 (a1 f)))))))
+		 (t f)))  ; should not happen if (wff f)
+	  ((wfquant (a1 f))
+	   (cond ((car-all (a1 f))
+		  (list 'exists (a1 (a1 f)) (nnf (list 'not (a2 (a1 f))))))
+		 ((car-exists (a1 f))
+		  (list 'all (a1 (a1 f)) (nnf (list 'not (a2 (a1 f))))))
+		 (t f)))  ; should not happen if (wff f)
+
+	  ((wfnot (a1 f)) (nnf (a1 (a1 f))))
+	  (t f)))
+   (t f)))
+
+;; Prove that nnf preserves well-formedness.
+
+(defthm nnf-wff
+  (implies (wff f)
+	   (wff (nnf f))))
+
+;; Prove that nnf applied to a wff gives negation normal form.
+
+(defthm nnf-nnfp
+  (implies (wff x)
+	   (nnfp (nnf x))))
+
+(defthm subst-nnf-commute
+  (equal (subst-free (nnf f) x tm)
+	 (nnf (subst-free f x tm))))
+
+;;---------------------------------
+;; Prove that nnf is sound.  The proof seems to be easier with xeval.
+
+(defthm nnf-xsound-for-not
+  (equal (xeval (nnf (list 'not f)) dom i)
+	 (xeval (list 'not (nnf f)) dom i))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i))))
+
+(defthm nnf-xsound
+  (equal (xeval (nnf f) dom i)
+	 (xeval f dom i))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i))))
+
+(defthm nnf-fsound
+  (equal (feval (nnf f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval))))
+
+;;---------------------------------
+;; Prove that nnf preserves the set of free variables.
+
+(defthm nnf-preserves-free-vars
+  (equal (free-vars (nnf f)) (free-vars f)))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/paramod.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/paramod.lisp
new file mode 100644
index 0000000..d6d422d
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/paramod.lisp
@@ -0,0 +1,435 @@
+(in-package "ACL2")
+
+;; This book is about paramodulation (without unification).
+;;
+;; We define a function paramod that tries to make one
+;; paramodulation inference (on identical terms) at specified
+;; positions of two parent clauses.  Then we prove that if
+;; the universal closures of the two parents are true in some
+;; interpretation, then the universal closure of the paramoudulant
+;; is true in that interpretation.
+
+(include-book "stage")
+
+(defun term-at-pos-term-list (a l pos)
+  (declare (xargs :guard (and (wft a) (wft-list l) (integer-listp pos))))
+  (cond
+   ((atom pos) nil)
+   ((atom l) nil)
+   ((equal (car pos) 1)
+    (cond ((variable-term (car l)) (and (atom (cdr pos)) (equal a (car l))))
+	  ((domain-term   (car l)) (and (atom (cdr pos)) (equal a (car l))))
+	  ((wf-ap-term-top (car l))
+	   (if (atom (cdr pos))
+	       (equal a (car l))
+	     (term-at-pos-term-list a (cdar l) (cdr pos))))
+	  (t nil))) ;; non-term
+   (t (term-at-pos-term-list a (cdr l) (cons (- (car pos) 1)
+					     (cdr pos))))))
+
+;;  (term-at-pos-term-list 'x '(y (f x) z) '(2 1))
+
+(defun term-at-pos (a f pos)
+  (declare (xargs :guard (and (wft a) (wff f) (integer-listp pos))))
+  (cond ((atom pos) nil)
+	((wfnot f) (if (equal (car pos) 1)
+		       (term-at-pos a (a1 f) (cdr pos))
+		     nil))
+	((wfbinary f) (cond ((equal (car pos) 1)
+			     (term-at-pos a (a1 f) (cdr pos)))
+			    ((equal (car pos) 2)
+			     (term-at-pos a (a2 f) (cdr pos)))
+			    (t nil)))
+	((wfatomtop f) (term-at-pos-term-list a (cdr f) pos))
+	(t nil)))
+
+;;  (term-at-pos 'x '(or (p) (q y (f x) z)) '(2 2 1))
+
+(defun replace-at-pos-term-list (a b l pos)
+  (declare (xargs :guard (and (wft a) (wft b) (wft-list l) (integer-listp pos))))
+  (cond
+   ((atom pos) l)
+   ((atom l) l)
+   ((equal (car pos) 1)
+    (cons (cond ((variable-term (car l))
+		 (if (and (atom (cdr pos)) (equal a (car l)))
+		     b
+		     (car l)))
+		((domain-term (car l))
+		 (if (and (atom (cdr pos)) (equal a (car l)))
+		     b
+		     (car l)))
+		((wf-ap-term-top (car l))
+		 (if (atom (cdr pos))
+		     (if (equal a (car l))
+			 b
+		         (car l))
+		     (cons (caar l)
+			   (replace-at-pos-term-list a b (cdar l) (cdr pos)))))
+		(t (car l))) ;; variable term, domain-term, non-term
+	  (cdr l)))
+   (t (cons (car l)
+	    (replace-at-pos-term-list a b (cdr l) (cons (- (car pos) 1)
+							(cdr pos)))))))
+
+(defthm replace-at-pos-term-list-preserves-true-listp
+  (implies (true-listp l)
+	   (true-listp (replace-at-pos-term-list a b l pos))))
+
+(defthm replace-at-pos-term-list-wf
+  (implies (and (wft-list l)
+		(wft b))
+	   (wft-list (replace-at-pos-term-list a b l pos))))
+
+(defthm replace-at-pos-term-list-preserves-len
+  (equal (len (replace-at-pos-term-list a b l po))
+	 (len l)))
+
+;;------------------------------------------------------
+;; replace-at-pos
+;; No replacements are made below quantified formulas.
+;; If the position doesn't exist, or if a is not at the position,
+;; the formula is not changed.
+
+(defun replace-at-pos (a b f pos)
+  (declare (xargs :guard (and (wft a) (wft b) (wff f) (integer-listp pos))))
+  (cond ((atom pos) f)
+	((wfnot f) (if (equal (car pos) 1)
+		       (list 'not (replace-at-pos a b (a1 f) (cdr pos)))
+		     f))
+	((wfbinary f) (cond ((equal (car pos) 1)
+			     (list (car f)
+				   (replace-at-pos a b (a1 f) (cdr pos))
+				   (a2 f)))
+			    ((equal (car pos) 2)
+			     (list (car f)
+				   (a1 f)
+				   (replace-at-pos a b (a2 f) (cdr pos))))
+			    (t f)))
+	((wfatomtop f) (cons (car f)
+			     (replace-at-pos-term-list a b (cdr f) pos)))
+	(t f)))
+
+;; (replace-at-pos '(a) 'x '(or (p (f (a)) c) (d)) '(1 1 1))
+
+(defthm replace-at-pos-wf
+  (implies (and (wff f)
+		(wft b))
+	   (wff (replace-at-pos a b f pos))))
+
+;-------------------------
+
+(defthm eval-term-list-replace
+  (implies (equal (car (eval-term-list (list a) i))
+		  (car (eval-term-list (list b) i)))
+	   (equal (eval-term-list (replace-at-pos-term-list a b l pos) i)
+		  (eval-term-list l i))))
+
+;; These next two lemmas help when paramodulating into an equality
+;; (because eval-atomic does that awkward eval-term thing for equalities).
+
+(defthm eval-term-list-replace-car
+  (implies
+   (and (equal (car (eval-term-list (list a) i))
+	       (car (eval-term-list (list b) i)))
+	(consp l))
+   (equal
+    (car (eval-term-list (list (car (replace-at-pos-term-list a b l pos))) i))
+    (car (eval-term-list (list (car l)) i)))))
+
+(defthm eval-term-list-replace-cadr
+  (implies
+   (and (equal (car (eval-term-list (list a) i))
+	       (car (eval-term-list (list b) i)))
+	(consp l)
+	(consp (cdr l)))
+   (equal
+    (car (eval-term-list (list (cadr (replace-at-pos-term-list a b l pos))) i))
+    (car (eval-term-list (list (cadr l)) i)))))
+
+(defthm replace-at-pos-not-true-listp
+  (implies (not (true-listp x))
+	   (not (true-listp (replace-at-pos-term-list a b x pos)))))
+
+(defthm replace-at-pos-xsound
+  (implies (xeval (list '= a b) (domain i) i)
+	   (equal (xeval (replace-at-pos a b f pos) dom i)
+		  (xeval f dom i)))
+  :hints (("Goal"
+	   :do-not generalize
+	   :in-theory (enable eval-atomic)
+	   :induct (replace-at-pos a b f pos))))
+
+;;-----------------------
+
+(defun simp-t-or (f g)
+  (declare (xargs :guard (and (wff f) (wff g))))
+  (if (or (equal f 'true) (equal g 'true))
+      'true
+    (list 'or f g)))
+
+(defun paramod (f1 p1 f2 p2)
+  (declare (xargs :guard (and (wff f1) (integer-listp p1)
+			      (wff f2) (integer-listp p2))))
+  (cond ((atom p1) 'true)
+	((atom (cdr p1))
+	 (cond ((not (wfeq f1)) 'true)
+	       ((and (equal (car p1) 1)
+		     (term-at-pos (a1 f1) f2 p2))
+		(replace-at-pos (a1 f1) (a2 f1) f2 p2))
+	       ((and (equal (car p1) 2)
+		     (term-at-pos (a2 f1) f2 p2))
+		(replace-at-pos (a2 f1) (a1 f1) f2 p2))
+	       (t 'true)))
+	((wfor f1)
+	 (cond ((equal (car p1) 1)
+		(simp-t-or (paramod (a1 f1) (cdr p1) f2 p2) (a2 f1)))
+	       ((equal (car p1) 2)
+		(simp-t-or (a1 f1) (paramod (a2 f1) (cdr p1) f2 p2)))
+	       (t 'true)))
+	(t 'true)))
+
+;; (paramod '(or (p) (= (a) (b))) '(2 1) '(or (q x (a)) (r)) '(1 2))
+
+(defthm paramod-xsound-ground
+  (implies (and (xeval f1 dom i)
+		(xeval f2 dom i))
+	   (xeval (paramod f1 p1 f2 p2) dom i))
+  :hints (("Goal"
+	   :in-theory (enable eval-atomic)
+	   :induct (paramod f1 p1 f2 p2))))
+
+;;----------------------
+
+(defthm subst-term-list-preserves-len
+  (equal (len (subst-term-list l x tm))
+	 (len l)))
+
+;;----------------------------
+;; (eoft f g): "equal-or-first-true".  This is similar to sub-conj
+;; in resolve book, except that it is nonrecursive and simpler.
+;; The purpose is the same as for resolve: to get around the problem
+;; that subst-free and paramod don't commute.  (See thm
+;; paramod-xsound-case2-helper below to see how it fits in.)
+;; This messy, and there must be a simpler way to do it.
+
+(defun eoft (f g)
+  (declare (xargs :guard (and (wff f) (wff g))))
+  (or (equal f g)
+      (equal f 'true)))
+
+;-----------------
+
+(defthm subst-term-list-preserves-wf-ap-term-top
+  (implies (wf-ap-term-top (cons f args))
+	   (wf-ap-term-top (cons f (subst-term-list args x tm)))))
+
+(defthm replace-at-pos-term-list-preserves-wf-ap-term-top
+  (implies (wf-ap-term-top (cons f args))
+	   (wf-ap-term-top (cons f (replace-at-pos-term-list a b args pos)))))
+
+(defthm wf-ap-term-top-consp
+  (implies (not (consp x))
+	   (not (wf-ap-term-top x))))
+
+(defthm wf-ap-term-top-is-true-listp
+  (implies (wf-ap-term-top tm)
+	   (true-listp (cdr tm)))
+  :rule-classes :forward-chaining)
+
+(local (in-theory (disable wf-ap-term-top)))
+
+(defthm subst-replace-term-list
+  (implies
+   (and (term-at-pos-term-list a f2 pos)
+	(domain-term e))
+   (equal (subst-term-list (replace-at-pos-term-list a b f2 pos) x e)
+	  (replace-at-pos-term-list (subst-term a x e)
+				    (subst-term b x e)
+				    (subst-term-list f2 x e)
+				    pos))))
+
+(defthm subst-replace
+  (implies (and (term-at-pos a f pos)
+		(domain-term e))
+	   (equal (subst-free (replace-at-pos a b f pos) x e)
+		  (replace-at-pos (subst-term a x e)
+				  (subst-term b x e)
+				  (subst-free f x e)
+				  pos))))
+
+;;----------------------
+
+(defthm subst-true
+  (equal (equal (subst-free f x tm) 'true)
+	 (equal f 'true)))
+
+(defthm term-at-pos-subst-1
+  (implies (and (domain-term e)
+		(term-at-pos a f pos))
+	   (term-at-pos (subst-term a x e) (subst-free f x e) pos)))
+
+(defthm term-at-pos-subst-2
+  (implies (and (domain-term e)
+		(variable-term x)
+		(term-at-pos x f pos))
+	   (term-at-pos e (subst-free f x e) pos)))
+
+(defthm term-at-pos-subst-3
+  (implies (and (domain-term e)
+		(variable-term y)
+		(not (equal y x))
+		(term-at-pos y f pos))
+	   (term-at-pos y (subst-free f x e) pos)))
+
+(defthm term-at-pos-subst-4
+  (implies (and (domain-term e)
+		(wf-ap-term-top tm)
+		(term-at-pos tm f pos))
+	   (term-at-pos (cons (car tm) (subst-term-list (cdr tm) x e))
+			(subst-free f x e)
+			pos))
+  :hints (("goal"
+           :in-theory (enable wf-ap-term-top))))
+
+(defthm term-at-pos-subst-5
+  (implies (and (domain-term e)
+		(not (variable-term y))
+		(not (wf-ap-term-top y))
+		(term-at-pos y f pos))
+	   (term-at-pos y (subst-free f x e) pos)))
+
+(defthm term-at-pos-subst-6
+  (implies (and (domain-term e)
+		(domain-term ee)
+		(term-at-pos ee f pos))
+	   (term-at-pos ee (subst-free f x e) pos)))
+
+(local (include-book "arithmetic"))
+
+; The following was modified by Matt Kaufmann, June 2001, in order to
+; accommodate the new rewrite rule equal-constant-+-left in the
+; arithmetic/equalities book.
+
+#|
+(defthm len-0-list-forward
+  (implies (and (true-listp l)
+		(equal (+ n (len l)) n))
+	   (equal l nil))
+  :rule-classes :forward-chaining)
+|#
+
+(defthm len-0-list-forward
+  (implies (and (true-listp l)
+		(equal (len l) 0))
+	   (equal l nil))
+  :rule-classes :forward-chaining)
+
+;----------------------------
+
+(defthm eoft-paramod
+  (implies (domain-term e)
+	   (eoft (subst-free (paramod f1 p1 f2 p2) x e)
+		 (paramod (subst-free f1 x e) p1
+			  (subst-free f2 x e) p2)))
+  :hints (("Goal"
+	   :induct (paramod f1 p1 f2 p2)
+	   :do-not generalize)))
+
+(defthm eoft-subst
+  (implies (eoft q p)
+	   (eoft (subst-free q x tm) (subst-free p x tm))))
+
+(defthm eoft-xeval
+  (implies (and (eoft q p)
+		(xeval p dom i))
+	   (xeval q dom i))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (xeval-i p dom i))))
+
+(defthm eoft-xeval-vars
+  (implies (and (var-set vars)
+		(eoft q p)
+		(xeval (alls vars p) dom i))
+	   (xeval (alls vars q) dom i))
+  :hints (("Goal"
+	   :do-not generalize
+	   :in-theory (disable eoft)
+	   :expand ((alls vars p) (alls vars q))
+	   :induct (var-induct-2 vars p q dom i))))
+
+(defthm paramod-xsound-case2-helper
+  (implies
+   (and (variable-term x)
+	(var-set vars)
+	(not (member-equal x vars))
+	(domain-term e)
+	(xeval (alls vars (paramod (subst-free f1 x e) p1
+				   (subst-free f2 x e) p2)) (domain i) i) )
+   (xeval (alls vars (subst-free (paramod f1 p1 f2 p2) x e)) (domain i) i))
+  :hints (("Goal"
+         :use ((:instance eoft-xeval-vars
+			  (dom (domain i))
+			  (q (subst-free (paramod f1 p1 f2 p2) x e))
+			  (p (paramod (subst-free f1 x e) p1
+				      (subst-free f2 x e) p2)))))))
+
+(defthm paramod-xsound-alls
+  (implies (and (var-set vars)
+		(domain-term-list (fringe dom))
+		(xeval (alls vars f1) dom i)
+		(xeval (alls vars f2) dom i))
+	   (xeval (alls vars (paramod f1 p1 f2 p2)) dom i))
+  :hints (("Goal"
+	   :induct (var-induct-2 vars f1 f2 dom i)
+	   :do-not generalize
+	   :in-theory (disable paramod))
+	  ("Subgoal *1/3"
+	   :expand ((alls vars f1) (alls vars f2)))))
+		
+;;-----------------------------
+;; Now, get it in terms of universal-closure.
+
+(encapsulate
+ nil
+ (local (include-book "close"))
+ (defthm xeval-alls-subset
+   (implies (and (var-set a)
+		 (var-set b)
+		 (subsetp-equal a b)
+		 (not (free-vars (alls a f))))
+	    (equal (xeval (alls a f) (domain i) i)
+		   (xeval (alls b f) (domain i) i)))
+   :rule-classes nil)
+ )
+
+(defthm paramod-xsound-closure
+  (implies (and (xeval (universal-closure f) (domain i) i)
+		(xeval (universal-closure g) (domain i) i))
+           (xeval (universal-closure (paramod f fp g gp)) (domain i) i))
+  :hints
+  (("Goal"
+    :do-not-induct t
+    :use ((:instance xeval-alls-subset
+		     (f f)
+		     (a (free-vars f))
+		     (b (union-equal
+			 (free-vars f)
+			 (union-equal (free-vars g)
+				      (free-vars (paramod f fp g gp))))))
+	  (:instance xeval-alls-subset
+		     (f g)
+		     (a (free-vars g))
+		     (b (union-equal
+			 (free-vars f)
+			 (union-equal (free-vars g)
+				      (free-vars (paramod f fp g gp))))))
+	  (:instance xeval-alls-subset
+		     (f (paramod f fp g gp))
+		     (a (free-vars (paramod f fp g gp)))
+		     (b (union-equal
+			 (free-vars f)
+			 (union-equal (free-vars g)
+				      (free-vars (paramod f fp g gp))))))
+	  ))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/permutations.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/permutations.lisp
new file mode 100644
index 0000000..122be01
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/permutations.lisp
@@ -0,0 +1,274 @@
+(in-package "ACL2")
+
+;; This book is about permutations and related stuff.
+;;
+;; It includes some congruence theorems for permutation.
+
+(include-book "sets")
+
+;;-------------------------
+;; Function remove1 (x lst) removes the first occurrence of x.
+
+; Matt K.:  Function remove1 was defined here, but has been removed for ACL2
+; Version_2.9.4 in favor of new ACL2 function remove1-equal.
+
+(defthm not-member-remove1-equal
+  (implies (not (member-equal x a))
+	   (not (member-equal x (remove1-equal y a)))))
+
+(defthm member-remove1-equal
+  (implies (and (member-equal x a)
+                (not (equal x y)))
+           (member-equal x (remove1-equal y a))))
+
+(defthm remove1-equal-commute
+  (equal (remove1-equal x (remove1-equal y a))
+         (remove1-equal y (remove1-equal x a))))
+
+(defthm subset-not-member-remove1-equal
+  (implies (and (subsetp-equal a b)
+		(not (member-equal x a)))
+	   (subsetp-equal a (remove1-equal x b))))
+
+(defthm member-not-equal-remove1-equal
+  (implies (and (member-equal a1 b)
+		(not (equal x a1)))
+	   (member-equal a1 (remove1-equal x b))))
+
+(defthm subset-not-member-subset-remove
+  (implies (and (subsetp-equal a b)
+		(not (member-equal x a)))
+	   (subsetp-equal a (remove1-equal x b))))
+
+;;----------------
+;; perm (permutation)
+
+(defun perm (a b)
+  (declare (xargs :guard (and (true-listp a) (true-listp b))))
+  (cond ((atom a) (atom b))
+        ((member-equal (car a) b) (perm (cdr a) (remove1-equal (car a) b)))
+        (t nil)))
+
+(defthm perm-reflexive
+  (perm x x))
+
+(defthm perm-cons
+  (implies (member-equal a x)
+           (equal (perm x (cons a y))
+                  (perm (remove1-equal a x) y)))
+  :hints (("Goal" :induct (perm x y))))
+
+(defthm perm-symmetric
+  (implies (perm x y) (perm y x)))
+
+(defthm perm-member
+  (implies (and (perm x y)
+                (member-equal a x))
+           (member-equal a y)))
+
+(defthm perm-remove1-equal
+  (implies (perm x y)
+           (perm (remove1-equal a x) (remove1-equal a y))))
+
+(defthm perm-transitive
+  (implies (and (perm x y) (perm y z))
+           (perm x z)))
+
+(defequiv perm)
+
+(defcong perm perm (append a b) 2)
+
+(defthm append-cons
+  (perm (append a (cons b c)) (cons b (append a c))))
+
+(defthm append-commutes
+  (perm (append a b) (append b a)))
+
+(defcong perm perm (append x y) 1
+  :hints (("Goal" :induct (append y x))))
+
+(defcong perm iff (member-equal a b) 2)
+
+;;--------------
+
+(defthm member-perm-not
+  (implies (and (perm a b)
+                (not (member-equal x a)))
+           (not (member-equal x b)))
+  :rule-classes nil)
+
+(defthm setp-remove
+  (implies (and (setp (remove1-equal x b))
+                (not (member-equal x (remove1-equal x b))))
+           (setp b))
+  :rule-classes nil)
+
+(defthm perm-setp-setp
+  (implies (and (perm a b)
+                (setp a))
+           (setp b))
+  :hints (("Subgoal *1/5'4'"
+           :use ((:instance setp-remove (x a1) (b b))
+                 (:instance member-perm-not (a a2) (b (remove1-equal a1 b)) (x a1)))
+           )))
+
+(defthm perm-not-setp-not-setp
+  (implies (and (perm a b) (not (setp a)))
+           (not (setp b))))
+
+(defcong perm iff (setp a) 1)
+
+;;--------------- subbag
+;; A bag is a multiset, that is, a collection with possible duplicates.
+;; Everything can be considered a bag, and the subbag relation
+;; considers the number of occurrences of the members.
+
+(defun subbag (x y)
+  (declare (xargs :guard (and (true-listp x) (true-listp y))))
+  (if (atom x)
+      t
+      (and (member-equal (car x) y)
+           (subbag (cdr x) (remove1-equal (car x) y)))))
+
+(defthm subbag-cons
+  (subbag l (cons x l)))
+
+(defthm subbag-append-left
+  (implies (subbag a b)
+           (subbag (append c a) (append c b))))
+
+(defthm subbag-remove1-equal
+  (implies (subbag a (remove1-equal x b))
+           (subbag a b)))
+
+(defthm remove1-equal-append-commute
+  (implies (member-equal x a)
+           (equal (remove1-equal x (append a b))
+                  (append (remove1-equal x a) b))))
+
+(defthm remove1-equal-append-commute-2
+  (implies (and (not (member-equal x a))
+                (member-equal x b))
+           (equal (remove1-equal x (append a b))
+                  (append a (remove1-equal x b)))))
+
+(defthm member-equal-append
+  (implies (and (not (member-equal x a))
+                (member-equal x (append a b)))
+           (member-equal x b)))
+
+(defthm subbag-append-right
+  (implies (subbag a b)
+           (subbag (append a c) (append b c))))
+
+(defthm first-of-subbag-is-member
+  (implies (subbag (cons x l) a)
+           (member-equal x a)))
+
+(defthm subbag-remove1-equal-member-cons
+  (implies (and (subbag a2 (remove1-equal a1 b))
+                (member-equal a1 b))
+           (subbag (cons a1 a2) b)))
+
+(defthm subbag-flip-start
+  (implies (subbag (list* x y a) b)
+           (subbag (list* y x a) b))
+  :hints (("Goal"
+           :expand ((subbag (list* x y a) b)
+                    (subbag (list* y x a) b)))
+          ("Subgoal 2"
+           :expand ((subbag (cons y a) (remove1-equal x b))))
+          ("Subgoal 1"
+           :expand ((subbag (cons y a) (remove1-equal x b))
+                    (subbag (cons x a) (remove1-equal y b))))
+          )
+  :rule-classes nil)
+
+(defthm subbag-member-cons
+  (implies (and (subbag a b)
+                (member-equal x b)
+                (not (member-equal x a)))
+           (subbag (cons x a) b))
+  :hints (("Goal"
+           :do-not generalize)
+          ("Subgoal *1/1''"
+           :expand ((subbag (cons x a) b)))
+          ("Subgoal *1/6'4'"
+           :use ((:instance subbag-flip-start (x a1) (y x) (a a2) (b b))))))
+
+(defthm subbag-not-member
+  (implies (and (subbag vs q)
+                (not (member-equal c q)))
+           (not (member-equal c vs))))
+
+(defthm subbag-trans-helper
+  (implies (and (member-equal x a)
+                (member-equal x b)
+                (subbag a b))
+           (subbag (remove1-equal x a) (remove1-equal x b))))
+
+(defthm subbag-trans
+  (implies (and (subbag a b)
+                (subbag b c))
+           (subbag a c))
+  :hints (("Goal"
+           :do-not generalize))
+  :rule-classes nil)
+
+(defthm subbag-reflexive
+  (subbag x x))
+
+;;--------------
+
+(defthm member-len-remove1-equal
+  (implies (member-equal x b)
+           (equal (len (remove1-equal x b)) (- (len b) 1))))
+
+(defthm subbag-of-same-len-is-perm
+  (implies (and (subbag a b)
+                (equal (len a) (len b)))
+           (perm a b))
+  :rule-classes nil)
+
+(defthm perm-implies-subbag
+  (implies (perm a b)
+           (subbag a b))
+  :rule-classes nil)
+
+(defthm subbag-equal-len
+  (implies (and (subbag a b)
+                (equal (len a) (len b)))
+           (subbag b a))
+  :hints (("Goal"
+           :use ((:instance subbag-of-same-len-is-perm)
+                 (:instance perm-implies-subbag (a b) (b a))))))
+
+;;-------------------------
+;; This section builds up to some congruences about permutation and disjoint.
+
+(defthm not-member-not-disjiont-not-disjoint-remove1-equal
+  (implies (and (not (member-equal x b))
+		(not (disjoint a b)))
+	   (not (disjoint (remove1-equal x a) b))))
+
+(defthm perm-disjoint-disjoint
+  (implies (and (perm a a1)
+		(disjoint a b))
+	   (disjoint a1 b))
+  :hints (("goal"
+	   :induct (perm a a1))))
+
+(defthm disjoint-remove1-equal
+  (implies (disjoint a b)
+	   (disjoint (remove1-equal x a) b)))
+
+(defthm perm-not-disjoint-not-disjoint
+  (implies (and (perm a a1)
+		(not (disjoint a b)))
+	   (not (disjoint a1 b)))
+  :hints (("goal"
+	   :induct (perm a a1))))
+
+(defcong perm equal (disjoint a b) 1)
+
+(defcong perm equal (disjoint a b) 2)
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.lisp
new file mode 100644
index 0000000..a48a703
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/prop-subsume.lisp
@@ -0,0 +1,120 @@
+(in-package "ACL2")
+
+;; In this book we define a relation (prop-subsume c d), which
+;; checks if formula c propositionally subsumes formula d.
+;; This is intended for quantifier-free formulas (in particular,
+;; clauses and lists of clauses), but it is sound for all formulas.
+;; For quantified formulas, prop-subsume is true iff the formulas
+;; are equal.
+;;
+;; Soundness: if (prop-subsume c d), then
+;; (univ-closure c) => (univ-closure d).
+;;
+;; This is not propositionally complete; that is, it is weaker
+;; than "implies".
+
+(include-book "stage")
+
+(defun prop-subsume (c d)
+  (declare (xargs :guard (and (wff c) (wff d))
+		  :measure (+ (acl2-count c) (acl2-count d))))
+  (cond ((equal c d) t)
+	((equal c 'false) t)
+	((equal d 'true) t)
+	((and (wfnot c) (equal (a1 c) 'true)) t)
+	((and (wfnot d) (equal (a1 d) 'false)) t)
+	;;
+	;; The order of these tests is important.
+	;; For example, if the last test is moved to the front,
+	;; (prop-subsume '(or (p) (q)) '(or (p) (or (q) (r))))
+	;; will fail.
+	;;
+	((wfor c)  (and (prop-subsume (a1 c) d)
+			(prop-subsume (a2 c) d)))
+	((wfand d) (and (prop-subsume c (a1 d))
+			(prop-subsume c (a2 d))))
+	((wfand c) (or  (prop-subsume (a1 c) d)
+		        (prop-subsume (a2 c) d)))
+	((wfor d)  (or  (prop-subsume c (a1 d))
+			(prop-subsume c (a2 d))))
+	(t nil)))
+
+;; Some tests:
+;; (prop-subsume '(or (p) (q)) '(or (p) (or (q) (r))))
+;;
+;; (prop-subsume
+;;  '(and (and (or (p) (q)) (r)) (or (s) (or (t) (u))))
+;;  '(or (r) (r1)))
+
+;; Using this induction scheme is somewhat faster than using prop-subsume
+;; on the following theorem.
+
+(defun prop-subsume-i (c d)
+  (declare (xargs :guard (and (wff c) (wff d))
+		  :measure (+ (acl2-count c) (acl2-count d))))
+  (cond ((equal c d) 'junk)
+	((equal c 'false) 'junk)
+	((equal d 'true) 'junk)
+	((and (wfnot c) (equal (a1 c) 'true)) 'junk)
+	((and (wfnot d) (equal (a1 d) 'false)) 'junk)
+	((wfor c)  (cons (prop-subsume-i (a1 c) d)
+			 (prop-subsume-i (a2 c) d)))
+	((wfand d) (cons (prop-subsume-i c (a1 d))
+			 (prop-subsume-i c (a2 d))))
+	((wfand c) (cons (prop-subsume-i (a1 c) d)
+			 (prop-subsume-i (a2 c) d)))
+	((wfor d)  (cons (prop-subsume-i c (a1 d))
+			 (prop-subsume-i c (a2 d))))
+	(t nil)))
+
+(defthm subst-free-preserves-prop-subsume  ;; very long time
+  (implies (prop-subsume c d)
+	   (prop-subsume (subst-free c x tm) (subst-free d x tm)))
+  :hints (("Goal"
+	   :induct (prop-subsume-i c d))))
+
+(defthm prop-subsume-ground-xsound
+  (implies (and (prop-subsume c d)
+		(xeval c dom i))
+	   (xeval d dom i))
+  :hints (("Goal"
+	   :induct (prop-subsume c d)))
+  :rule-classes nil)
+
+(defthm car-of-alls-is-all
+  (implies (consp vars)
+	   (equal (car (alls vars f)) 'all)))
+
+(defthm prop-subsume-xsound-vars
+  (implies (and (prop-subsume c d)
+		(var-set vars)
+		(xeval (alls vars c) dom i))
+	   (xeval (alls vars d) dom i))
+  :hints (("Goal"
+	   :induct (var-induct-2 vars c d dom i))
+	  ("Subgoal *1/1'''"
+	   :use ((:instance prop-subsume-ground-xsound))
+	   ))
+  :rule-classes nil)
+
+;; Now, get it in terms of universal closure.
+
+(local (include-book "close"))  ;; for xeval-alls-subset
+
+(defthm prop-subsume-xsound
+  (implies (and (prop-subsume c d)
+		(xeval (universal-closure c) (domain i) i))
+	   (xeval (universal-closure d) (domain i) i))
+  :hints (("Goal"
+           :do-not-induct t
+	   :use ((:instance xeval-alls-subset
+			    (f c)
+			    (a (free-vars c))
+			    (b (union-equal (free-vars c) (free-vars d))))
+		 (:instance xeval-alls-subset
+			    (f d)
+			    (a (free-vars d))
+			    (b (union-equal (free-vars c) (free-vars d))))
+		 (:instance prop-subsume-xsound-vars
+			    (vars (union-equal (free-vars c) (free-vars d)))
+			    (dom (domain i)))))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/prover.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/prover.lisp
new file mode 100644
index 0000000..7aed730
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/prover.lisp
@@ -0,0 +1,90 @@
+(in-package "ACL2")
+
+;; This book contains the top definitions and soundness theorems for
+;; the refutation and proof procedures.
+;;
+;; The eight components of the refutation procedure:
+
+(include-book "nnf")            ; nnf
+(include-book "rename-top")     ; rename-all
+(include-book "skolem-top"  )   ; skolemize
+(include-book "cnf")            ; cnf
+(include-book "right-assoc")    ; ANDs and ORs
+(include-book "pull-top")       ; pull-quants
+(include-book "derive")         ; refute-n-check
+(include-book "simplify")       ; simp-tf
+
+;;-----------------------
+;; Function refutation-attempt composes all of the operations.
+;;
+;; Verifying the guard of refutation-attempt is important and nontrivial,
+;; because each operation expects its input to be in a particular form.
+
+(defun refutation-attempt (f)
+  (declare (xargs :guard (and (wff f) (not (free-vars f)))))
+  (simp-tf
+   (refute-n-check
+    (right-assoc
+     (cnf
+      (pull-quants
+       (skolemize
+	(rename-all
+	 (nnf f)))))))))
+
+;; Soundness of refutation-attempt.
+;; Note that we skolem-extend the interpretation for the initial
+;; part of the refutation-attempt.
+
+(defthm refutation-attempt-fsound
+  (equal (feval (refutation-attempt f)
+		(skolemize-extend (rename-all (nnf f)) i))
+	 (feval f i))
+  :rule-classes nil)
+
+(in-theory (disable refutation-attempt))
+
+;; If the refutation attempt gives 'false, we have a refutation.
+;; This is a top function, so check the guard.
+
+(defun refuted (f)
+  (declare (xargs :guard (and (wff f) (not (free-vars f)))))
+  (if (not (and (wff f) (not (free-vars f))))
+      nil
+    (equal (refutation-attempt f) 'false)))
+
+;; A refuted formula is false in all interpretations.
+
+(defthm refutation-is-fsound  ;; Top Theorem #1
+  (implies (refuted f)
+	   (and (wff f)
+		(not (free-vars f))
+		(not (feval f i))))
+  :hints (("Goal"
+	   :use refutation-attempt-fsound))
+  :rule-classes nil)
+
+(in-theory (disable refuted))
+
+;; Now, state it positively.  That is, if we refute the negation of
+;; a formula f, then f is true in all interpretations.
+;; This is a top function, so check the guard.
+
+(defun proved (f)
+  (declare (xargs :guard (and (wff f) (not (free-vars f)))))
+  (if (not (and (wff f) (not (free-vars f))))
+      nil
+    (refuted (list 'not f))))
+
+;; The main event.  A proved formula is true in all interpretations.
+
+(defthm proof-is-fsound  ;; Top Theorem #2
+  (implies (proved f)
+	   (and (wff f)
+		(not (free-vars f))
+		(feval f i)))
+  :hints (("Goal"
+	   :use ((:instance refutation-is-fsound (f (list 'not f))))))
+  :rule-classes nil)
+
+(in-theory (disable proved))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.lisp
new file mode 100644
index 0000000..4b56b73
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-pulls.lisp
@@ -0,0 +1,280 @@
+(in-package "ACL2")
+
+;; Here we prove that (pull f) brings all of the quantifiers to
+;; the top if f is closed, nnf, with unique quantified variables.
+
+(include-book "pull")
+
+(defmacro quant-prefix (f)
+  (list 'quantifier-free (list 'remove-leading-quants f)))
+
+(defthm ptl-quant-prefix-nnf-b
+  (implies (and (quant-prefix f)
+		(disjoint (quantified-vars f)
+			  (free-vars g))
+		(or (equal op 'and) (equal op 'or)))
+	   (quantifier-free
+	    (a1 (remove-leading-quants (pull-top-left op f g)))))
+  :hints (("Goal"
+	   :in-theory (enable not-free-is-not-free)
+	   :do-not generalize
+	   :induct (pull-top-left op f g))))
+
+(defthm ptr-quant-prefix-nnf-2-b
+  (implies (and (quant-prefix g)
+		(quantifier-free f)    ;; a little different from ptl
+		(disjoint (quantified-vars g)
+			  (free-vars f))
+		(or (equal op 'and) (equal op 'or)))
+	   (quant-prefix (pull-top-right op f g)))
+  :hints (("goal"
+	   :in-theory (enable not-free-is-not-free)
+	   :do-not generalize
+	   :induct (pull-top-right op f g))))
+
+(defthm down-right-prefix-nnf-b
+  (implies (and (or (wfand (remove-leading-quants f))
+		    (wfor (remove-leading-quants f)))
+		(quantifier-free (a1 (remove-leading-quants f)))
+		(quant-prefix (a2 (remove-leading-quants f)))
+		(disjoint (quantified-vars (a2 (remove-leading-quants f)))
+			  (free-vars (a1 (remove-leading-quants f)))))
+	   (quant-prefix (down-right f)))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (down-right f))))
+
+;;----------------------------
+
+(defthm quantifier-free-means-no-quantifiers
+  (implies (quantifier-free f)
+	   (equal (quantified-vars f) nil)))
+
+(defthm ptr-preserves-qvars
+  (implies (and (or (equal op 'and) (equal op 'or))
+		(quantifier-free f))
+	   (equal (quantified-vars (pull-top-right op f g))
+		  (quantified-vars g))))
+
+;;-----------------------
+
+(defthm disjoint-union-special-1
+  (implies
+   (and (not (disjoint e (union-equal c d)))
+	(not (member-equal x e)))
+   (not	(disjoint e (union-equal (remove-equal x c) d)))))
+
+;;----------------------------
+
+(defthm wfand-remove-quants-ptl
+  (wfand (remove-leading-quants (pull-top-left 'and f g))))
+
+(defthm wfor-remove-quants-ptl
+  (wfor (remove-leading-quants (pull-top-left 'or f g))))
+
+;;-------------------- First do 'and
+
+(defthm ptl-quant-lemma-and
+  (implies (and (disjoint (append (quantified-vars f)
+				  (quantified-vars g))
+			  (union-equal (free-vars f)
+				       (free-vars g)))
+		(setp (append (quantified-vars f)
+			      (quantified-vars g)))
+		)
+	   (disjoint (quantified-vars g)
+		     (free-vars
+		      (a1 (remove-leading-quants (pull-top-left 'and f g))))))
+  :hints (("goal"
+	   :do-not generalize
+	   :induct (pull-top-left 'and f g))))
+
+(defthm ptl-a2-and
+  (equal (a2 (remove-leading-quants (pull-top-left 'and f g))) g))
+
+(defthm heart-and
+  (implies
+   (and (quantifier-free (remove-leading-quants f))
+	(quantifier-free (remove-leading-quants g))
+	(nnfp f)
+	(nnfp g)
+	(setp (append (quantified-vars f)
+		      (quantified-vars g)))
+	(disjoint (append (quantified-vars f)
+			  (quantified-vars g))
+		  (union-equal (free-vars f)
+			       (free-vars g)))
+	)
+   (quantifier-free
+    (remove-leading-quants (down-right (pull-top-left 'and f g)))))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance down-right-prefix-nnf-b
+			    (f (pull-top-left 'and f g)))
+		 (:instance ptl-quant-prefix-nnf-b
+			    (op 'and)))
+	   :in-theory (disable down-right-prefix-nnf-b
+			       ptl-quant-prefix-nnf-b
+			       pull)))
+  :rule-classes nil)
+
+(defthm heart-and-fix
+  (implies (and (quantifier-free (remove-leading-quants (pull f)))
+		(quantifier-free (remove-leading-quants (pull g)))
+		(nnfp f)
+		(nnfp g)
+		(setp (append (quantified-vars f)
+			      (quantified-vars g)))
+		(disjoint (append (quantified-vars f)
+				  (quantified-vars g))
+			  (union-equal (free-vars f)
+				       (free-vars g))))
+	   (quantifier-free
+	    (remove-leading-quants (down-right (pull-top-left 'and
+							      (pull f)
+							      (pull g))))))
+  :hints (("goal"
+	   :do-not-induct t
+	   :hands-off (pull down-right pull-top-left)
+           :use ((:instance heart-and (f (pull f)) (g (pull g)))))))
+
+;;----------------- now do 'or
+
+(defthm ptl-quant-lemma-or
+  (implies (and (disjoint (append (quantified-vars f)
+				  (quantified-vars g))
+			  (union-equal (free-vars f)
+				       (free-vars g)))
+		(setp (append (quantified-vars f)
+			      (quantified-vars g))))
+	   (disjoint (quantified-vars g)
+		     (free-vars
+		      (a1 (remove-leading-quants (pull-top-left 'or f g))))))
+  :hints (("goal"
+	   :do-not generalize
+	   :induct (pull-top-left 'or f g))))
+
+(defthm ptl-a2-or
+  (equal (a2 (remove-leading-quants (pull-top-left 'or f g))) g))
+
+(defthm heart-or
+  (implies
+   (and (quantifier-free (remove-leading-quants f))
+	(quantifier-free (remove-leading-quants g))
+	(nnfp f)
+	(nnfp g)
+	(setp (append (quantified-vars f)
+		      (quantified-vars g)))
+	(disjoint (append (quantified-vars f)
+			  (quantified-vars g))
+		  (union-equal (free-vars f)
+			       (free-vars g))))
+   (quantifier-free
+    (remove-leading-quants (down-right (pull-top-left 'or f g)))))
+  :hints (("goal"
+	   :do-not-induct t
+	   :use ((:instance down-right-prefix-nnf-b
+			    (f (pull-top-left 'or f g)))
+		 (:instance ptl-quant-prefix-nnf-b
+			    (op 'or)))
+	   :in-theory (disable down-right-prefix-nnf-b
+			       ptl-quant-prefix-nnf-b
+			       pull)))
+  :rule-classes nil)
+
+(defthm heart-or-fix
+  (implies (and (quantifier-free (remove-leading-quants (pull f)))
+		(quantifier-free (remove-leading-quants (pull g)))
+		(nnfp f)
+		(nnfp g)
+		(setp (append (quantified-vars f)
+			      (quantified-vars g)))
+		(disjoint (append (quantified-vars f)
+				  (quantified-vars g))
+			  (union-equal (free-vars f)
+				       (free-vars g))))
+	   (quantifier-free
+	    (remove-leading-quants (down-right (pull-top-left 'or
+							      (pull f)
+							      (pull g))))))
+  :hints (("goal"
+	   :do-not-induct t
+	   :hands-off (pull down-right pull-top-left)
+           :use ((:instance heart-or (f (pull f)) (g (pull g)))))))
+
+;;-----------------------
+;; dvprop - a formula has this property if, at each subformula,
+;; the free variables are disjoint from the quantified variables.
+
+(defun dvprop (f)
+  (declare (xargs :guard (wff f)))
+  (and (disjoint (quantified-vars f)
+		 (free-vars f))
+       (cond ((wfnot f) (dvprop (a1 f)))
+	     ((wfbinary f) (and (dvprop (a1 f)) (dvprop (a2 f))))
+	     ((wfquant f) (dvprop (a2 f)))
+	     (t t))))
+
+(defthm dvprop-ptl
+  (implies (and (or (equal op 'and) (equal op 'or))
+		(setp (quantified-vars (list op f g)))
+		(dvprop (list op f g)))
+	   (dvprop (pull-top-left op f g)))
+  :hints (("Goal"
+	   :induct (pull-top-left op f g))))
+
+(defthm pull-prefix-quant-1
+  (implies (and (nnfp f)
+		(setp (quantified-vars f))
+		(dvprop f))
+	   (quantifier-free (remove-leading-quants (pull f))))
+  :hints (("Goal"
+	   :induct (pull f)
+	   :do-not generalize)))
+
+;; If the quantified variables are a setp, and the disjointness
+;; property holds at the top, then the disjointness property
+;; holds everywhere.
+
+(defthm setp-quants-disjoint-dvprop
+  (implies (and (setp (quantified-vars f))
+		(disjoint (quantified-vars f)
+			  (free-vars f)))
+	   (dvprop f))
+  :rule-classes nil)
+
+;;-----------------------------------
+;; Here are the theorems for pull and for pull-quants.
+
+(defthm pull-pulls
+  (implies (and (nnfp f)
+		(setp (quantified-vars f))
+		(not (free-vars f)))
+	   (quantifier-free (remove-leading-quants (pull f))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :hands-off (pull)
+	   :use ((:instance setp-quants-disjoint-dvprop)))))
+
+(defthm pull-quants-pulls
+  (implies (and (nnfp f)
+		(setp (quantified-vars f))
+		(not (free-vars f)))
+	   (quantifier-free (remove-leading-quants (pull-quants f))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :hands-off (pull)
+           :in-theory (enable pull-quants))))
+
+;;------------------------------------------
+
+(defthm pull-quants-pulls-2
+  (implies (and (nnfp f)
+		(not (free-vars f))
+		(setp (quantified-vars f))
+		(equal (exists-count f) 0))
+	   (universal-prefix-nnf (pull-quants f)))
+  :hints (("Goal"	
+	   :in-theory (disable pull)
+	   :do-not-induct t)))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.lisp
new file mode 100644
index 0000000..fd96111
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-sound.lisp
@@ -0,0 +1,337 @@
+(in-package "ACL2")
+
+;; Soundness of the pull-quant functions.
+
+(include-book "pull")
+
+;;---------------------------------------------------------------------
+;; Soundness of pull-top-left and pull-top-right.
+;;
+;; There are 8 cases: and/or, left/right, and both directions of <=>.
+;; All 8 cases do induction using meval-i.  I'd like to find a
+;; simpler way to prove this.
+;;
+;; Working on this caused me to write the first mutually
+;; recursive evaluation function (thanks to the ACL2 docs for the
+;; clear mutual recursion example).  Because the mutually
+;; recursive eval function is clearest, it is now the official eval.
+
+(defthm subst-ptr-dist
+  (implies (and (not (free-occurrence x a))
+		(or (equal op 'and) (equal op 'or)))
+	   (equal (subst-free (pull-top-right op a b) x e)
+		  (pull-top-right op a (subst-free b x e))))
+  :hints (("Goal"
+           :in-theory (enable not-free-not-change))))
+
+;; 'or for pull-top-right
+
+(defthm ptr-or-fsound-1-mutual
+  (if flg
+      (implies (feval (pull-top-right 'or f g) i)
+	       (feval (list 'or f g) i))
+    (implies (and (wfquant (pull-top-right 'or f g))
+		  (wfquant g)
+		  (feval-d (pull-top-right 'or f g) dom i))
+	     (or (feval f i)
+		 (feval-d g dom i))))
+  :hints (("Goal"
+           :induct (feval-i flg g dom i)))
+  :rule-classes nil)
+
+(defthm ptr-or-fsound-2-mutual
+  (if flg
+      (implies (feval (list 'or f g) i)
+	       (feval (pull-top-right 'or f g) i))
+    (implies (and (wfquant g)
+		  (wfquant (pull-top-right 'or f g))
+		  (or (feval f i)
+		      (feval-d g dom i)))
+	     (feval-d (pull-top-right 'or f g) dom i)))
+  :hints (("Goal"
+           :induct (feval-i flg g dom i)))
+  :rule-classes nil)
+
+(defthm ptr-or-fsound
+  (equal (feval (pull-top-right 'or f g) i)
+	 (feval (list 'or f g) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance ptr-or-fsound-1-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))
+		 (:instance ptr-or-fsound-2-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))))))
+
+;; 'and for pull-top-right
+
+(defthm ptr-and-fsound-1-mutual
+  (if flg
+      (implies (feval (pull-top-right 'and f g) i)
+	       (feval (list 'and f g) i))
+    (implies (and (wfquant g)
+		  (feval-d (pull-top-right 'and f g) dom i))
+	     (and (feval f i)
+		  (feval-d g dom i))))
+  :hints (("Goal"
+           :induct (feval-i flg g dom i)))
+  :rule-classes nil)
+
+(defthm ptr-and-fsound-2-mutual
+  (if flg
+      (implies (feval (list 'and f g) i)
+	       (feval (pull-top-right 'and f g) i))
+    (implies (and (wfquant g)
+		  (wfquant (pull-top-right 'and f g))
+		  (and (feval f i)
+		       (feval-d g dom i)))
+	     (feval-d (pull-top-right 'and f g) dom i)))
+  :hints (("Goal"
+           :induct (feval-i flg g dom i)))
+  :rule-classes nil)
+
+(defthm ptr-and-fsound
+  (equal (feval (pull-top-right 'and f g) i)
+	 (feval (list 'and f g) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance ptr-and-fsound-1-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))
+		 (:instance ptr-and-fsound-2-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))))))
+
+;; Ok, here is the soundness theorem for pull-top-right.
+
+(defthm ptr-fsound
+  (equal (feval (pull-top-right op f g) i)
+	 (feval (list op f g) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :expand (pull-top-right op f g)
+	   :use ((:instance ptr-and-fsound)
+		 (:instance ptr-or-fsound))
+	   :in-theory (disable feval wfquant
+			       ptr-and-fsound ptr-or-fsound))))
+
+;; Now, do EXACTLY the same thing for pull-top-left.
+
+(defthm subst-ptl-dist
+  (implies (and (not (free-occurrence x b))
+		(or (equal op 'and) (equal op 'or)))
+	   (equal (subst-free (pull-top-left op a b) x e)
+		  (pull-top-left op (subst-free a x e) b)))
+  :hints (("Goal"
+           :in-theory (enable not-free-not-change))))
+
+;; 'or for pull-top-left
+
+(defthm ptl-or-fsound-1-mutual
+  (if flg
+      (implies (feval (pull-top-left 'or f g) i)
+	       (feval (list 'or f g) i))
+    (implies (and (wfquant (pull-top-left 'or f g))
+		  (wfquant f)
+		  (feval-d (pull-top-left 'or f g) dom i))
+	     (or (feval g i)
+		 (feval-d f dom i))))
+  :hints (("Goal"
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm ptl-or-fsound-2-mutual
+  (if flg
+      (implies (feval (list 'or f g) i)
+	       (feval (pull-top-left 'or f g) i))
+    (implies (and (wfquant f)
+		  (wfquant (pull-top-left 'or f g))
+		  (or (feval g i)
+		      (feval-d f dom i)))
+	     (feval-d (pull-top-left 'or f g) dom i)))
+  :hints (("Goal"
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm ptl-or-fsound
+  (equal (feval (pull-top-left 'or f g) i)
+	 (feval (list 'or f g) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance ptl-or-fsound-1-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))
+		 (:instance ptl-or-fsound-2-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))))))
+
+;; 'and for pull-top-left
+
+(defthm ptl-and-fsound-1-mutual
+  (if flg
+      (implies (feval (pull-top-left 'and f g) i)
+	       (feval (list 'and f g) i))
+    (implies (and (wfquant f)
+		  (feval-d (pull-top-left 'and f g) dom i))
+	     (and (feval g i)
+		  (feval-d f dom i))))
+  :hints (("Goal"
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm ptl-and-fsound-2-mutual
+  (if flg
+      (implies (feval (list 'and f g) i)
+	       (feval (pull-top-left 'and f g) i))
+    (implies (and (wfquant f)
+		  (wfquant (pull-top-left 'and f g))
+		  (and (feval g i)
+		       (feval-d f dom i)))
+	     (feval-d (pull-top-left 'and f g) dom i)))
+  :hints (("Goal"
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm ptl-and-fsound
+  (equal (feval (pull-top-left 'and f g) i)
+	 (feval (list 'and f g) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance ptl-and-fsound-1-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))
+		 (:instance ptl-and-fsound-2-mutual
+			    (flg t) (dom 'junk) (i i) (f f) (g g))))))
+
+;; Ok, here is the soundness theorem for pull-top-left.
+
+(defthm ptl-fsound
+  (equal (feval (pull-top-left op f g) i)
+	 (feval (list op f g) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :expand (pull-top-left op f g)
+	   :use ((:instance ptl-and-fsound (i i) (f f) (g g))
+		 (:instance ptl-or-fsound  (i i) (f f) (g g)))
+	   :in-theory (disable feval wfquant
+			       ptl-and-fsound ptl-or-fsound))))
+
+;;========================================================================
+;; For soundness of down-right and pull, we have the hypothesis
+;; (setp (quantified-vars f)).  I'm pretty sure this is not necessary,
+;; but I didn't see how to get the proofs without it.  This not a problem,
+;; because in the the applications I envision, formulas will have that
+;; property anyway.
+
+(defthm ptr-not-bound
+  (implies (and (not (bound-occurrence x f))
+		(not (bound-occurrence x g))
+		(or (equal op 'and) (equal op 'or)))
+	   (not (bound-occurrence x (pull-top-right op f g)))))
+
+(defthm ptl-not-bound
+  (implies (and (not (bound-occurrence x f))
+		(not (bound-occurrence x g))
+		(or (equal op 'and) (equal op 'or)))
+	   (not (bound-occurrence x (pull-top-left op f g)))))
+
+(defthm down-right-not-bound
+  (implies (not (bound-occurrence x f))
+	   (not (bound-occurrence x (down-right f)))))
+
+(defthm pull-not-bound
+  (implies (not (bound-occurrence x f))
+	   (not (bound-occurrence x (pull f))))
+  :hints (("Goal"
+           :in-theory (disable down-right))))
+
+;; The next few thms need (the explosive) not-free-not-change.
+
+(in-theory (enable not-free-not-change))
+
+(defthm subst-ptr-dist-not-bound
+  (implies (and (or (equal op 'and) (equal op 'or))
+		(not (bound-occurrence x b))
+		(domain-term e))
+	   (equal (subst-free (pull-top-right op a b) x e)
+		  (pull-top-right op (subst-free a x e) (subst-free b x e)))))
+
+(defthm subst-ptl-dist-not-bound
+  (implies (and (or (equal op 'and) (equal op 'or))
+		(not (bound-occurrence x a))
+		(domain-term e))
+	   (equal (subst-free (pull-top-left op a b) x e)
+		  (pull-top-left op (subst-free a x e) (subst-free b x e)))))
+
+(defthm subst-down-right-commute
+  (implies (and (not (bound-occurrence x f))
+		(domain-term e))
+	   (equal (subst-free (down-right f) x e)
+		  (down-right (subst-free f x e)))))
+
+(defthm subst-pull-commute
+  (implies (and (not (bound-occurrence x f))
+		(domain-term e))
+	   (equal (subst-free (pull f) x e)
+		  (pull (subst-free f x e))))
+  :hints (("Goal"
+           :in-theory (disable down-right))))
+
+(in-theory (disable not-free-not-change))  ;; back in its cage
+
+(defthm down-right-fsound-mutual
+  (implies (setp (quantified-vars f))
+	   (if flg
+	       (equal (feval (down-right f) i)
+		      (feval f i))
+	       (implies (and (domain-term-list (fringe dom))
+			     (wfquant f))
+			(equal (feval-d (down-right f) dom i)
+			       (feval-d f dom i)))))
+  :hints (("Goal"
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm down-right-fsound
+  (implies (setp (quantified-vars f))
+	   (equal (feval (down-right f) i)
+		  (feval f i)))
+  :hints (("Goal"
+	   :by (:instance down-right-fsound-mutual (flg t)))))
+
+;;=======================
+;; The last part is to prove (pull f) fsound.
+
+(defthm setp-append-qvars-pull
+  (implies (setp (append (quantified-vars f)
+			 (quantified-vars g)))
+	   (setp (append (quantified-vars (pull f))
+			 (quantified-vars (pull g)))))
+  :hints (("Goal"
+           :in-theory (disable pull set-equal))))
+
+(defthm pull-fsound-mutual
+  (implies (setp (quantified-vars f))
+	   (if flg
+	       (equal (feval (pull f) i)
+		      (feval f i))
+	       (implies (and (domain-term-list (fringe dom))
+			     (wfquant f))
+			(equal (feval-d (pull f) dom i)
+			       (feval-d f dom i)))))
+  :hints (("Goal"
+	   :in-theory (disable down-right)
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+;;---------------
+
+(defthm pull-fsound
+  (implies (setp (quantified-vars f))
+	   (equal (feval (pull f) i)
+		  (feval f i)))
+  :hints (("Goal"
+	   :by (:instance pull-fsound-mutual (flg t)))))
+
+;;----------------
+
+(defthm pull-quants-fsound
+  (equal (feval (pull-quants f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :in-theory (disable pull))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.lisp
new file mode 100644
index 0000000..61b55e5
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull-top.lisp
@@ -0,0 +1,49 @@
+(in-package "ACL2")
+
+;; Function pull-quants pulls quantifiers to the top of a formula.
+;; Here we gather the definitions and top lemmas.
+
+(include-book "pull")
+
+;;-----------------------------------
+
+(encapsulate
+ nil
+
+ (local (include-book "pull-sound"))
+
+ ;; This event is redundant.  Its occurrence here makes it global.
+
+ (defthm pull-quants-fsound
+   (equal (feval (pull-quants f) i)
+	  (feval f i)))
+ )
+
+;;-----------------------------------
+
+(encapsulate
+ nil
+
+ (local (include-book "pull-pulls"))
+
+ ;; These events are redundant.  Their occurrences here make them global.
+
+ (defthm pull-quants-pulls
+   (implies (and (nnfp f)
+		 (setp (quantified-vars f))
+		 (not (free-vars f)))
+	    (quantifier-free (remove-leading-quants (pull-quants f)))))
+
+ (defthm pull-quants-pulls-2
+   (implies (and (nnfp f)
+		 (not (free-vars f))
+		 (setp (quantified-vars f))
+		 (equal (exists-count f) 0))
+	    (universal-prefix-nnf (pull-quants f))))
+ )
+
+;;-----------------------------------
+;; Pull-quants is nonrecursive---we have to disable it
+;; so the preceding results can be used.
+
+(in-theory (disable pull-quants))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull.lisp
new file mode 100644
index 0000000..4f4b877
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/pull.lisp
@@ -0,0 +1,278 @@
+(in-package "ACL2")
+
+;; The pull books are arranged like this:
+;;
+;;        pull-top
+;;          /  \
+;; pull-pulls  pull-sound
+;;          \  /
+;;          pull
+;;
+;; This book (pull) has the main definitions and some
+;; preservation-of-property theorems.  The top definition
+;; is (pull-quants f), which pulls quantifiers to the
+;; top of a formula.
+
+(include-book "wfftype")
+(include-book "permutations")
+
+;;--------------------------------------
+;; Function pull (f) moves quantifiers toward the root of a formula
+;; as much as possible, using rules like
+;; (or p (all x q)) <=> (all x (or p q)) if x is not free in p.
+;; Bound variables are NOT renamed.  If all bound variables are
+;; unique, the formula is closed nnf, then all quantifiers should
+;; come to the top.  (That property proved elsewhere.)  Here,
+;; we define the functions and prove soundness.
+;;
+;; Pull-top-left pulls quantifiers up from the left side, and
+;; pull-top-right from the right side.
+;;
+;; The first functions I wrote were a little simpler than these.
+;; Originally, when pull-top right got to the base case, it called
+;; pull-top-left.  Now, they are independent (and the same except for
+;; left/right):  we first pull-top-left, then call down-right,
+;; which goes back down to the 'and or 'or and calls pull-top-right.
+;;
+;;     or                      q1                   q1
+;;    / \           ->         q2        ->         q2
+;;   q1 q3    pull-top-left    or    down-right     q3
+;;   q2 q4                    / \  (pull-top-right) q4
+;;   A   B                   A  q3                  or
+;;                              q4                 / \
+;;                               B                A   B
+;;
+;; I changed to the current version, because I had trouble getting
+;; a soundness proof for the original.
+
+(defun pull-top-right (op f g)
+  (declare (xargs :guard (and (or (equal op 'and) (equal op 'or))
+			      (wff f) (nnfp f)
+			      (wff g) (nnfp g))))
+  (if (and (or (equal op 'and) (equal op 'or))
+	   (wfquant g)
+	   (not (free-occurrence (a1 g) f)))
+      (list (car g) (a1 g) (pull-top-right op f (a2 g)))
+      (list op f g)))
+
+(defun pull-top-left (op f g)
+  (declare (xargs :guard (and (or (equal op 'and) (equal op 'or))
+			      (wff f) (nnfp f)
+			      (wff g) (nnfp f))))
+  (if (and (or (equal op 'and) (equal op 'or))
+	   (wfquant f)
+	   (not (free-occurrence (a1 f) g)))
+      (list (car f) (a1 f) (pull-top-left op (a2 f) g))
+      (list op f g)))
+
+(defun down-right (f)
+  (declare (xargs :guard (and (wff f) (nnfp f))))
+  (cond ((wfquant f) (list (car f) (a1 f) (down-right (a2 f))))
+	((or (wfand f)
+	     (wfor f)) (pull-top-right (car f) (a1 f) (a2 f)))
+	(t f)))
+
+;; Beware!  Something about pull, I don't know what, causes
+;; rewrite explosions.  Even to get guards verified, I had to
+;; disable pull.  In other proofs below, down-right is disabled,
+;; which helps somewhat.
+
+(defun pull (f)
+  (declare (xargs :guard (and (wff f) (nnfp f))
+		  :verify-guards nil))
+  (cond ((or (wfand f)
+	     (wfor f)) (down-right (pull-top-left (car f)
+						  (pull (a1 f))
+						  (pull (a2 f)))))
+	((wfquant f) (list (car f) (a1 f) (pull (a2 f))))
+	(t f)))
+
+;;---------------
+;; Prove the the pull functions preserve wff and nnfp, and finally
+;; verify guards for pull.
+
+(defthm pull-top-right-wff
+  (implies (and (wff f)
+		(wff g)
+		(or (equal op 'and) (equal op 'or)
+		    (equal op 'imp) (equal op 'iff)))
+	   (wff (pull-top-right op f g))))
+
+(defthm pull-top-right-nnfp
+  (implies (and (nnfp f)
+		(nnfp g)
+		(or (equal op 'and) (equal op 'or)))
+	   (nnfp (pull-top-right op f g)))
+  :hints (("Goal"
+	   :induct (pull-top-right op f g))))
+
+(defthm pull-top-left-wff
+  (implies (and (wff f)
+		(wff g)
+		(or (equal op 'and) (equal op 'or)
+		    (equal op 'imp) (equal op 'iff)))
+	   (wff (pull-top-left op f g))))
+
+(defthm pull-top-left-nnfp
+  (implies (and (nnfp f)
+		(nnfp g)
+		(or (equal op 'and) (equal op 'or)))
+	   (nnfp (pull-top-left op f g)))
+  :hints (("Goal"
+	   :induct (pull-top-left op f g))))
+
+(defthm down-right-wff
+  (implies (wff f)
+	   (wff (down-right f))))
+
+(defthm down-right-nnfp
+  (implies (nnfp f)
+	   (nnfp (down-right f)))
+  :hints (("Goal"
+	   :induct (down-right f))))
+
+(defthm pull-wff
+  (implies (wff f)
+	   (wff (pull f)))
+  :hints (("Goal"
+           :in-theory (disable down-right))))
+
+(defthm pull-nnfp
+  (implies (nnfp f)
+	   (nnfp (pull f)))
+  :hints (("Goal"
+           :in-theory (disable down-right))))
+
+(verify-guards pull
+  :hints (("Goal"
+           :in-theory (disable pull))))
+
+;;----------------------------------------
+;; Here is a wrapper for pull.  This checks the (unnecessary I think) setp
+;; condition in the soundness theorem.
+
+(defun pull-quants (f)
+  (declare (xargs :guard (and (wff f) (nnfp f))))
+  (if (setp (quantified-vars f))
+      (pull f)
+    f))
+
+(defthm pull-quants-wff
+  (implies (wff f)
+	   (wff (pull-quants f)))
+  :hints (("Goal"
+           :in-theory (disable pull))))
+
+(defthm pull-quants-nnfp
+  (implies (nnfp f)
+	   (nnfp (pull-quants f)))
+  :hints (("Goal"
+           :in-theory (disable pull))))
+
+;;---------------
+;; Show that each pull functions preserves the set of free variables.
+
+(defthm ptr-preserves-free-vars
+  (implies (or (equal op 'and) (equal op 'or))
+	   (equal (free-vars (pull-top-right op f g))
+		  (union-equal (free-vars f) (free-vars g))))
+  :hints (("Goal"
+	   :induct (pull-top-right op f g))))
+
+(defthm ptl-preserves-free-vars
+  (implies (or (equal op 'and) (equal op 'or))
+	   (equal (free-vars (pull-top-left op f g))
+		  (union-equal (free-vars f) (free-vars g))))
+  :hints (("Goal"
+	   :induct (pull-top-left op f g))))
+
+(defthm down-right-preserves-free-vars
+  (equal (free-vars (down-right f))
+	 (free-vars f))
+  :hints (("Goal"
+	   :induct (down-right f))))
+
+(defthm pull-preserves-free-vars
+  (equal (free-vars (pull f))
+	 (free-vars f))
+  :hints (("Goal"
+	   :induct (pull f))))
+
+(defthm pull-quants-preserves-free-vars
+  (equal (free-vars (pull-quants f))
+	 (free-vars f))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :in-theory (disable pull))))
+
+;;------------------------------------
+;; The various operations preserve the set of quantified variables.
+;; Note equality for pull-top-right, permutation for the rest.
+;; (If the original formula is closed nnf with unique quantified
+;; variables, all quantifiers come to the top, then does equality hold.
+;; If I had proved this, some later things would have been simpler.)
+
+(defthm ptl-preserves-qvars
+  (implies (and (or (equal op 'and) (equal op 'or)))
+	   (equal (quantified-vars (pull-top-left op f g))
+		  (append (quantified-vars f)
+			  (quantified-vars g)))))
+
+(defthm ptr-unique-qvars-2
+  (implies (or (equal op 'and) (equal op 'or))
+	   (perm (quantified-vars (pull-top-right op f g))
+		 (append (quantified-vars f)
+			 (quantified-vars g)))))
+
+(defthm down-right-unique-vars-2
+  (perm (quantified-vars (down-right f))
+	(quantified-vars f)))
+
+(defthm pull-unique-vars-2
+  (perm (quantified-vars (pull f))
+	(quantified-vars f))
+  :hints (("Goal"
+           :in-theory (disable down-right set-equal))))
+
+;;---------------------------
+;; The pull operations preserve exists-count.
+
+(defthm ptl-preserves-exists-count
+  (implies (or (equal op 'and) (equal op 'or))
+	   (equal (exists-count (pull-top-left op f g))
+		  (+ (exists-count f) (exists-count g))))
+  :hints (("Goal"
+	   :induct (pull-top-left op f g))))
+
+(defthm ptr-preserves-exists-count
+  (implies (or (equal op 'and) (equal op 'or))
+	   (equal (exists-count (pull-top-right op f g))
+		  (+ (exists-count f) (exists-count g))))
+  :hints (("Goal"
+	   :induct (pull-top-right op f g))))
+
+(defthm down-right-preserves-exists-count
+  (equal (exists-count (down-right f))
+	 (exists-count f))
+  :hints (("Goal"
+	   :induct (down-right f))))
+
+(defthm pull-preserves-exists-count
+  (equal (exists-count (pull f))
+	 (exists-count f))
+  :hints (("Goal"
+           :in-theory (disable pull-top-left pull-top-right down-right))))
+
+(defthm pull-quants-preserves-exists-count
+  (equal (exists-count (pull-quants f))
+	 (exists-count f))
+  :hints (("Goal"
+           :in-theory (disable pull-top-left pull-top-right down-right))))
+
+;;------------
+
+(defthm pull-quants-setp
+  (implies (setp (quantified-vars f))
+	   (setp (quantified-vars (pull-quants f))))
+  :hints (("Goal"
+	   :in-theory (disable pull))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.lisp
new file mode 100644
index 0000000..929867f
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-sound.lisp
@@ -0,0 +1,85 @@
+(in-package "ACL2")
+
+;; This book contains the soundess proof for (rename-all f),
+;; which is defined in the book "rename".
+
+(include-book "rename")
+(include-book "xeval")
+
+;----------------------------
+
+(defthm rename-bound-xsound-top-quant-equal
+  (implies (and (wfquant f)
+		(variable-term y)
+	        (not (bound-occurrence y f))
+		(not (free-occurrence y f)))
+	   (equal (xeval (rename-bound f (a1 f) y) dom i)
+		  (xeval f dom i)))
+  :hints (("Goal"
+	   :induct (dom-i dom)
+	   )))
+
+(defthm subst-rename-commute
+  (implies (and (domain-term e)
+		(variable-term z)
+		(variable-term y)
+	        (not (equal y z)))
+	   (equal (subst-free (rename-bound f x y) z e)
+		  (rename-bound (subst-free f z e) x y))))
+
+(defthm rename-bound-xsound
+  (implies (and (variable-term y)
+	        (not (bound-occurrence y f))
+		(not (free-occurrence y f))
+		(domain-term-list (fringe dom))
+		)
+	   (equal (xeval (rename-bound f x y) dom i)
+		  (xeval f dom i)))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i))))
+
+;-------
+
+(defthm not-bound-occurrence-rename-bound
+  (implies (and (not (bound-occurrence v f))
+		(not (equal y v)))
+	   (not (bound-occurrence v (rename-bound f x y)))))
+
+(defthm not-free-occurrence-rename-bound
+  (implies (and (not (free-occurrence v f))
+		(not (equal y v)))
+	   (not (free-occurrence v (rename-bound f x y)))))
+
+(defthm all-safe-rename-bound
+  (implies (and (not (member-equal y vars))
+		(var-set vars)
+		(not (bound-occurrence y f))
+		(not (free-occurrence y f))
+		(all-safe vars f))
+	   (all-safe vars (rename-bound f x y)))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm rename-bunch-xsound
+  (implies (and (var-set newvars)
+		(all-safe newvars f))
+	   (equal (xeval (rename-bunch f oldvars newvars) (domain i) i)
+		  (xeval f (domain i) i)))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (rename-bunch f oldvars newvars))))
+
+(defthm rename-all-xsound
+  (equal (xeval (rename-all f) (domain i) i)
+	 (xeval f (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t)))
+
+;; Now state it in terms of the official evaluation function feval.
+
+(defthm rename-all-fsound
+  (equal (feval (rename-all f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.lisp
new file mode 100644
index 0000000..230e35a
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-top.lisp
@@ -0,0 +1,44 @@
+(in-package "ACL2")
+
+;; Function (rename-all f), defined in book "rename", renames
+;; all bound variables.
+;;
+;; This book brings together the three rename books.
+
+(include-book "rename")
+
+;;-----------------------------------
+
+(encapsulate
+ nil
+
+ (local (include-book "rename-sound"))
+
+ ;; This event is redundant.  Its occurrence here makes it global.
+
+ (defthm rename-all-fsound
+   (equal (feval (rename-all f) i)
+	  (feval f i)))
+ )
+
+;;-----------------------------------
+
+(encapsulate
+ nil
+
+ (local (include-book "rename-unique"))
+
+ ;; This event is redundant.  Its occurrence here makes it global.
+
+ (defthm rename-all-setp-qvars
+   (setp (quantified-vars (rename-all f))))
+
+ )
+
+;;-----------------------------------
+
+;; rename-all is nonrecursive, and we have to disable it
+;; so the preceding results can be used.
+
+(in-theory (disable rename-all))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.lisp
new file mode 100644
index 0000000..0eb39f8
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename-unique.lisp
@@ -0,0 +1,181 @@
+(in-package "ACL2")
+
+;; This book contains the syntactic correctness theorem for
+;; (rename-all f):   (setp (quantified-vars (rename-all f))).
+
+(include-book "rename")
+
+;; I think this book could use some cleaning up.  All we need is
+;; the last theorem, and I think it can be proved with a lot less work.
+
+;------------------------------------------------
+
+(defthm rename-bound-introduces-new-variable
+  (implies (and (bound-occurrence x f)
+		(variable-term y))
+	   (member-equal y (quantified-vars (rename-bound f x y)))))
+
+(defthm rename-bound-introduces-new-variable-2
+  (implies (and (member-equal x (quantified-vars f))
+		(variable-term y))
+	   (member-equal y (quantified-vars (rename-bound f x y))))
+  :hints (("Goal"
+	   :use ((:instance quantified-is-bound)))))
+
+(defthm rename-bound-doesnt-change-other-variables
+  (implies (and (member-equal v (quantified-vars f))
+		(variable-term y)
+		(not (equal v x)))
+	   (member-equal v (quantified-vars (rename-bound f x y)))))
+
+(defthm rename-bunch-introduces-new-variables
+  (implies (and (member-equal x (quantified-vars g))
+		(var-list new)
+		(not (member-equal x old)))
+	   (member-equal x (quantified-vars (rename-bunch g old new))))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm bound-is-quantified  ;; disabled below
+  (implies (bound-occurrence x f)
+	   (member-equal x (quantified-vars f)))
+  :hints (("Goal"
+           :use ((:instance quantified-iff-bound)))))
+
+(defthm not-bound-is-not-quantified  ;; disabled below
+  (implies (not (bound-occurrence x f))
+	   (not (member-equal x (quantified-vars f))))
+  :hints (("Goal"
+           :use ((:instance quantified-iff-bound)))))
+
+;;----------------------------
+;; Bring in subbag, because there can be duplicates in the list of
+;; original quantified variables.  Also, we will use permutation.
+
+(include-book "permutations")
+
+(defthm subbag-member-remove1-equal-append-lemma
+  (implies (and (not (member-equal x f3))
+		(subbag (remove1-equal x f5) q))
+	   (subbag (remove1-equal x (append f3 f5)) (append f3 q))))
+
+(defthm subbag-remove1-equal-qvars-lemma-1
+  (implies (variable-term y)
+	   (subbag (remove1-equal x (quantified-vars f))
+		   (quantified-vars (rename-bound f x y)))))
+
+(in-theory (disable bound-is-quantified not-bound-is-not-quantified))
+
+(defthm subbag-remove1-equal-qvars-lemma-2
+  (implies (and (subbag vars (remove1-equal x (quantified-vars f)))
+		(variable-term y))
+	   (subbag vars (quantified-vars (rename-bound f x y))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance subbag-trans
+			    (a vars)
+			    (b (remove1-equal x (quantified-vars f)))
+			    (c (quantified-vars (rename-bound f x y))))))))
+
+(defthm disjoint-cons
+  (implies (not (disjoint a b))
+           (not (disjoint a (cons x b)))))
+
+(defthm new-vars-really-get-there-lemma
+  (implies (and (subbag old (quantified-vars f))
+		(equal (len old) (len new))
+		(disjoint new old)
+		(var-list new))
+	   (subsetp-equal new (quantified-vars (rename-bunch f old new))))
+  :hints (("Goal"
+	   :induct (rename-bunch f old new)
+	   :expand ((subbag (cons old1 old2) (quantified-vars f)))
+	   )))
+
+(defthm all-safe-vars-are-disjoint-from-quantified-vars
+  (implies (all-safe vars f)
+	   (disjoint vars (quantified-vars f))))
+
+(defthm safe-list-vars-are-disjoint-from-quantified-vars
+  (disjoint (safe-list f)
+	    (quantified-vars f))
+  :hints (("Goal"
+           :in-theory (disable safe-list))))
+
+(defthm len-qvars-equal-len-safe-vars
+  (equal (len (safe-list f))
+	 (len (quantified-vars f))))
+
+(defthm new-vars-really-get-there
+  (subsetp-equal (safe-list f)
+		 (quantified-vars (rename-all f)))
+  :hints (("Goal"
+	   :in-theory (disable safe-list))))
+
+; Now, use the fact that the new variables are a setp with the
+; same length as the set of variables after the renaming to
+; show that the permutation relation holds.  (Actually, it should
+; be equal, but I couldn't see how to prove that.)
+
+(defthm setp-subset-equal-length-perm
+  (implies (and (setp new)
+		(subsetp-equal new q)
+		(equal (len new) (len q)))
+	   (perm new q))
+  :hints (("Goal"
+	   :induct (perm new q)))
+  :rule-classes nil)
+
+;-----------------------
+; When I wrote len-append-left and len-append right positively,
+; I got a segmentation fault, I guess because of a rewrite loop.
+
+(defthm len-append-left  ;; disabled below
+  (implies (not (equal (len (append b a)) (len (append b c))))
+           (not (equal (len a) (len c)))))
+
+(defun double-list-induct (a b)
+  (declare (xargs :guard t))
+  (if (or (atom a) (atom b))
+      nil
+      (double-list-induct (cdr a) (cdr b))))
+
+(defthm len-append-right  ;; disabled below
+  (implies (not (equal (len (append a b)) (len (append c b))))
+           (not (equal (len a) (len c))))
+  :hints (("Goal"
+           :induct (double-list-induct a c))))
+
+(defthm rename-bound-preserves-len-of-qvars
+  (implies (variable-term y)
+	   (equal (len (quantified-vars (rename-bound f x y)))
+		  (len (quantified-vars f)))))
+
+(in-theory (disable len-append-left len-append-right))
+
+(defthm rename-bunch-preserves-len-of-qvars
+  (implies (var-list new)
+	   (equal (len (quantified-vars (rename-bunch f old new)))
+		  (len (quantified-vars f)))))
+
+;-----------------------
+
+(defthm safe-list-is-perm-of-qvars-rename-all
+  (perm (safe-list f)
+	(quantified-vars (rename-all f)))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance setp-subset-equal-length-perm
+			    (new (safe-list f))
+			    (q (quantified-vars (rename-all f))))))))
+
+;; The main event.
+
+(defthm rename-all-setp-qvars
+  (setp (quantified-vars (rename-all f)))
+  :hints (("Goal"
+           :in-theory (disable rename-all safe-list perm-implies-iff-setp-1)
+	   :use ((:instance perm-setp-setp
+			    (a (safe-list f))
+			    (b (quantified-vars (rename-all f))))))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename.lisp
new file mode 100644
index 0000000..530a862
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/rename.lisp
@@ -0,0 +1,225 @@
+(in-package "ACL2")
+
+;; The rename books are arranged like this:
+;;
+;;          rename-top
+;;             /  \
+;; rename-unique  rename-sound
+;;             \  /
+;;            rename
+;;
+;; This book (rename) has the main definitions and some
+;; preservation-of-property theorems.  The top definition
+;; is (rename-all f), which renames all bound variables
+;; (left-to-right, in separate passes) to unique new
+;; variable names.
+
+(include-book "wfftype")
+
+;;===================== step-wise rename
+
+;; Function rename-bound (f old new) renames the first bound occurrence
+;; of old to new.  Safeness of "new" is not checked.
+
+(defun rename-bound (f old new)
+  (declare (xargs :guard (and (wff f)
+			      (variable-term old)
+			      (variable-term new))))
+  (cond ((wfnot f) (list 'not (rename-bound (a1 f) old new)))
+	((wfbinary f) (if (bound-occurrence old (a1 f))
+			  (list (car f)
+				(rename-bound (a1 f) old new)
+				(a2 f))
+			  (list (car f)
+				(a1 f)
+				(rename-bound (a2 f) old new))))
+	((wfquant f) (if (equal (a1 f) old)
+			 (list (car f)
+			       new
+			       (subst-free (a2 f) (a1 f) new))
+		         (list (car f)
+			       (a1 f)
+			       (rename-bound (a2 f) old new))))
+	(t f)))
+
+(defthm rename-bound-wff
+  (implies (and (wff f)
+		(variable-term new))
+	   (wff (rename-bound f old new))))
+
+(defthm rename-bound-preserves-car
+  (equal (car (rename-bound f old new)) (car f)))
+
+(defthm rename-bound-preserves-nnfp
+  (implies (nnfp f)
+	   (nnfp (rename-bound f x y))))
+
+;;===============================================
+;; Function rename-bunch (f oldvars newvars) renames the members of oldvars
+;; to the corresponding members of newvars.
+
+(defun rename-bunch (f oldvars newvars)
+  (declare (xargs :guard (and (wff f) (var-list oldvars) (var-list newvars)
+			      (equal (len oldvars) (len newvars)))))
+  (if (or (atom oldvars) (atom newvars))
+      f
+      (rename-bunch (rename-bound f (car oldvars) (car newvars))
+		    (cdr oldvars) (cdr newvars))))
+
+(defthm rename-bunch-wff
+  (implies (and (wff f)
+		(var-list newvars))
+	   (wff (rename-bunch f oldvars newvars))))
+
+(defthm rename-bunch-preserves-nnfp
+  (implies (nnfp f)
+	   (nnfp (rename-bunch f old new))))
+
+;; Function (all-safe vars f) is true if no member of vars has a
+;; bound or free occurrence in formula f.
+
+(defun all-safe (vars f)
+  (declare (xargs :guard (and (wff f) (var-list vars))))
+  (cond ((atom vars) t)
+	((bound-occurrence (car vars) f) nil)
+	((free-occurrence (car vars) f) nil)
+	(t (all-safe (cdr vars) f))))
+
+;;------------------------------------------------
+;; Now what should the newvars be?
+;;
+;; Get the gensym book, define a function to get a list of new
+;; symbols, and prove some properties.
+
+(include-book "gensym-e")
+
+(defun gen-symbols (n sym lst)
+  (declare (xargs :guard (and (natp n)
+			      (symbolp sym)
+			      (symbol-listp lst))))
+  (if (zp n)
+      nil
+    (let ((newsym (gen-symbol sym lst)))
+      (cons newsym (gen-symbols (1- n) sym (cons newsym lst))))))
+
+(defthm gen-symbols-ok
+  (implies (symbolp sym)
+	   (disjoint (gen-symbols n sym lst) lst)))
+
+(defthm gen-symbols-len
+  (implies (natp n)
+	   (equal (len (gen-symbols n sym lst)) n)))
+
+(defthm member-member-not-disjoint
+  (implies (and (member-equal x a)
+		(member-equal x b))
+	   (not (disjoint a b)))
+  :rule-classes nil)
+
+(defthm gen-symbols-member
+  (implies (symbolp sym)
+	   (not (member-equal a (gen-symbols n sym (cons a lst)))))
+  :hints (("Goal"
+	   :use ((:instance member-member-not-disjoint
+			    (x a)
+			    (a (gen-symbols n sym (cons a lst)))
+			    (b (cons a lst)))))))
+
+(defthm gen-symbols-setp
+  (implies (symbolp sym)
+	   (setp (gen-symbols n sym lst))))
+
+;;------------------------------------------------
+
+(defthm var-list-symbol-listp
+  (implies (var-list lst)
+	   (symbol-listp lst)))
+
+(defun safe-list (f)
+  (declare (xargs :guard (wff f)))
+  (gen-symbols (len (quantified-vars f))
+	       'v
+	       (append (quantified-vars f) (free-vars f))))
+
+(defthm free-free-append
+  (implies (free-occurrence x f)
+	   (member-equal x (append (quantified-vars f)
+				   (free-vars f))))
+  :hints (("Goal"
+         :use ((:instance free-free)))))
+
+(defthm bound-bound-append
+  (implies (bound-occurrence x f)
+	   (member-equal x (append (quantified-vars f)
+				   (free-vars f))))
+  :hints (("Goal"
+         :use ((:instance quantified-iff-bound)))))
+
+(defthm disjoint-all-safe
+  (implies (disjoint a (append (quantified-vars f) (free-vars f)))
+	   (all-safe a f)))
+
+(defthm safe-list-all-safe
+  (all-safe (safe-list f) f))
+
+(defmacro var-set (vars)
+  (list 'and (list 'var-list vars) (list 'setp vars)))
+
+(defthm gen-symbols-var-list
+  (var-list (gen-symbols n sym lst)))
+
+(defthm safe-list-varset
+  (var-set (safe-list f)))
+
+;;---------------------------------
+;; Function (rename-all f) renames all bound variables.
+
+(defthm var-list-append
+  (implies (and (var-list qvs0)
+		(var-list qvs))
+	   (var-list (append qvs0 qvs))))
+
+(defun rename-all (f)
+  (declare (xargs :guard (wff f)))
+  (rename-bunch f (quantified-vars f) (safe-list f)))
+
+(defthm rename-all-wff
+  (implies (wff f)
+	   (wff (rename-all f))))
+
+(defthm rename-all-preserves-nnfp
+  (implies (nnfp f)
+	   (nnfp (rename-all f))))
+
+;;------------------------------------------------
+;; Prove that the rename functions preserve free-vars
+
+(defthm rename-bound-preserves-free-vars
+  (implies (and (variable-term y)
+		(not (bound-occurrence y f))
+		(not (free-occurrence y f)))
+	   (equal (free-vars (rename-bound f x y))
+		  (free-vars f))))
+
+(defthm rename-bound-doesnt-introduce-free-vars
+  (implies (not (free-occurrence z f))
+           (not (free-occurrence z (rename-bound f x y)))))
+
+(defthm rename-bound-still-safe
+  (implies (and (all-safe new2 f)
+		(not (member-equal new1 new2))
+		(not (bound-occurrence new1 f))
+		(not (free-occurrence new1 f)))
+	   (all-safe new2 (rename-bound f old1 new1))))
+
+(defthm rename-bunch-preserves-free-vars
+  (implies (and (all-safe new f)
+		(var-set new))
+	   (equal (free-vars (rename-bunch f old new))
+		  (free-vars f)))
+  :hints (("Goal"
+	   :induct (rename-bunch f old new))))
+
+(defthm rename-all-preserves-free-vars
+  (equal (free-vars (rename-all f))
+	 (free-vars f)))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/resolve.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/resolve.lisp
new file mode 100644
index 0000000..fef9c69
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/resolve.lisp
@@ -0,0 +1,243 @@
+(in-package "ACL2")
+
+(include-book "stage")
+
+;; -------------- Resolution
+;; This is resolution on identical atoms; that is, no unification is
+;; involved.  The function (resolve f1 l1 f2 l2) computes the resolvent of
+;; f1 and f2 on literals specified in position lists l1 and l2.  If the
+;; specified literals (computed by literal-at-position) do not resolve,
+;; 'true is returned.
+;;
+;; We took a shortcut: the resolvent contains 'false literals
+;; corresponding to the resolved literals, and the resolvent is not right
+;; associated.  If you need nicer resolvents, you can apply functions
+;; right-assoc and simplify (defined elsewhere).
+
+(defun exists-literal-at-position (f l)
+  (declare (xargs :guard (and (wff f) (integer-listp l))))
+  (cond ((atom l) t)
+	((wfor f) (cond ((equal (car l) 1)
+			 (exists-literal-at-position (a1 f) (cdr l)))
+			((equal (car l) 2)
+			 (exists-literal-at-position (a2 f) (cdr l)))
+			(t nil)))
+	(t nil)))
+
+(defun literal-at-position (f l)
+  (declare (xargs :guard (and (wff f) (integer-listp l))))
+  (cond ((atom l) f)
+	((wfor f) (cond ((equal (car l) 1)
+			 (literal-at-position (a1 f) (cdr l)))
+			((equal (car l) 2)
+			 (literal-at-position (a2 f) (cdr l)))
+			(t nil)))
+	(t nil)))
+
+(defmacro complements (p q)
+  (list 'or
+	(list 'equal p (list 'list ''not q))
+        (list 'equal (list 'list ''not p) q)))
+
+(defun remove-literal (f l)
+  (declare (xargs :guard (and (wff f) (integer-listp l))))
+  (cond ((atom l) 'false)
+	((wfor f) (cond ((equal (car l) 1)
+			 (list 'or (remove-literal (a1 f) (cdr l)) (a2 f)))
+			((equal (car l) 2)
+			 (list 'or (a1 f) (remove-literal (a2 f) (cdr l))))
+			(t f)))
+	(t f)))
+
+(defthm remove-literal-wff
+  (implies (wff f)
+           (wff (remove-literal f pos))))
+
+(defun resolve (f1 l1 f2 l2)
+  (declare (xargs :guard (and (wff f1) (integer-listp l1)
+			      (wff f2) (integer-listp l2))))
+  (if (and (exists-literal-at-position f1 l1)
+	   (exists-literal-at-position f2 l2)
+	   (complements (literal-at-position f1 l1)
+			(literal-at-position f2 l2)))
+      (list 'or (remove-literal f1 l1) (remove-literal f2 l2))
+    'true))
+
+(defthm resolve-wff
+  (implies (and (wff par1)
+                (wff par2))
+           (wff (resolve par1 pos1 par2 pos2))))
+
+;;----------------------------------------------------------------------------
+;; Ground soundness of resolve
+;;
+
+(defthm remove-false-unit-gsound
+  (implies (and (exists-literal-at-position f pos)
+		(not (feval (literal-at-position f pos) i)))
+	   (equal (feval (remove-literal f pos) i)
+		  (feval f i))))
+
+(defthm resolve-ground-fsound-helper
+  (implies (and (feval f i)
+		(feval g i)
+		(exists-literal-at-position f pos1)
+		(exists-literal-at-position g pos2)
+		(complements (literal-at-position f pos1)
+			     (literal-at-position g pos2))
+		(not (feval (remove-literal f pos1) i)))
+	   (feval (remove-literal g pos2) i))
+  :hints (("goal" :induct (remove-literal f pos1))))
+
+(defthm resolve-ground-fsound
+  (implies (and (feval f i)
+		(feval g i))
+	   (feval (resolve f pos1 g pos2) i)))
+
+(in-theory (disable resolve-ground-fsound-helper))
+
+(in-theory (disable resolve))
+
+;;----------------------------------------------------------------------------
+;; Soundness of resolve under universal closure
+
+(defthm remove-literal-subst-free-commute
+  (equal (remove-literal (subst-free f x tm) l)
+	 (subst-free (remove-literal f l) x tm)))
+
+(defthm literal-at-position-subst-free-commute
+  (equal (literal-at-position (subst-free f x tm) l)
+	 (subst-free (literal-at-position f l) x tm)))
+
+(defthm exists-literal-at-position-subst
+  (implies (exists-literal-at-position f pos)
+	   (exists-literal-at-position (subst-free f x tm) pos)))
+
+;; Induction scheme for resolve-fsound-alls-aux
+
+(defun alls-i-2 (vars flg f g dom i)
+  (declare (xargs :guard (and (implies (not flg)
+                                       (domain-term-list (fringe dom)))
+                              (var-list vars)
+                              (wff f)
+			      (wff g))
+                  :measure (cons (cons (+ 1 (acl2-count vars))
+                                       (if flg 2 1))
+				 (acl2-count dom))))
+  (if flg
+      (if (atom vars)
+	  nil
+	  (alls-i-2 vars nil f g (domain i) i))
+      (if (atom vars)
+          nil
+	  (if (atom dom)
+              (alls-i-2 (cdr vars) t
+		      (subst-free f (car vars) dom)
+		      (subst-free g (car vars) dom)
+		      'junk i)
+              (cons (alls-i-2 vars nil f g (car dom) i)
+                    (alls-i-2 vars nil f g (cdr dom) i))))))
+
+
+;; Note: condition (**) is added in the flg==nil case to avoid the
+;; inductive case
+;;
+;; (implies (and (feval-d f dom i)
+;;               (feval-d g dom i))
+;;          (feval-d (resolve f posf g posg) dom i))
+;;
+;; which does not hold.  We only use the feval part of this lemma.
+
+(defthm resolve-fsound-alls-aux
+  (implies (var-set vars)
+	   (if flg
+	       (implies (and (feval (alls vars f) i)
+			     (feval (alls vars g) i))
+			(feval (alls vars (resolve f posf g posg)) i))
+	       (implies (and (domain-term-list (fringe dom))
+                             (consp vars) ;; (**)
+			     (feval-d (alls vars f) dom i)
+			     (feval-d (alls vars g) dom i))
+			(feval-d (alls vars (resolve f posf g posg)) dom i))))
+  :hints (("Goal"
+	   :induct (alls-i-2 vars flg f g dom i))
+          ("Subgoal *1/3"
+	   :in-theory (enable resolve))
+          ("Subgoal *1/2"
+	   :in-theory (enable resolve)
+	   :expand (alls vars (list 'or
+				    (remove-literal f posf)
+				    (remove-literal g posg)))))
+  :rule-classes nil)
+
+(defthm resolve-fsound-alls
+  (implies (and (var-set vars)
+ 		(feval (alls vars f) i)
+		(feval (alls vars g) i))
+	   (feval (alls vars (resolve f posf g posg)) i))
+  :hints (("Goal" :by (:instance resolve-fsound-alls-aux (flg t)))))
+
+;;-----------------------------------------
+
+(encapsulate
+ nil
+ (local (include-book "close"))
+ (defthm feval-alls-subset
+   (implies (and (var-set a)
+                 (var-set b)
+                 (subsetp-equal a b)
+                 (not (free-vars (alls a f))))
+            (equal (feval (alls a f) i)
+                   (feval (alls b f) i)))
+   :rule-classes nil)
+ )
+
+;; Main theorem
+
+(defthm resolve-fsound-closure
+  (implies (and (feval (universal-closure f) i)
+                (feval (universal-closure g) i))
+           (feval (universal-closure (resolve f l1 g l2)) i))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance
+		  feval-alls-subset
+		  (f f)
+		  (a (free-vars f))
+		  (b (union-equal
+		      (free-vars f)
+		      (union-equal (free-vars g)
+				   (free-vars (resolve f l1 g l2))))))
+                 (:instance
+		  feval-alls-subset
+		  (f g)
+		  (a (free-vars g))
+		  (b (union-equal
+		      (free-vars f)
+		      (union-equal (free-vars g)
+				   (free-vars (resolve f l1 g l2))))))
+                 (:instance
+		  feval-alls-subset
+		  (f (resolve f l1 g l2))
+		  (a (free-vars (resolve f l1 g l2)))
+		  (b (union-equal
+		      (free-vars f)
+		      (union-equal (free-vars g)
+				   (free-vars (resolve f l1 g l2))))))
+                 ))))
+
+;;-----------------------------------------------------------------
+;; We need the preceding theorem in terms of xeval.
+
+(in-theory (enable xeval-feval))
+
+(defthm resolve-xsound-closure
+  (implies (and (xeval (universal-closure f) (domain i) i)
+                (xeval (universal-closure g) (domain i) i))
+           (xeval (universal-closure (resolve f l1 g l2)) (domain i) i))
+  :hints (("Goal"
+	   :use ((:instance resolve-fsound-closure))
+	   :in-theory (disable resolve-fsound-closure))))
+
+(in-theory (disable xeval-feval))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.lisp
new file mode 100644
index 0000000..d75eefa
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/right-assoc.lisp
@@ -0,0 +1,188 @@
+(in-package "ACL2")
+
+;; Define a function to right-associate conjunctions and disjunctions.
+;; Just like the other normal-form operations, we prove a syntactic
+;; correctness theorem, a soundness theorem, and several perservation of
+;; property theorems.
+;;
+;; The need for right-assoc arises from the interface to external-prover
+;; (i.e., Otter).  The external-prover isn't supposed to alter the
+;; inital proof object, but Otter always right associates it, so
+;; we have to make sure the initial proof object is right associated.
+
+(include-book "stage")
+
+(defun rat (op f g)
+  (declare (xargs :guard (and (or (equal op 'and)
+				  (equal op 'or))
+			      (wff f)
+			      (wff g))))
+  (cond ((and (equal op 'and) (wfand f)) (list op (a1 f) (rat op (a2 f) g)))
+	((and (equal op 'or)  (wfor f))  (list op (a1 f) (rat op (a2 f) g)))
+	(t (list op f g))))
+
+(defthm rat-wff
+  (implies (and (or (equal op 'and)
+		    (equal op 'or))
+		(wff f)
+		(wff g))
+	   (wff (rat op f g))))
+
+(defun right-assoc (f)  ;; I think this algorithm is unnecessarily slow
+  (declare (xargs :guard (wff f)))
+  (cond ((wfand f) (rat 'and (right-assoc (a1 f)) (right-assoc (a2 f))))
+	((wfor f) (rat 'or  (right-assoc (a1 f)) (right-assoc (a2 f))))
+	((wfbinary f) (list (car f) (right-assoc (a1 f)) (right-assoc (a2 f))))
+	((wfnot f) (list 'not (right-assoc (a1 f))))
+	((wfquant f) (list (car f) (a1 f) (right-assoc (a2 f))))
+	(t f)))
+
+(defthm right-assoc-wff
+  (implies (wff f)
+	   (wff (right-assoc f))))
+	
+(defthm rat-xsound
+  (implies (or (equal op 'and)
+	       (equal op 'or))
+	   (equal (xeval (rat op f g) dom i)
+		  (xeval (list op f g) dom i))))
+
+(defthm right-assoc-subst-free-commute
+  (equal (subst-free (right-assoc f) x tm)
+	 (right-assoc (subst-free f x tm))))
+
+(defthm right-assoc-xsound
+  (equal (xeval (right-assoc f) dom i)
+	 (xeval f dom i))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i))))
+
+(defthm right-assoc-fsound
+  (equal (feval (right-assoc f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval))))
+
+(defun right-assoc-p (f)  ;; no 'and has and 'and as left child; same for 'or.
+  (declare (xargs :guard (and (wff f))))
+  (cond ((wfand f) (and (not (wfand (a1 f)))
+			(right-assoc-p (a1 f))
+			(right-assoc-p (a2 f))))
+	((wfor f) (and (not (wfor (a1 f)))
+		       (right-assoc-p (a1 f))
+		       (right-assoc-p (a2 f))))
+	((wfbinary f) (and (right-assoc-p (a1 f))
+			   (right-assoc-p (a2 f))))
+	((wfnot f) (right-assoc-p (a1 f)))
+	((wfquant f) (right-assoc-p (a2 f)))
+	(t t)))
+
+(defthm rat-ok
+  (implies (and (right-assoc-p f)
+		(right-assoc-p g)
+		(or (equal op 'and)
+		    (equal op 'or)))
+	   (right-assoc-p (rat op f g))))
+
+(defthm right-assoc-ok
+  (right-assoc-p (right-assoc f)))
+
+;------------------------------------
+; Now, we have to prove that right-assoc preserves a bunch of properties.
+
+;; Prove that right-assoc preserves closedness.
+
+(defthm right-assoc-doesnt-introduce-free-vars
+  (implies (not (free-occurrence x f))
+	   (not (free-occurrence x (right-assoc f)))))
+
+(defthm right-assoc-preserves-closedness-almost
+  (implies (not (member-equal x (free-vars f)))
+	   (not (member-equal x (free-vars (right-assoc f)))))
+  :hints (("Goal"
+	   :use ((:instance free-free)
+		 (:instance free-free (f (right-assoc f)))))))
+
+(defthm right-assoc-preserves-closedness
+  (implies (not (free-vars f))
+	   (not (free-vars (right-assoc f))))
+  :hints (("Goal"
+	   :use ((:instance member-equal
+			    (x (car (free-vars (right-assoc f))))
+			    (lst (free-vars (right-assoc f))))
+		 (:instance member-equal
+			    (x (car (free-vars f)))
+			    (lst (free-vars f)))))))
+
+;;----------------------
+;; right-assoc preserves quantifier-free
+
+(defthm ratp-preserves-quantifier-free
+  (implies (and (quantifier-free f)
+		(quantifier-free g)
+		(or (equal op 'and)
+		    (equal op 'or)))
+	   (quantifier-free (rat op f g))))
+
+(defthm right-assoc-preserves-quantifier-free
+  (implies (quantifier-free f)
+	   (quantifier-free (right-assoc f))))
+
+;;--------------------
+;; right-assoc preserves leading-alls
+
+(defthm leading-alls-right-assoc
+  (equal (leading-alls (right-assoc f)) (leading-alls f)))
+
+;;----------------------
+;; right-assoc preserves cnfp
+
+(defthm cnfp-rat-and
+  (implies (and (cnfp f)
+		(cnfp g))
+	   (cnfp (rat 'and f g))))
+
+(defthm rat-preserves-op
+  (equal (car (rat op f g)) op))
+
+(defthm right-assoc-preserves-car
+  (equal (car (right-assoc f)) (car f)))
+
+(defthm cnfp-rat-or
+  (implies (and (not (wfand f))
+		(not (wfand g))
+		(cnfp f)
+		(cnfp g))
+	   (cnfp (rat 'or f g))))
+
+(defthm right-assoc-consp
+  (equal (consp (right-assoc f)) (consp f)))
+
+(defthm right-assoc-preserves-cnfp-helper  ;; why is this necessary??
+  (implies (and (wfor f)
+		(not (consp (cddadr f)))
+		(cnfp (right-assoc (cadr f)))
+		(cnfp (right-assoc (caddr f)))
+		(not (consp (cddadr (cdr f)))))
+	   (cnfp (rat 'or
+		      (right-assoc (cadr f))
+		      (right-assoc (caddr f)))))
+  :hints (("Goal"
+	   :use ((:instance cnfp-rat-or
+			    (f (right-assoc (cadr f)))
+			    (g (right-assoc (caddr f))))))))
+
+(defthm right-assoc-preserves-cnfp
+  (implies (cnfp f)
+	   (cnfp (right-assoc f)))
+  :hints (("Goal"
+	   :induct (cnfp f))))
+
+;;----------------------
+;; right-assoc preserves universal-prefix-cnf
+
+(defthm right-assoc-preserves-universal-prefix-cnf
+  (implies (universal-prefix-cnf f)
+	   (universal-prefix-cnf (right-assoc f)))
+  :hints (("Goal"
+	   :induct (universal-prefix-cnf f))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sets.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sets.lisp
new file mode 100644
index 0000000..48ad586
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sets.lisp
@@ -0,0 +1,427 @@
+(in-package "ACL2")
+
+;; This book is about set operations on lists.  The definitions
+;; of member-equal, subsetp-equal, and union-equal are built into
+;; ACL2.  Here we define remove-equal, set-equal, setp, and disjoint.
+;;
+;; The lemmas are just what arose in practice, without much thought
+;; on designing good sets of rewrite rules for these operations.
+;;
+;; This includes some congruence theorems for set-equal.
+
+;;-----------------------
+;; First, some properties of subsetp-equal, member-equal, union-equal.
+
+;;-----------------------
+;; subsetp-equal
+
+(defthm subset-cons
+  (implies (subsetp-equal a b)
+	   (subsetp-equal a (cons x b))))
+
+(defthm subset-reflexive
+  (subsetp-equal x x))
+
+(defthm subsetp-equal-transitive
+  (implies (and (subsetp-equal x y)
+                (subsetp-equal y z))
+           (subsetp-equal x z)))
+
+(defthm subset-member-subset-cons
+  (implies (and (subsetp-equal a b)
+		(member-equal x b))
+	   (subsetp-equal (cons x a) b)))
+
+(defthm not-member-subset
+  (implies (and (not (member-equal a y))
+                (subsetp-equal x y))
+           (not (member-equal a x))))
+
+(defun subset-skolem (a b)  ;; first member of a not in b
+  (declare (xargs :guard (and (true-listp a) (true-listp b))))
+  (cond ((atom a) nil)
+        ((not (member-equal (car a) b)) (car a))
+        (t (subset-skolem (cdr a) b))))
+
+(defthm subset-skolem-lemma
+  (implies (implies (member-equal (subset-skolem a b) a)
+                    (member-equal (subset-skolem a b) b))
+           (subsetp-equal a b))
+  :rule-classes nil)
+
+;;-----------------------
+;; union-equal
+
+(defthm union-equal-preserves-true-listp
+  (implies (true-listp y)
+	   (true-listp (union-equal x y))))
+
+(defthm union-nil-left
+  (equal (union-equal nil x) x))
+
+(defthm union-nil-right
+  (implies (true-listp x)
+	   (equal (union-equal x nil) x)))
+
+(defthm member-union-or
+  (implies (or (member-equal x a)
+	       (member-equal x b))
+	   (member-equal x (union-equal a b))))
+
+(defthm not-member-union-equal
+  (implies (and (not (member-equal x a))
+		(not (member-equal x b)))
+	   (not (member-equal x (union-equal a b)))))
+
+(defthm union-not-nil-if-either-argument-is-a-cons
+  (implies (or (consp x) (consp y))
+	   (union-equal x y)))
+
+(defthm subset-union-2
+  (implies (subsetp-equal a b)
+	   (equal (union-equal a b) b)))
+
+(defthm union-equal-idempotent
+  (equal (union-equal x x) x))
+
+(defthm subset-union-3
+  (implies (and (subsetp-equal a c)
+		(subsetp-equal b c))
+	   (subsetp-equal (union-equal a b) c)))
+
+(defthm subset-union
+  (implies (and (subsetp-equal a b)
+		(subsetp-equal c d))
+	   (subsetp-equal (union-equal a c)
+			  (union-equal b d))))
+
+(defthm subset-union-4
+  (implies (subsetp-equal a b)
+	   (subsetp-equal a (union-equal c b))))
+
+(defthm subset-union-left-2
+  (implies (subsetp-equal a b)
+           (subsetp-equal a (union-equal b c))))
+
+(defthm subset-union-left-not
+  (implies (not (subsetp-equal a c))
+	   (not (subsetp-equal (union-equal a b) c))))
+
+(defthm subset-union-right-not
+  (implies (not (subsetp-equal b c))
+	   (not (subsetp-equal (union-equal a b) c))))
+
+;;-----------------------
+;; Function remove-equal (x lst) removes all occurrences of x.
+
+; Matt K.: Commented out after v2-9-3 because remove-equal is now defined in
+; axioms.lisp, very slightly differently.
+;(defun remove-equal (x l)
+;  (declare (xargs :guard (true-listp l)))
+;  (cond ((atom l) l)
+;	((equal x (car l)) (remove-equal x (cdr l)))
+;	(t (cons (car l) (remove-equal x (cdr l))))))
+
+(defthm removed-element-is-not-member
+  (not (member-equal x (remove-equal x a))))
+
+(defthm subset-equal-remove
+  (implies (subsetp-equal a b)
+	   (subsetp-equal (remove-equal x a)
+			  (remove-equal x b)))
+  :hints (("Goal" :do-not generalize)))
+
+(defthm not-member-not-member-remove
+  (implies (not (member-equal y a))
+	   (not (member-equal y (remove-equal x a)))))
+
+(defthm remove-distributes-over-union
+  (equal (remove-equal x (union-equal a b))
+	 (union-equal (remove-equal x a) (remove-equal x b)))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm subset-cons-remove
+  (subsetp-equal a (cons x (remove-equal x a))))
+
+(defthm subset-remove-append-one
+  (subsetp-equal a (append (remove-equal x a) (list x))))
+
+(defthm not-equal-member-remove
+  (implies (and (not (equal x v1))
+                (member-equal x a))
+           (member-equal x (remove-equal v1 a))))
+
+(defthm remove-equal-commutative
+  (equal (remove-equal x (remove-equal y a))
+         (remove-equal y (remove-equal x a))))
+
+(defthm remove-equal-idempotent
+  (equal (remove-equal x (remove-equal x a))
+         (remove-equal x a)))
+
+(defthm true-listp-remove-equal
+  (implies (true-listp l)
+	   (true-listp (remove-equal x l))))
+
+;;-----------------------
+;; set-equal (nonrecursive)  (I now think recursive might be better.)
+
+(defun set-equal (a b)
+  (declare (xargs :guard (and (true-listp a)
+                              (true-listp b))))
+  (and (subsetp-equal a b)
+       (subsetp-equal b a)))
+
+(defthm set-equal-reflexive
+  (set-equal x x))
+
+(defequiv set-equal)
+
+(defcong set-equal set-equal (union-equal a b) 1)
+
+(defcong set-equal set-equal (union-equal a b) 2)
+
+(defcong set-equal set-equal (remove-equal x a) 2)
+
+(defcong set-equal set-equal (cons x a) 2)
+
+(defthm member-append-left
+  (implies (member-equal x a)
+           (member-equal x (append a b))))
+
+(defthm member-append-right
+  (implies (member-equal x b)
+           (member-equal x (append a b))))
+
+(defthm subset-append-left
+  (implies (subsetp-equal a b)
+           (subsetp-equal (append a c) (append b c))))
+
+(defcong set-equal set-equal (append a b) 1)
+
+(defcong set-equal set-equal (append a b) 2)
+
+(defthm set-equal-member-equal-cons
+  (implies (member-equal x a)
+	   (set-equal (cons x a) a)))
+
+(defthm set-equal-nil
+  (not (set-equal nil (cons x a))))
+
+;;---------------------------------------------------------------
+;; A collection of rewrite rules for canonicalizing union-equal expressions.
+
+(defthm union-equal-commute-subset
+  (subsetp-equal (union-equal a b) (union-equal b a)))
+
+(defthm union-equal-commutative
+  (set-equal (union-equal a b) (union-equal b a)))
+
+(defthm union-equal-associative
+  (equal (union-equal (union-equal a b) c)
+	 (union-equal a (union-equal b c))))
+
+(defthm union-equal-assoc-commute-subset
+  (subsetp-equal (union-equal a (union-equal b c))
+		 (union-equal b (union-equal a c))))
+
+(defthm union-equal-assoc-commute
+  (set-equal (union-equal a (union-equal b c))
+	     (union-equal b (union-equal a c))))
+
+(defthm union-equal-idempotent-general
+  (equal (union-equal x (union-equal x y))
+	 (union-equal x y))
+  :hints (("Goal"
+           :do-not-induct t
+           :use ((:instance union-equal-associative
+                            (a x) (b x) (c y))))))
+
+;;-----------------  append and subsetp-equal
+
+(defthm subset-append-1
+  (implies (not (subsetp-equal a b))
+           (not (subsetp-equal (append a c) b))))
+
+(defthm subset-append-2
+  (implies (not (subsetp-equal a b))
+           (not (subsetp-equal (append c a) b))))
+
+(defthm member-append-cons
+  (member-equal x (append a (cons x b))))
+
+(defthm subset-append-cons
+  (subsetp-equal (append b c) (append b (cons x c))))
+
+(defthm subset-append-cons-2
+  (implies (subsetp-equal a (append b c))
+           (subsetp-equal a (append b (cons x c))))
+  :hints (("Goal"
+           :use ((:instance subsetp-equal-transitive
+                            (x a) (y (append b c))
+                            (z (append b (cons x c))))))))
+
+(defthm subset-append-cons-3
+  (implies (subsetp-equal (append a b) c)
+           (subsetp-equal (append a (cons x b)) (cons x c))))
+
+;;--------------------------
+;; The setp predicate checks that a list has no duplicates.
+
+(defun setp (a)
+  (declare (xargs :guard (true-listp a)))
+  (cond ((atom a) t)
+        ((member-equal (car a) (cdr a)) nil)
+        (t (setp (cdr a)))))
+
+(defthm union-equal-setp
+  (implies (and (setp a)
+                (setp b))
+           (setp (union-equal a b))))
+
+(defthm remove-equal-setp
+  (implies (setp a)
+           (setp (remove-equal x a))))
+
+(defthm setp-append-1
+  (implies (not (setp b))
+           (not (setp (append a b)))))
+
+(defthm setp-append-2
+  (implies (not (setp a))
+           (not (setp (append a b))))
+  :hints (("Goal"
+           :do-not generalize)))
+
+;;--------------------------------
+;; set-difference-equal
+
+(defthm not-member-set-difference
+  (implies (not (member-equal x c))
+           (not (member-equal x (set-difference-equal c d)))))
+
+(defthm set-difference-equal-nil
+  (implies (true-listp a)
+           (equal (set-difference-equal a nil) a)))
+
+
+;;--------------------------------
+;; misc
+
+(defthm consp-has-member-equal
+  (implies (consp x)
+           (member-equal (car x) x))
+  :rule-classes nil)
+
+;;--------------------------------
+;; This section is a bunch of special-purpose lemmas about subset and union.
+
+(defthm subset-union-6
+  (subsetp-equal a (union-equal c (union-equal a d))))
+
+(defthm special-set-lemma-2
+  (implies (subsetp-equal b (union-equal c (union-equal a d)))
+           (subsetp-equal (union-equal a b)
+                          (union-equal c (union-equal a d)))))
+
+(defthm subset-union-7
+  (subsetp-equal a (union-equal c (cons x (union-equal a d)))))
+
+(defthm special-set-lemma-3
+  (implies (subsetp-equal b (union-equal c (cons x (union-equal a d))))
+           (subsetp-equal (union-equal a b)
+                          (union-equal c (cons x (union-equal a d))))))
+
+(defthm subset-union-8
+  (implies (subsetp-equal a (union-equal b m))
+	   (subsetp-equal a (union-equal b (union-equal d m)))))
+
+(defthm subset-union-9
+  (implies (subsetp-equal c (union-equal d m))
+	   (subsetp-equal c (union-equal b (union-equal d m)))))
+
+(defthm special-set-lemma-4
+  (implies (and (subsetp-equal a (union-equal b m))
+                (subsetp-equal c (union-equal d m)))
+           (subsetp-equal (union-equal a c)
+                          (union-equal b (union-equal d m)))))
+
+(defthm special-set-lemma-6
+  (implies (and (subsetp-equal fs (union-equal fl ft))
+                (subsetp-equal fl s)
+                (subsetp-equal ft s))
+           (subsetp-equal fs s))
+  :rule-classes nil)
+
+;;-----------------
+;; Disjoint lists.
+
+(defun disjoint (a b)
+  (declare (xargs :guard (and (true-listp a) (true-listp b))))
+  (cond ((atom a) t)
+	((member-equal (car a) b) nil)
+	(t (disjoint (cdr a) b))))
+
+(defthm disjoint-nil-right
+  (disjoint a nil))
+
+(defthm disjoint-append-union-1
+  (implies (not (disjoint a b))
+	   (not (disjoint (append d a) (union-equal c b)))))
+
+(defthm disjoint-append-union-2
+  (implies (not (disjoint a b))
+	   (not (disjoint (append a d) (union-equal b c)))))
+
+(defthm disjoint-member-remove
+  (implies (and (not (disjoint a b))
+		(not (member-equal x a)))
+	   (not (disjoint a (remove-equal x b)))))
+
+(defthm disjoint-append-union-3
+  (implies (not (disjoint a b))
+	   (not (disjoint (append a d) (union-equal c b)))))
+
+(defthm disjoint-append-union-4
+  (implies (not (disjoint a b))
+	   (not (disjoint (append d a) (union-equal b c)))))
+
+(defthm disjoint-append-1
+  (implies (not (disjoint a b))
+	   (not (disjoint (append a c) b))))
+
+(defthm disjoint-append-2
+  (implies (not (disjoint a b))
+	   (not (disjoint (append c a) b))))
+
+(defthm disjoint-append-3
+  (implies (not (disjoint a b))
+	   (not (disjoint a (append b c)))))
+
+(defthm disjoint-append-4
+  (implies (not (disjoint a b))
+	   (not (disjoint a (append c b)))))
+
+(defthm disjoint-union-1
+  (implies (not (disjoint a b))
+	   (not (disjoint a (union-equal b c)))))
+
+(defthm disjoint-union-2
+  (implies (not (disjoint a b))
+	   (not (disjoint a (union-equal c b)))))
+
+;;------------------
+
+(defun disjoint-skolem (a b)  ;; first member of a in b
+  (declare (xargs :guard (and (true-listp a) (true-listp b))))
+  (cond ((atom a) nil)
+	((member-equal (car a) b) (car a))
+	(t (disjoint-skolem (cdr a) b))))
+
+(defthm disjoint-skolem-lemma
+  (implies (implies (member-equal (disjoint-skolem a b) a)
+                    (not (member-equal (disjoint-skolem a b) b)))
+           (disjoint a b))
+  :rule-classes nil)
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.lisp
new file mode 100644
index 0000000..dc7fc59
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/simple-check.lisp
@@ -0,0 +1,67 @@
+(in-package "ACL2")
+
+;; This book is a little add-on to Ivy.  I imagine there will
+;; times when we wish to simply check a proof object, without
+;; using Ivy's preprocessing.  For example, if a prover
+;; can build proof objects, but it is inconvenient to use
+;; Ivy's preprocessing.
+;;
+;; Function (bcheck proof) below checks if its input is a proof
+;; object, fixes the substitutions (just like refute-n-check),
+;; and checks it.  Ths soundness theorems says that if the
+;; input steps are true, then all the steps are true.
+;;
+;; Bcheck is similar to the checker of our 1994 Nqthm project.
+;; (But we didn't have any soundness proofs back then.)
+
+(include-book "derive")
+
+;; Here is the checker function.  Compare it to refute-n-check
+;; in book "derive".
+
+(defun bcheck (prf)
+  (declare (xargs :guard t))
+  (if (not (wfproof prf))
+      nil
+    (let ((fixed-prf (fix-substs-in-prf
+		      prf
+		      (free-vars (extract-all-steps prf)))))
+      (check-proof nil fixed-prf))))
+
+;; Question to us: why weren't the following two lemmas needed
+;; for soundness of refute-n-check?
+
+(defthm extract-all-fixed
+  (equal (extract-all-steps (fix-substs-in-prf prf vars))
+	 (extract-all-steps prf)))
+
+(defthm extract-input-fixed
+  (equal (extract-input-steps (fix-substs-in-prf prf vars))
+	 (extract-input-steps prf)))
+
+;; Luckily, we can use theorem check-proof-xsound which we
+;; used for soundness of refute-n-check.
+
+(defthm bcheck-xsound
+  (implies
+   (and (bcheck prf)
+	(xeval (universal-closure (extract-input-steps prf)) (domain i) i))
+   (xeval (universal-closure (extract-all-steps prf)) (domain i) i))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance check-proof-xsound
+			    (prf (fix-substs-in-prf
+				  prf
+				  (free-vars (extract-all-steps prf))
+				  )))))))
+
+;; Now state it in terms of the official evaluation function feval.
+
+(defthm bcheck-fsound
+  (implies (and (bcheck prf)
+		(feval (universal-closure (extract-input-steps prf)) i))
+	   (feval (universal-closure (extract-all-steps prf)) i))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval)
+	   :do-not-induct t)))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/simplify.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/simplify.lisp
new file mode 100644
index 0000000..4800036
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/simplify.lisp
@@ -0,0 +1,141 @@
+(in-package "ACL2")
+
+;; Function (simp-tf f) simplifies formulas by removing all
+;; occurrences of 'true and 'false (except if the formula
+;; becomes 'true or 'false).
+;;
+;; We prove a syntactic correctness theorem, a soundness theorem,
+;; and some preservation-of-property theorems.
+
+(include-book "stage")
+
+;; ===========================================
+
+(defun simp-tf (f)
+  (declare (xargs :guard (wff f)))
+  (cond
+	((wfnot f)
+         (let ((g (simp-tf (a1 f))))
+           (cond ((equal g 'false) 'true)
+                 ((equal g 'true) 'false)
+                 (t (list 'not g)))))
+	((wfand f)
+         (let ((g1 (simp-tf (a1 f))) (g2 (simp-tf (a2 f))))
+           (cond ((equal g1 'true) g2)
+                 ((equal g2 'true) g1)
+                 ((equal g1 'false) 'false)
+                 ((equal g2 'false) 'false)
+                 (t (list 'and g1 g2)))))
+	((wfor f)
+         (let ((g1 (simp-tf (a1 f))) (g2 (simp-tf (a2 f))))
+           (cond ((equal g1 'false) g2)
+                 ((equal g2 'false) g1)
+                 ((equal g1 'true) 'true)
+                 ((equal g2 'true) 'true)
+                 (t (list 'or g1 g2)))))
+	((wfimp f)
+         (let ((g1 (simp-tf (a1 f))) (g2 (simp-tf (a2 f))))
+           (cond ((equal g1 'false) 'true)
+                 ((equal g1 'true) g2)
+                 ((equal g2 'false) (list 'not g1))
+                 ((equal g2 'true) 'true)
+                 (t (list 'imp g1 g2)))))
+	((wfiff f)
+         (let ((g1 (simp-tf (a1 f))) (g2 (simp-tf (a2 f))))
+           (cond ((equal g1 'true) g2)
+                 ((equal g2 'true) g1)
+		 ((and (equal g1 'false) (equal g2 'false)) 'true)
+                 ((equal g1 'false) (list 'not g2))
+                 ((equal g2 'false) (list 'not g1))
+                 (t (list 'iff g1 g2)))))
+	((wfquant f)
+         (let ((g (simp-tf (a2 f))))
+	   (if (or (equal g 'true) (equal g 'false))
+	       g
+	       (list (car f) (a1 f) g))))
+	(t f)))
+
+;; Prove that simp-tf preserves well-formedness.
+
+(defthm simp-tf-wff
+  (implies (wff f)
+	   (wff (simp-tf f))))
+
+;;------------------------------------------------------------
+;; Function tf-free checks for occurrences of 'true and 'false.
+;; (Move these 2 functions to wfftype.)
+
+(defun tf-free (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((or (equal f 'true) (equal f 'false)) nil)
+	((wfnot f) (tf-free (a1 f)))
+	((wfbinary f) (and (tf-free (a1 f)) (tf-free (a2 f))))
+	((wfquant f) (tf-free (a2 f)))
+	(t t)))
+
+(defun tf-free-except-top (f)
+  (declare (xargs :guard (wff f)))
+  (or (equal f 'true)
+      (equal f 'false)
+      (tf-free f)))
+
+;;------------------------------------------------------------
+;; Prove the simp-tf gets rid of all occurrences of 'true and 'false.
+
+(defthm simp-complete-1
+  (implies (and (not (equal (simp-tf f) 'true))
+		(not (equal (simp-tf f) 'false)))
+	   (tf-free (simp-tf f))))
+
+(defthm simp-complete-2
+  (tf-free-except-top (simp-tf f)))
+
+;;-----------------------
+;; Soundness
+
+(defthm not-equal-subst-true
+  (implies (not (equal f 'true))
+	   (not (equal (subst-free f x tm) 'true))))
+
+(defthm not-equal-subst-false
+  (implies (not (equal f 'false))
+	   (not (equal (subst-free f x tm) 'false))))
+
+(defthm subst-simp-tf-commute
+  (equal (simp-tf (subst-free f x tm))
+	 (subst-free (simp-tf f) x tm)))
+
+(defthm simp-tf-xsound
+  (equal (xeval (simp-tf f) dom i)
+	 (xeval f dom i))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i))))
+
+(defthm simp-tf-fsound
+  (equal (feval (simp-tf f) i)
+	 (feval f i))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval))))
+
+;;------------------------------------
+;; Some other properties of simp-tf
+
+;; Note that simp-ft can eliminate free-vars.
+
+(defthm simp-tf-doesnt-introduce-free-vars
+  (subsetp-equal (free-vars (simp-tf f))
+		 (free-vars f))
+  :rule-classes nil)
+
+(defthm simp-tf-preserves-closedness
+  (implies (not (free-vars f))
+	   (not (free-vars (simp-tf f))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use simp-tf-doesnt-introduce-free-vars)))
+
+(defthm simp-tf-preserves-nnfp
+  (implies (nnfp f)
+           (nnfp (simp-tf f)))
+  :hints (("Goal"
+           :induct (nnfp f))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.lisp
new file mode 100644
index 0000000..e40a883
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/simultaneous-d.lisp
@@ -0,0 +1,587 @@
+(in-package "ACL2")
+
+;; Simultaneous substitution and seqify soundness.
+;;
+;; Author: Olga Shumsky (shumsky@mcs.anl.gov)
+;;
+;; As Bill suggested in substitution, I will attempt to write a
+;; simultaneous-apply and prove soundness of seqify by proving that
+;;
+;;     (simultaneous-apply s f) = (sequential-apply (seqify s) f)
+
+(include-book "substitution")
+
+(defun simapply-term-list (s l)
+  (declare (xargs :guard (and (wft-list l) (wfsubst s))))
+  (if (atom l)
+      l
+      (cons (cond ((variable-term (car l))
+		   (if (fassoc (car l) s)
+		       (cdr (fassoc (car l) s))
+		       (car l)))
+		  ((domain-term (car l)) (car l))
+		  ((wf-ap-term-top (car l))
+		   (cons (caar l) (simapply-term-list s (cdar l))))
+		  (t (car l))) ;; leave non-term unchanged
+	    (simapply-term-list s (cdr l)))))
+
+(defun sim-apply (s f)
+  (declare (xargs :guard (and (wff f) (quantifier-free f) (wfsubst s))))
+  (cond ((wfnot f) (list 'not (sim-apply s (a1 f))))
+	((wfbinary f) (list (car f)
+			    (sim-apply s (a1 f))
+			    (sim-apply s (a2 f))))
+	((wfatomtop f) (cons (car f) (simapply-term-list s (cdr f))))
+	(t f)))
+
+;; let's try a different sequential-apply.  The idea is to match the
+;; structure of sequential apply to that of simultaneous apply.
+(defun seq-term-list (s l)
+  (declare (xargs :guard (and (wfsubst s) (wft-list l))))
+  (if (atom s)
+      l
+      (seq-term-list (cdr s) (subst-term-list l (caar s) (cdar s)))))
+
+(defun seq-apply (s f)
+  (declare (xargs :guard (and (wfsubst s) (wff f))))
+  (cond ((wfnot f) (list 'not (seq-apply s (a1 f))))
+	((wfbinary f) (list (car f)
+			    (seq-apply s (a1 f))
+			    (seq-apply s (a2 f))))
+	((wfatomtop f) (cons (car f) (seq-term-list s (cdr f))))
+	(t f)))
+
+;;------------------ Section 1 -----------------------------------
+;; If variables in cars and cdrs of the substitution are disjoint
+;; seq-apply-term-list and simapply-term-list give the same result
+
+(defthm intersect-with-cons-1
+  (implies (intersect-equal x y)
+	   (intersect-equal x (cons a y))))
+
+(defthm intersect-with-cons-2
+  (implies (not (intersect-equal x (cons y a)))
+	   (not (intersect-equal x (list y)))))
+
+(defthm intersect-with-union-1
+  (implies (intersect-equal x y)
+	   (intersect-equal x (union-equal a y))))
+
+(defthm intersect-with-union-2
+  (implies (not (intersect-equal x (union-equal y a)))
+	   (not (intersect-equal x y))))
+
+(defthm intersect-nil
+  (not (intersect-equal x nil)))
+
+(defthm x-member-listx-intersect
+  (implies (and (intersect-equal x (list a))
+		(member-equal a y))
+	   (intersect-equal x y))
+  :rule-classes nil)
+
+;; The lemma subst-term-list-no-change is needed for the
+;; proof of lemma seq-term-list-no-change.  It is not needed
+;; anywhere else, but if left enable slows things down considerably
+(defthm subst-term-list-no-change
+  (implies (not (member-equal x (vars-in-term-list l)))
+	   (equal (subst-term-list l x tm) l)))
+
+;; The lemma seq-term-list-no-change is used in proofs of
+;; lemmas seq-term-listvar-list-fassoc and
+;; sim-seq-variable-disjoint-subst-cars-cdrs. It is not needed
+;; anywhere else, but if left enable slows things down considerably.
+;; The lemmas is disabled after it is proved and explicitly enabled
+;; for the proofs of the two lemmas.
+(defthm seq-term-list-no-change
+  (implies (and (wft-list l)
+		(wfsubst s)
+		(not (intersect-equal (cars s) (vars-in-term-list l))))
+	   (equal (seq-term-list s l) l)))
+
+(in-theory (disable subst-term-list-no-change seq-term-list-no-change))
+
+;; check where used
+(defthm wft-list-true-list
+  (implies (wft-list l)
+	   (true-listp l)))
+(in-theory (disable wft-list-true-list))
+
+(defthm seq-term-list-var-list-fassoc
+  (implies (and (variable-term x)
+		(wfsubst s)
+		(not (intersect-equal (cars s) (vars-in-term-list (cdrs s))))
+		(fassoc x s))
+	   (equal (seq-term-list s (list x))
+		  (list (cdr (fassoc x s)))))
+  :hints (("Goal"
+	   :in-theory (enable wft-list-true-list))
+	  ("Subgoal *1/2"
+	   :in-theory (enable seq-term-list-no-change
+			      wft-list-true-list))
+	  ("Subgoal *1/2.2"
+	   :use ((:instance x-member-listx-intersect
+			    (x (cars (cdr s)))
+			    (y (vars-in-term-list (cdrs (cdr s))))
+			    (a (cdar s)))))))
+
+(defthm subst-term-list-append-commute
+  (implies (and (wft-list l1)
+		(wft-list l2))
+	   (equal (subst-term-list (append l1 l2) x tm)
+		  (append (subst-term-list l1 x tm)
+			  (subst-term-list l2 x tm)))))
+
+(defthm seq-term-list-append-commute
+  (implies (and (wft-list l1)
+		(wft-list l2)
+		(wfsubst s))
+	   (equal (seq-term-list s (append l1 l2))
+		  (append (seq-term-list s l1)
+			  (seq-term-list s l2))))
+  :rule-classes nil)
+
+;; (in-theory (disable subst-term-list-append-commute ))
+
+(defthm seq-term-list-cons-var-wftlist
+  (implies (and (variable-term x)
+		(wft-list l)
+		(wfsubst s)
+		(not (intersect-equal (cars s) (vars-in-term-list (cdrs s))))
+		(fassoc x s))
+	   (equal (seq-term-list s (cons x l))
+		  (append (list (cdr (fassoc x s)))
+			  (seq-term-list s l))))
+  :hints (("Goal" :use ((:instance seq-term-list-append-commute
+				   (l1 (list x)) (l2 l))))))
+
+(defthm variable-not-in-seq-subst
+  (implies (and (wft-list l)
+		(variable-term x)
+		(wfsubst s)
+		(not (fassoc x s)))
+	   (equal (seq-term-list s (cons x l))
+		  (cons x (seq-term-list s l)))))
+
+(defthm domain-term-seq-subst
+  (implies (and (wft-list l)
+		(domain-term x)
+		(wfsubst s))
+	   (equal (seq-term-list s (cons x l))
+		  (cons x (seq-term-list s l)))))
+
+(defthm term-seq-subst
+  (implies (and (wft-list l1)
+		(wft-list l2)
+		(symbolp p)
+		(wfsubst s))
+	   (equal (seq-term-list s (cons (cons p l1) l2))
+		  (cons (cons p (seq-term-list s l1))
+			(seq-term-list s l2))))
+  :hints (("Goal" :in-theory (enable wft-list-true-list))))
+
+;; This theorem is the goal of section 1.
+(defthm sim-seq-variable-disjoint-subst-cars-cdrs
+  (implies (and (wft-list a)
+		(wfsubst s)
+		(not (intersect-equal (cars s)
+				      (vars-in-term-list (cdrs s)))))
+	   (equal (seq-term-list s a)
+		  (simapply-term-list s a)))
+  :hints (("Goal" :in-theory (enable wft-list-true-list))
+	  ("Subgoal *1/1" :in-theory (enable seq-term-list-no-change))))
+
+;;(in-theory (disable variable-not-in-seq-subst domain-term-seq-subst
+;;		   term-seq-subst))
+
+;;------------------ Section 2 -----------------------------------
+;; The goal of this section is to prove that subst-term-list and
+;; subst-cdrs cancel each other.  In particular, we need to prove
+;; that under certain conditions
+;;         (equal (subst-term-list
+;;                  (simapply-term-list (subst-cdrs s v1 v2) a) v2 v1)
+;;                (simapply-term-list s a))))
+;;
+;; This is accomplished in two steps.  First, we prove that
+;;  (equal (simapply-term-list (subst-cdrs s v1 v2) a)
+;;         (subst-term-list (simapply-term-list s a) v1 v2))
+;; provided v2 is a new variable.  This is done in lemma
+;; subst-term-list-simapply-term-list-distribute.
+;;
+;; The second step is to prove that (simapply-term-list s l)
+;; does not introduce new variables wrt (cdrs s) and l.  This is
+;; done in lemma simapply-term-list-introduces-no-new-vars.
+;;
+;; I use an series of encapsulates so that the auxiliary lemmas
+;; do not get in the way later.
+
+;; Step 1:
+;; note that the exported theorem of this statement breaks up into
+;; too many cases.  maybe it can be fixed and go faster?
+(encapsulate
+ ()
+ (local (defthm fassoc-subst-cdrs
+	  (implies (fassoc x y)
+		   (fassoc x (subst-cdrs y v tm)))))
+
+ (local (defthm fassoc-subst-cdrs-not
+	  (implies (and (symbolp x)
+			(wfsubst y)
+			(not (fassoc x y)))
+		   (not (fassoc x (subst-cdrs y v tm))))))
+
+ (local (defthm member-subst-fassoc
+	  (implies (and (wfsubst s)
+		(member-equal x (cars s)))
+		   (fassoc x s))))
+
+ (local (defthm fassoc-domain-subst-cdrs
+	  (implies (and (wfsubst s)
+			(domain-term (cdr (fassoc x s))))
+		   (equal (fassoc x (subst-cdrs s v1 v2))
+			  (fassoc x s)))))
+
+ (local (defthm fassoc-subst-cdr-equal-cdr
+	  (implies (and (wfsubst s)
+			(fassoc x s)
+			(variable-term (cdr (fassoc x s))))
+		   (equal (fassoc x (subst-cdrs s (cdr (fassoc x s)) v))
+			  (cons x v)))))
+
+ (local (defthm fassoc-subst-cdr-same
+	  (implies (and (wfsubst s)
+			(fassoc x s)
+			(variable-term (cdr (fassoc x s)))
+			(not (equal (cdr (fassoc x s)) v1)))
+		   (equal (fassoc x (subst-cdrs s v1 v2))
+			  (fassoc x s)))))
+
+ (local (defthm fassoc-wft
+	  (implies
+	   (and (wfsubst s)
+		(fassoc x s)
+		(consp (cdr (fassoc x s)))
+		(not (member-equal v2 (vars-in-term-list (cdrs s)))))
+	   (equal (fassoc x (subst-cdrs s v1 v2))
+		  (cons x
+			(cons (cadr (fassoc x s))
+			      (subst-term-list (cddr (fassoc x s)) v1 v2)))))
+  :hints (("Goal" :in-theory (enable wft-list-true-list)))))
+
+ (local (defthm simapply-term-list-true-list
+	  (implies (true-listp l)
+		   (true-listp (simapply-term-list s l)))))
+
+ (local (defthm fassoc-domain-term
+	  (implies (and (wfsubst s)
+			(fassoc x s)
+			(not (symbolp (cdr (fassoc x s))))
+			(not (and (consp (cdr (fassoc x s)))
+				  (symbolp (cadr (fassoc x s)))
+				  (true-listp (cddr (fassoc x s))))))
+		   (domain-term (cdr (fassoc x s))))))
+
+ ;; exported theorem of this encapsulate
+ (defthm subst-term-list-simapply-term-list-distribute ;; ~20 secs
+  (implies (and (wft-list a)
+		(wfsubst s)
+		(variable-term v1)
+		(variable-term v2)
+		(member-equal v1 (cars s))
+		(not (member-equal v2 (vars-in-term-list a)))
+		(not (member-equal v2 (vars-in-term-list (cdrs s)))))
+	   (equal (simapply-term-list (subst-cdrs s v1 v2) a)
+		  (subst-term-list (simapply-term-list s a) v1 v2))))
+
+ ) ;; end of encapsulate
+
+;; Step 2:
+;; Prove that simapply-term-list introduces not new variable occurrences
+
+(encapsulate
+ ()
+ (local (defthm var-occurrence-tl-fassoc
+	  (implies (and (wfsubst s)
+			(fassoc a s)
+			(not (var-occurrence-term-list x (cdrs s))))
+		   (not (var-occurrence-term-list
+			 x (list (cdr (fassoc a s))))))))
+
+ (local (defthm var-occurrence-tl-cons
+	  (implies (and (true-listp z)
+			(not (var-occurrence-term-list x (list y)))
+			(not (var-occurrence-term-list x z)))
+		   (not (var-occurrence-term-list x (cons y z))))))
+
+ (local (defthm simapply-term-list-wftlist-truelist
+	  (implies (and (wfsubst s)
+			(wft-list l))
+		   (true-listp (simapply-term-list s l)))))
+
+ ;; exported lemma of this encapsulate
+ (defthm var-occurrence-simapply-term-list
+  (implies (and (wft-list l)
+		(variable-term x)
+		(wfsubst s)
+		(not (var-occurrence-term-list x l))
+		(not (var-occurrence-term-list x (cdrs s))))
+	   (not (var-occurrence-term-list x (simapply-term-list s l))))
+  :rule-classes nil)
+
+ ) ;; end of encapsulate
+
+
+(local (defthm wfsubst-cdrs-wftlist
+	 (implies (wfsubst s)
+		  (wft-list (cdrs s)))))
+
+(encapsulate
+ ()
+ ;; relationship between var-occurrence and vars-in-term-list
+ (local (defthm var-occurrence-member-vars-term-list-1
+	  (implies (and (wft-list l)
+			(not (var-occurrence-term-list x l)))
+		   (not (member-equal x (vars-in-term-list l))))))
+
+ (local (defthm var-occurrence-member-vars-term-list-2
+	  (implies (and (wft-list l)
+			(var-occurrence-term-list x l))
+		   (member-equal x (vars-in-term-list l)))))
+
+ ;; lemmas to prove that simapply-term-list is a wft-list
+ (local (defthm cdr-fassoc-wftlist
+	  (implies (and (wfsubst s)
+			(fassoc x s))
+		   (wft-list (list (cdr (fassoc x s)))))))
+
+ (local (defthm wftlist-cons
+	  (implies (and (wft-list (list x))
+			(wft-list y))
+		   (wft-list (cons x y)))))
+
+ (local (defthm simapply-term-list-wftlist
+	  (implies (and (wft-list l)
+			(wfsubst s))
+		   (wft-list (simapply-term-list s l)))))
+
+ ;; exported theorem of this section
+ (defthm simapply-term-list-introduces-no-new-vars
+   (implies (and (wft-list l)
+		 (variable-term x)
+		 (wfsubst s)
+		 (not (member-equal x (vars-in-term-list l)))
+		 (not (member-equal x (vars-in-term-list (cdrs s)))))
+	    (not (member-equal
+		  x (vars-in-term-list (simapply-term-list s l)))))
+   :hints (("Goal" :do-not-induct t
+	    :use var-occurrence-simapply-term-list)))
+
+ ) ;; end of encapsulate
+
+(defthm subst-term-list-inverse
+  (implies (and (variable-term v1)
+		(variable-term v2)
+		(not (member-equal v2 (vars-in-term-list l))))
+	   (equal (subst-term-list (subst-term-list l v1 v2) v2 v1) l)))
+
+;; Putting is all together:  Main lemma of section 2
+(defthm subst-term-subst-cdrs-cancel
+  (implies (and (wft-list a)
+		(wfsubst s)
+		(variable-term v1)
+		(variable-term v2)
+		(member-equal v1 (cars s))
+		(not (member-equal v2 (vars-in-term-list a)))
+		(not (member-equal v2 (vars-in-term-list (cdrs s)))))
+	   (equal (subst-term-list
+		   (simapply-term-list (subst-cdrs s v1 v2) a)
+		   v2
+		   v1)
+		  (simapply-term-list s a))))
+
+;;------------------ Section 3 -----------------------------------
+;; Here we prove a supporting lemma about sets.
+
+(defthm vars-subst-subset-subset
+  (implies (and (variable-term v)
+		(subsetp-equal (vars-in-term-list l) vars))
+	   (subsetp-equal (vars-in-term-list (subst-term-list l x v))
+			  (cons v vars))))
+
+(encapsulate
+ ()
+ (local (defthm member-intersect-subset-1
+	  (implies (and (not (member-equal a x))
+			(subsetp-equal (intersect-equal x y) z))
+		   (subsetp-equal (intersect-equal x (cons a y)) z))))
+
+ (local (defthm intersect-union-subset-1
+	  (implies (and (subsetp-equal (intersect-equal x y1) z)
+			(subsetp-equal (intersect-equal x y2) z))
+		   (subsetp-equal (intersect-equal
+				   x (union-equal y1 y2)) z))))
+
+ (local (defthm intersect-union-subset-2
+	  (implies (not (subsetp-equal (intersect-equal x y) z))
+		   (not (subsetp-equal (intersect-equal
+					x (union-equal y a)) z)))))
+
+ (local (defthm intersect-union-subset-3
+	  (implies (not (subsetp-equal (intersect-equal x y) z))
+		   (not (subsetp-equal (intersect-equal
+					x (union-equal a y)) z)))))
+
+ (local (defthm intersect-cons-subset-1
+	  (implies (not (subsetp-equal (intersect-equal x y) z))
+		   (not (subsetp-equal (intersect-equal x (cons a y)) z)))))
+
+ (local (defthm subst-vars-subset
+	  (implies (and (wft-list l)
+			(variable-term v)
+			(variable-term y))
+		   (subsetp-equal (vars-in-term-list (subst-term-list l v y))
+				  (cons y (vars-in-term-list l))))))
+
+ (local (defthm member-subst
+	  (implies (and (wft-list l)
+			(variable-term v)
+			(variable-term y)
+			(not (equal v y)))
+		   (not (member-equal
+			 v (vars-in-term-list (subst-term-list l v y)))))))
+
+ (local
+  (defthm subset-intersect-helper-subcase
+    (implies (and (subsetp-equal (intersect-equal cs y1) v2)
+		  (subsetp-equal (intersect-equal cs (cons a y2))
+				 (cons v1 v2))
+		  (not (member-equal z cs))
+		  (not (equal v1 z))
+		  (not (equal v1 a))
+		  (not (member-equal v1 y1))
+		  (subsetp-equal y1 (cons z y2)))
+	     (subsetp-equal (intersect-equal cs (cons a y1)) v2))
+    :hints (("Goal" :do-not generalize))))
+
+ (defthm subset-intersect-helper
+   (implies
+    (and (variable-term y)
+	 (variable-term v1)
+	 (not (equal y v1))
+	 (var-list cs)
+	 (wft-list cd)
+	 (var-list v2)
+	 (subsetp-equal (intersect-equal cs (vars-in-term-list cd))
+			(cons v1 v2))
+	 (not (member-equal y cs)))
+    (subsetp-equal (intersect-equal cs (vars-in-term-list
+					(subst-term-list cd v1 y)))
+		   v2)))
+
+ ) ;; end of encapsulate
+;; end of section 3
+
+;; ------------------ Putting it all together ----------------------
+(defthm gensymbol-subset-member
+  (implies (subsetp-equal l1 l2)
+	   (not (member-equal (gen-symbol 'y l2) l1))))
+
+(defthm gensymbol-subset-not-equal
+  (implies (and (subsetp-equal l1 l2)
+		(member-equal a l1))
+	   (not (equal a (gen-symbol 'y l2)))))
+
+(defthm cars-subst-cdrs
+  (implies (wfsubst s)
+	   (equal (cars (subst-cdrs s x tm))
+		  (cars s))))
+
+(defthm cdrs-subst-cdr
+  (implies (wfsubst s)
+	   (equal (cdrs (subst-cdrs s v e))
+		  (subst-term-list (cdrs s) v e))))
+
+(defthm seq-last-subst-unroll
+  (implies (and (wft-list a)
+		(wfsubst s)
+		(variable-term v1)
+		(variable-term v2))
+	   (equal (seq-term-list (append s (list (cons v1 v2))) a)
+		  (subst-term-list (seq-term-list s a) v1 v2)))
+  :hints (("Goal"
+	   :in-theory (disable sim-seq-variable-disjoint-subst-cars-cdrs))))
+
+; this lemma is the essence of the proof
+(defthm seq-apply-seq-helper-simapply-same
+  (implies
+   (and (wft-list a)
+        (wfsubst s)
+        (var-list vars)
+        (var-list vars-to-fix)
+        (subsetp-equal vars-to-fix vars)
+        (subsetp-equal vars-to-fix (cars s))
+        (subsetp-equal (vars-in-term-list a) vars)
+	(subsetp-equal (vars-in-term-list (cdrs s)) vars)
+        (subsetp-equal (cars s) vars)
+	(subsetp-equal (intersect-equal (cars s)
+					(vars-in-term-list (cdrs s)))
+		       vars-to-fix)
+	)
+   (equal (seq-term-list (seqify-helper s vars-to-fix vars) a)
+          (simapply-term-list s a)))
+  :hints (("goal"
+	   :in-theory (enable wft-list-true-list
+			      sim-seq-variable-disjoint-subst-cars-cdrs)
+           :induct (seqify-helper s vars-to-fix vars))))
+
+(defthm intersect-subset-of-first
+  (subsetp-equal (intersect-equal x y) x))
+
+(defthm intersect-subset-of-union
+  (subsetp-equal (intersect-equal x y)
+		 (union-equal x (union-equal y z))))
+
+;; Main theorem:
+;; Prove that sim-apply and seq-apply/seqify give the same result
+;; note: case 2 takes a long time.  Can anything be done?
+
+(defthm simaltaneous-sequential-subst
+  (implies (and (wff f)
+		(quantifier-free f)
+		(var-list vars)
+		(subsetp-equal (free-vars f) vars)
+		(wfsubst s))
+	   (equal (seq-apply (seqify s vars) f)
+		  (sim-apply s f)))
+  :hints (("Goal" :induct (sim-apply s f))))
+
+;;-----------------------------------------------------------------
+;; Now, state the equivalence of simultaneous and sequential
+;; substitutions in terms of official sequential-apply
+
+(defthm wfsubst-seqify
+  (implies (and (wfsubst s)
+		(var-list vars))
+           (wfsubst (seqify s vars))))
+
+;; Prove that two sequential apply functions give the same result
+;;
+;; does several inductions, but it is faster and cleaner to do that
+;; then to prove the subgoals separately
+
+(defthm two-seq-versions-same
+  (implies (and (wff f)
+		(quantifier-free f)
+		(wfsubst s))
+	   (equal (sequential-apply s f)
+		  (seq-apply s f))))
+
+(defthm simaltaneous-sequential-subst-2
+  (implies (and (wff f)
+		(quantifier-free f)
+		(var-list vars)
+		(subsetp-equal (free-vars f) vars)
+		(wfsubst s))
+	   (equal (sequential-apply (seqify s vars) f)
+		  (sim-apply s f)))
+  :hints (("Goal" :in-theory (disable seqify))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.lisp
new file mode 100644
index 0000000..035b01a
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-misc-lemmas.lisp
@@ -0,0 +1,186 @@
+(in-package "ACL2")
+
+;; This book contains lemmas, not about Skolemization, that
+;; arose during the Skolemization work.
+
+(include-book "stage")
+
+(defthm eval-term-list-preserves-len
+  (equal (len (eval-term-list l i))
+	 (len l)))
+
+(defthm subst-term-list-preserves-len
+  (equal (len (subst-term-list l x tm))
+	 (len l)))
+
+(defthm domain-list-domain
+  (equal (domain (list* (domain i) x))
+	 (domain i))
+  :hints (("Goal"
+           :in-theory (enable domain))))
+
+(defthm relations-1
+  (equal (relations (list* x y z)) y)
+  :hints (("Goal"
+           :in-theory (enable relations))))
+
+(defthm functions-1
+  (equal (functions (list* x y z)) z)
+  :hints (("Goal"
+           :in-theory (enable functions))))
+
+(defthm var-list-append-one
+  (implies (and (variable-term v)
+		(var-list vars))
+	   (var-list (append vars (list v)))))
+
+(defthm var-list-props
+  (implies (var-list vars)
+	   (and (wft-list vars)
+		(true-listp vars)))
+  :rule-classes :forward-chaining)
+
+(defthm domain-term-list-append
+  (implies (and (domain-term dom)
+		(domain-term-list vals))
+	   (domain-term-list (append vals (list dom)))))
+
+(defthm eval-term-list-on-domain-term-list
+  (implies (and (domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i))))
+	   (equal (eval-term-list vals i) vals)))
+
+(defthm not-domain-term-not-domain-term-list
+  (implies (and (not (domain-term x))
+		(domain-term-list l))
+	   (not (member-equal x l))))
+
+(defthm eval-term-list-parts
+  (equal (eval-term-list l (list* (domain i) (relations i) (functions i)))
+	 (eval-term-list l i)))
+
+(defthm xeval-interp-parts
+  (equal (xeval f dom (list* (domain i) (relations i) (functions i)))
+	 (xeval f dom i))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i)
+           :in-theory (enable eval-atomic))))
+
+(defthm len-append-list
+  (equal (len (append a (list x)))
+	 (+ 1 (len a))))
+
+(defthm subset-member-append-list
+  (implies (and (subsetp-equal a b)
+		(member-equal x b))
+	   (subsetp-equal (append a (list x)) b)))
+
+(defthm subst-free-preserves-exists-count
+  (equal (exists-count (subst-free f x tm))
+	 (exists-count f)))
+
+(defthm subst-free-preserves-funcs-in-formula
+  (implies (domain-term e)
+	   (equal (funcs-in-formula (subst-free f x e))
+		  (funcs-in-formula f))))
+
+(defthm not-member-equal-append-list
+  (implies (and (not (equal y x))
+		(not (member-equal x vars)))
+	   (not (member-equal x (append vars (list y))))))
+
+(defthm var-occurrence-term-list-list-cons
+  (implies (and (var-list vars)
+		(not (member-equal x vars)))
+	   (not (var-occurrence-term-list x (list (cons s vars))))))
+
+(defthm disjoint-append-5
+  (implies (and (disjoint a (cons x b))
+		(not (member-equal x b)))
+	   (disjoint (append a (list x)) b))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm subst-append-vals-list
+  (implies (and (domain-term-list vals)
+		(variable-term x))
+	   (equal (subst-term-list (append vals (list x)) x e)
+		  (append vals (list e)))))
+
+(defthm nil-not-in-domain-term-list
+  (implies (domain-term-list vals)
+	   (not (member-equal nil vals))))
+
+(defthm not-member-append  ;; move to sets?
+  (implies (and (not (member-equal x a))
+		(not (member-equal x b)))
+	   (not (member-equal x (append a b)))))
+
+(defthm domain-term-list-has-no-vars
+  (implies (domain-term-list vals)
+	   (not (vars-in-term-list vals)))
+  :hints (("Goal"
+           :in-theory (enable domain-term))))
+
+(defthm not-vars-in-term-list-2
+  (implies (and (domain-term-list vals)
+		(function-symbol sym))
+	   (not (vars-in-term-list (list (cons sym vals))))))
+
+(defthm car-of-eval-term-list-is-domain-term
+  (implies (consp l)
+	   (domain-term (car (eval-term-list l i)))))
+
+(defthm subset-eval-term-list-domain
+  (subsetp-equal (eval-term-list l i)
+		 (fringe (domain i))))
+
+(defthm car-of-eval-term-list-is-in-domain
+  (implies (consp l)
+	   (member-equal (car (eval-term-list l (cons (domain i) tail)))
+			 (fringe (domain i)))))
+
+(defthm car-of-eval-term-list-is-in-domain-2
+  (member-equal (car (eval-term-list (list tm) i))
+		(fringe (domain i)))
+  :hints (("Goal"
+         :use ((:instance car-of-eval-term-list-is-in-domain
+			  (l (list tm))
+			  (tail (cons (relations i) (functions i))))))))
+
+(defthm feval-interp-parts
+  (equal (feval f (list* (domain i) (relations i) (functions i)))
+	 (feval f i))
+  :hints (("Goal"
+           :in-theory (enable xeval-feval))))
+
+(defthm setp-append-disjoint
+  (implies (setp (append a b))
+	   (disjoint a b)))
+
+(defthm disjoint-member-append-cons
+  (implies (and (disjoint a b2)
+		(not (member-equal b1 (append b2 a))))
+	   (disjoint a (cons b1 b2))))
+
+(defthm setp-append-disjoint-2
+  (implies (setp (append b a))
+	   (disjoint a b))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm setp-fringe-domain
+  (setp (fringe (domain i)))
+  :hints (("Goal"
+           :in-theory (enable domain))))
+
+(defthm not-funcs-in-var-list
+  (implies (var-list vars)
+	   (not (funcs-in-term-list vars))))
+
+(defthm disjoint-member-forward
+  (implies (and (disjoint a b)
+		(member-equal x a))
+	   (not (member-equal x b)))
+  :rule-classes :forward-chaining)
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.lisp
new file mode 100644
index 0000000..aced5c4
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-step-sound.lisp
@@ -0,0 +1,368 @@
+(in-package "ACL2")
+
+;; Soundness of the skolem step functions step-sk/step-ex,
+;; which operate on the leftmost existential quantifier.
+;; Recall that step-sk does a skolemization, and step-ex
+;; does the corresponding extension of an interpretation.
+
+(include-book "sk-useless")
+(include-book "sk-step")
+
+;;-------------------------
+
+(defthm not-validator-not-feval-d
+  (implies (and (domain-term-list (fringe dom))
+		(not (validator f x dom i)))
+	   (not (feval-d (list 'exists x f) dom i))))
+
+(defthm not-validator-not-feval
+  (implies (and (not (validator f x dom i))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		(member-equal e (fringe dom)))
+	   (not (feval (subst-free f x e) i))))
+
+(defthm not-validator-not-feval-2
+  (implies (and (not (validator f x (domain i) i))
+		(member-equal e (fringe (domain i))))
+	   (not (feval (subst-free f x e) i))))
+
+(defthm validator-feval
+  (implies (validator f x dom i)
+	   (feval (subst-free f x (validator f x dom i)) i)))
+
+(defthm validator-feval-exists
+  (implies (and (variable-term x)
+		(validator f x dom i))
+	   (feval-d (list 'exists x f) dom i)))
+
+;;------------------------------------
+;; not validator case
+
+(encapsulate
+ nil
+ (local (include-book "instance"))
+
+ (defthm ground-term-eval  ;; redundant event from instance book
+  (implies (and (variable-term x)
+		(domain-term-list (fringe dom))
+		(not (vars-in-term-list (list tm))))
+	   (equal (xeval (subst-free f x (eval-term tm i)) dom i)
+		  (xeval (subst-free f x tm) dom i))))
+ )
+
+(defthm ground-term-feval
+  (implies (and (variable-term x)
+		(not (vars-in-term-list (list tm))))
+	   (equal (feval (subst-free f x (eval-term tm i)) i)
+		  (feval (subst-free f x tm) i)))
+  :hints (("Goal"
+           :in-theory (enable xeval-feval))))
+
+(defthm not-validator-case
+  (implies (and (variable-term x)
+		(domain-term-list vals)
+		(not (validator f x (domain i) i))
+		(not (member-equal fsym (funcs-in-formula f))))
+	   (not (feval (subst-free f x (cons fsym vals))
+		       (list* (domain i)
+			      (relations i)
+			      (list (cons fsym (len vals))
+				    (cons vals 0))
+			      (functions i)))))
+  :hints (("Goal"
+	   :do-not generalize
+	   :in-theory (disable eval-term-list ground-term-feval)
+	   :use ((:instance ground-term-feval
+			    (tm (cons fsym vals))
+			    (i (list* (domain i)
+				      (relations i)
+				      (list (cons fsym (len vals))
+					    (cons vals 0))
+				      (functions i)))
+			    ))))
+  :otf-flg t)
+
+;;------------------------------------
+;; validator case
+
+(defthm validator-in-domain
+  (implies (validator f x dom i)
+	   (member-equal (validator f x dom i) (fringe dom))))
+
+(defthm validator-is-domain-term
+  (implies (and (validator f x dom i)
+		(domain-term-list (fringe dom)))
+	   (domain-term (validator f x dom i))))
+
+(defthm eval-term-with-inserted-tuple
+  (implies (and (domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(function-symbol fsym)
+		(member-equal val (fringe (domain i))))
+	   (equal (car (eval-term-list
+			(list (cons fsym vals))
+			(list* (domain i)
+			       (relations i)
+			       (list (cons fsym (len vals))
+				     (cons vals val))
+			       (functions i))))
+		  val))
+  :hints (("Goal"
+           :in-theory (enable fapply domain))))
+
+(defthm validator-case
+  (implies (and (variable-term x)
+		(function-symbol fsym)
+		(not (member-equal x (quantified-vars f)))
+		(setp (quantified-vars f))
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(validator f x (domain i) i))
+	   (equal (feval (subst-free f x (cons fsym vals))
+			 (list* (domain i)
+				(relations i)
+				(list (cons fsym (len vals))
+				      (cons vals
+					    (validator f x
+						       (domain i)
+						       i)))
+				(functions i)))
+		  (feval-d (list 'exists x f)
+			   (domain i)
+			   i)))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :in-theory (disable eval-term-list ground-term-feval)
+	   :use ((:instance ground-term-feval
+			    (tm (cons fsym vals))
+			    (i (list* (domain i)
+				      (relations i)
+				      (list (cons fsym (len vals))
+					    (cons vals (validator f x
+						       (domain i)
+						       i)))
+				      (functions i)))
+			    )))))
+
+;;---------------------------------
+;; append case
+
+(include-book "sk-xbuild")
+
+(defthm xeval-append-a-x
+  (implies
+   (and (variable-term f3)
+	(function-symbol fsym)
+	(step-sk-arity f5 (+ 1 (len vals)))
+	(not (member-equal f3 (quantified-vars f5)))
+	(setp (quantified-vars f5))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula f5)))
+	(domain-term-list (append (fringe dom1) (fringe dom2)))
+	(setp (append (fringe dom1) (fringe dom2)))
+	(subsetp-equal (append (fringe dom1) (fringe dom2))
+		       (fringe (domain i))))
+   (equal (feval-d (list 'all f3 (step-sk f5 (append vals (list f3)) fsym))
+		   dom2
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym
+				      (step-sk-arity f5 (+ 1 (len vals))))
+				(append (build-sk-d (list 'all f3 f5)
+						    vals dom1 i)
+					(build-sk-d (list 'all f3 f5)
+						    vals dom2 i)))
+			  (functions i)))
+	  (feval-d (list 'all f3 (step-sk f5 (append vals (list f3)) fsym))
+		   dom2
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym
+				      (step-sk-arity f5 (+ 1 (len vals))))
+				(build-sk-d (list 'all f3 f5)
+					    vals dom2 i))
+			  (functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-a
+			    (y f3) (f f5) (dm dom1) (dom dom2)
+			    (func2 (build-sk-d (list 'all f3 f5)
+					       vals dom2 i))))
+           :in-theory (disable XEVAL-APPEND-A)
+	   :do-not-induct t
+	   )))
+
+(defthm xeval-append-b-x1
+  (implies
+   (and (variable-term f3)
+	(function-symbol fsym)
+	(step-sk-arity f5 (+ 1 (len vals)))
+	(not (member-equal f3 (quantified-vars f5)))
+	(setp (quantified-vars f5))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula f5)))
+	(domain-term-list (append (fringe dom1) (fringe dom2)))
+	(setp (append (fringe dom1) (fringe dom2)))
+	(subsetp-equal (append (fringe dom1) (fringe dom2))
+		       (fringe (domain i)))
+	(feval-d (list 'all f3 f5) dom1 i)
+	)
+   (equal (feval-d (list 'all f3 (step-sk f5 (append vals (list f3)) fsym))
+		   dom1
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym (step-sk-arity f5 (+ 1 (len vals))))
+				(append (build-sk-d (list 'all f3 f5)
+						    vals dom1 i)
+					(build-sk-d (list 'all f3 f5)
+						    vals dom2 i)))
+			  (functions i)))
+	  (feval-d (list 'all f3 (step-sk f5 (append vals (list f3)) fsym))
+		   dom1
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym (step-sk-arity f5 (+ 1 (len vals))))
+				(build-sk-d (list 'all f3 f5)
+					    vals dom1 i))
+			  (functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-b
+			    (y f3) (f f5) (dm dom2) (dom dom1)
+			    (func1 (build-sk-d (list 'all f3 f5)
+					       vals dom1 i))))
+           :in-theory (disable XEVAL-APPEND-B)
+	   :do-not-induct t
+	   )))
+
+(defthm xeval-append-b-x2
+  (implies
+   (and (variable-term f3)
+	(function-symbol fsym)
+	(step-sk-arity f5 (+ 1 (len vals)))
+	(not (feval-d (list 'all f3 (step-sk f5 (append vals (list f3)) fsym))
+		      dom1
+		      (list* (domain i)
+			     (relations i)
+			     (cons (cons fsym
+					 (step-sk-arity f5 (+ 1 (len vals))))
+				   (build-sk-d (list 'all f3 f5)
+					       vals dom1 i))
+			     (functions i))))
+	(not (member-equal f3 (quantified-vars f5)))
+	(setp (quantified-vars f5))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula f5)))
+	(domain-term-list (append (fringe dom1) (fringe dom2)))
+	(setp (append (fringe dom1) (fringe dom2)))
+	(subsetp-equal (append (fringe dom1) (fringe dom2))
+		       (fringe (domain i)))
+	(not (feval-d (list 'all f3 f5) dom1 i))
+	)
+   (not (feval-d (list 'all f3 (step-sk f5 (append vals (list f3)) fsym))
+		 dom1
+		 (list* (domain i)
+			(relations i)
+			(cons (cons fsym (step-sk-arity f5 (+ 1 (len vals))))
+			      (append (build-sk-d (list 'all f3 f5)
+						  vals dom1 i)
+				      (build-sk-d (list 'all f3 f5)
+						  vals dom2 i)))
+			(functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-b
+			    (y f3) (f f5) (dm dom2) (dom dom1)
+			    (func1 (build-sk-d (list 'all f3 f5)
+					       vals dom1 i))))
+           :in-theory (disable XEVAL-APPEND-B)
+	   :do-not-induct t
+	   )))
+
+;;----------------------------------------------
+;; Here it is, the heart of the soundness of Skolemization.
+;; We split it into 2 cases: with and without a skolemizable existential quant.
+
+(defthm step-sk-e-fsound-flg
+  (implies (and (setp (quantified-vars f))
+		(step-sk-arity f (len vals))  ;; there is a skolemizable exists
+		(function-symbol fsym)
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f))))
+	   (if flg
+	       (equal (feval (step-sk f vals fsym) (step-ex f fsym vals i))
+		      (feval f i))
+
+	       (implies (and (wfall f)
+			     (domain-term-list (fringe dom))
+			     (setp (fringe dom))
+			     (subsetp-equal (fringe dom) (fringe (domain i))))
+			(equal (feval-d (step-sk f vals fsym ) dom
+					(step-ex-d f fsym vals dom i))
+			       (feval-d f dom i)))))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (build-sk-i flg f vals dom i))
+	  )
+  :rule-classes nil)
+
+(in-theory (disable step-ex))
+
+(defthm step-sk-e-fsound-vals
+  (implies (and (setp (quantified-vars f))
+		(step-sk-arity f (len vals))  ;; there is a skolemizable exists
+		(function-symbol fsym)
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		)
+	   (equal (feval (step-sk f vals fsym) (step-ex f fsym vals i))
+		  (feval f i)))
+  :hints (("Goal"
+	   :by (:instance step-sk-e-fsound-flg (flg t)))))
+
+(defthm step-sk-without-exists-2
+  (implies (and (natp n)
+		(not (step-sk-arity f n)))
+	   (equal (step-sk f vars fsym) f))
+  :hints (("goal"
+	   :induct (step-sk-sym-i2 f vars n))))
+
+(defthm step-sk-x-fsound-vals
+  (implies (and (setp (quantified-vars f))
+		(not (step-sk-arity f (len vals)))  ;; no skolemizable exists
+		(function-symbol fsym)
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		)
+	   (equal (feval (step-sk f vals fsym) (step-ex f fsym vals i))
+		  (feval f i)))
+  :hints (("Goal"
+	   :in-theory (enable step-ex)
+	   :use ((:instance step-sk-without-exists-2
+			    (n (len vals))
+			    (vars vals))))))
+
+(defthm step-sk-fsound-vals
+  (implies (and (setp (quantified-vars f))
+		(function-symbol fsym)
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		)
+	   (equal (feval (step-sk f vals fsym) (step-ex f fsym vals i))
+		  (feval f i)))
+  :hints (("Goal"
+	   :use ((:instance step-sk-e-fsound-vals)
+		 (:instance step-sk-x-fsound-vals)))))
+
+(defthm step-sk-fsound
+  (implies (and (setp (quantified-vars f))
+		(function-symbol fsym)
+		(not (member-equal fsym (funcs-in-formula f))))
+	   (equal (feval (step-sk f nil fsym) (step-ex f fsym nil i))
+		  (feval f i))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.lisp
new file mode 100644
index 0000000..d79ec65
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-step.lisp
@@ -0,0 +1,317 @@
+(in-package "ACL2")
+
+;; This book contains the definitions of the "step" functions
+;; for Skolemization.  Instead of Skolemizing all existential
+;; quantifiers in one pass, we repeatedly ("step-by-step")
+;; Skolemize the leftmost existential until done.
+;;
+;; Function step-sk Skolemizes the leftmost existential quantifier.
+;; To prove soundness of step-sk, we use a companion function
+;; step-ex, which extends an interpretaion with a Skolem function.
+;; The guts of step-ex are the mutually recursive pair build-sk/build-sk-d,
+;; which have recursion similar to the evaluation function feval/feval-d.
+;;
+;; Also, we also prove some preservation-of-property lemmas for step-sk.
+
+(include-book "stage")
+(include-book "sk-misc-lemmas")
+(local (include-book "../../../../../ordinals/e0-ordinal"))
+
+;;---------------------------------------------------------------
+;; (step-sk f vars fsym) tries to skolemize the left-most
+;; existential quantifier.
+
+(defun step-sk (f vars fsym)
+  (declare (xargs :guard (and (wff f)
+			      (nnfp f)
+			      (var-list vars)
+			      (function-symbol fsym))))
+  (cond ((or (wfand f) (wfor f))
+	 (if (> (exists-count (a1 f)) 0)
+	     (list (car f) (step-sk (a1 f) vars fsym) (a2 f))
+	     (list (car f) (a1 f) (step-sk (a2 f) vars fsym))))
+
+	((wfall f) (list 'all (a1 f) (step-sk (a2 f)
+					      (append vars (list (a1 f)))
+					      fsym)))
+	((wfexists f)
+	 (subst-free (a2 f) (a1 f) (cons fsym vars)))
+	(t f)))
+
+;;---------------
+
+(defthm step-sk-preserves-wff
+  (implies (and (wff f)
+		(var-list vars)
+		(function-symbol fsym))
+	   (wff (step-sk f vars fsym))))
+
+(defthm step-sk-preserves-nnfp
+  (implies (nnfp f)
+	   (nnfp (step-sk f vars fsym))))
+
+;;---------------
+;; (step-sk-arity f n):  Get the arity for the Skolem function for
+;; the leftmost existential quantifier.  Parameter n counts
+;; universals along the way.  Return nil if there are no existentials.
+
+(defun step-sk-arity (f n)
+  (declare (xargs :guard (and (wff f)
+			      (nnfp f)
+			      (natp n))))
+  (cond ((or (wfand f) (wfor f))
+	 (if (> (exists-count (a1 f)) 0)
+	     (step-sk-arity (a1 f) n)
+	     (step-sk-arity (a2 f) n)))
+	((wfall f) (step-sk-arity (a2 f) (+ 1 n)))
+	((wfexists f) n)
+	(t nil)))
+
+;;---------------------------------------------------------------
+;; (val-or-0 p x dom i) is the first member of dom that makes p
+;; true when substituted for x.  If there is none, 0 is returned.
+
+(defun validator (p x dom i)  ;; return a domain element or nil
+  (declare (xargs :guard (and (wff p)
+			      (variable-term x)
+			      (domain-term-list (fringe dom)))))
+  (if (atom dom)
+      (if (feval (subst-free p x dom) i)
+	  dom
+	nil)
+    (if (validator p x (car dom) i)
+	(validator p x (car dom) i)
+      (validator p x (cdr dom) i))))
+
+(defmacro val-or-0 (p x dom i)
+  (list 'if (list 'validator p x dom i)
+	(list 'validator p x dom i)
+	'0))
+
+;;--------------------
+;; (build-sk f vals i) builds a Skolem function (that is, an alist of
+;; tuple-value pairs) for the left-most existential quantifier.
+
+(mutual-recursion
+
+ (defun build-sk (f vals i)
+   (declare (xargs :measure (cons (cons (wff-count f) 2) 0)
+		   :guard (and (wff f)
+			       (nnfp f)
+			       (domain-term-list vals))
+		   :verify-guards nil))
+   (cond
+    ((or (wfand f) (wfor f))
+     (if (> (exists-count (a1 f)) 0)
+	 (build-sk (a1 f) vals i)
+       (build-sk (a2 f) vals i)))
+    ((wfexists f) (list (cons vals (val-or-0 (a2 f) (a1 f) (domain i) i))))
+    ((wfall f) (build-sk-d f vals (domain i) i)) ;; recurse-on-domain
+    (t nil)))
+
+ (defun build-sk-d (f vals dom i)
+   (declare (xargs :measure (cons (cons (wff-count f) 1) (acl2-count dom))
+		   :guard (and (wff f)
+			       (nnfp f)
+			       (domain-term-list vals)
+			       (domain-term-list (fringe dom))
+			       (subsetp-equal (fringe dom)
+					      (fringe (domain i))))))
+   (cond ((wfall f)
+	  (if (atom dom)
+	      (build-sk (subst-free (a2 f) (a1 f) dom)
+			(append vals (list dom)) i)
+	      (append (build-sk-d f vals (car dom) i)
+		      (build-sk-d f vals (cdr dom) i))))
+	 (t nil)))
+
+ )  ;; end of mutual recursion
+
+;;------------------
+;; build-sk-i is an induction scheme corresponding to build-sk.
+
+(defun build-sk-i (flg f vals dom i)
+  (declare (xargs :measure (cons (cons (wff-count f)
+				       (if flg 2 1))
+				 (acl2-count dom))
+		  :guard (and (wff f)
+			      (domain-term-list vals)
+			      (implies (not flg)
+				       (domain-term-list (fringe dom))))
+		  :verify-guards nil))
+  (if flg
+      (cond ((or (wfand f) (wfor f))
+	     (if (> (exists-count (a1 f)) 0)
+		 (build-sk-i t (a1 f) vals 'junk i)
+	         (build-sk-i t (a2 f) vals 'junk i)))
+	    ((wfexists f) nil)
+	    ((wfall f) (build-sk-i nil f vals (domain i) I))
+	    (t nil))
+    (cond ((wfall f) (if (atom dom)
+			 (build-sk-i t
+				    (subst-free (a2 f) (a1 f) dom)
+				    (append vals (list dom))
+				    'junk
+				    i)
+		       (append (build-sk-i nil f vals (car dom) i)
+			       (build-sk-i nil f vals (cdr dom) i))))
+	  (t nil))))
+
+;;---------------------
+;; Verify the guard for build-sk and build-sk-i.
+
+(defthm build-sk-true-listp-flg
+  (if flg
+      (true-listp (build-sk f vals i))
+      (true-listp (build-sk-d f vals dom i)))
+  :hints (("Goal"
+	   :induct (build-sk-i flg f vals dom i)))
+  :rule-classes nil)
+
+(defthm build-sk-d-true-listp
+  (true-listp (build-sk-d f vals dom i))
+  :hints (("Goal"
+	   :by (:instance build-sk-true-listp-flg (flg nil)))))
+
+(defthm build-sk-i-true-listp
+  (true-listp (build-sk-i flg f vals dom i)))
+
+(verify-guards build-sk)
+
+(verify-guards build-sk-i)
+
+;;---------------------
+;; After we build the skolem function, we have to be able to insert it
+;; into an interpretation.  It is useful to have two versions, step-ex
+;; and step-ex-d, corresponding to the two mutually recursive build
+;; functions.
+
+(defun insert-func-into-interp (fsym-arity func i)
+  (declare (xargs :guard (alistp func)))
+  (if (consp fsym-arity)
+      (cons (domain i)
+	    (cons (relations i)
+		  (cons (cons fsym-arity func) (functions i))))
+    i))
+
+(defthm build-sk-alistp-flg  ;; for step-sk guard
+  (if flg
+      (alistp (build-sk f vals i))
+      (alistp (build-sk-d f vals dom i)))
+  :hints (("Goal"
+	   :induct (build-sk-i flg f vals dom i)))
+  :rule-classes nil)
+
+(defthm build-sk-alistp  ;; for step-sk guard
+  (alistp (build-sk f vals i))
+  :hints (("Goal"
+	   :by (:instance build-sk-alistp-flg (flg t)))))
+
+(defthm build-sk-d-alistp  ;; for step-sk guard
+  (alistp (build-sk-d f vals dom i))
+  :hints (("Goal"
+	   :by (:instance build-sk-alistp-flg (flg nil)))))
+
+(defun step-ex (f fsym vals i)
+  (declare (xargs :guard (and (wff f) (nnfp f) (function-symbol fsym)
+			      (domain-term-list vals))))
+  (insert-func-into-interp (cons fsym (step-sk-arity f (len vals)))
+			   (build-sk f vals i) i))
+
+(defun step-ex-d (f fsym vals dom i)
+  (declare (xargs :guard (and (wff f) (nnfp f) (function-symbol fsym)
+			      (domain-term-list vals)
+			      (domain-term-list (fringe dom))
+			      (subsetp-equal (fringe dom)
+					     (fringe (domain i))))))
+  (insert-func-into-interp (cons fsym (step-sk-arity f (len vals)))
+			   (build-sk-d f vals dom i) i))
+
+;;---------
+;; The following induction scheme is useful when proving things
+;; involving both step-sk and step-sk-sym.  The recursion on f
+;; is similar to both; the vars argument is like step-sk, and the n
+;; argument is like step-sk-sym.
+
+(defun step-sk-sym-i2 (f vars n)
+  (declare (xargs :guard (and (wff f)
+			      (nnfp f)
+			      (var-list vars)
+			      (natp n))))
+  (cond ((or (wfand f) (wfor f))
+	 (if (> (exists-count (a1 f)) 0)
+	     (step-sk-sym-i2 (a1 f) vars n)
+	     (step-sk-sym-i2 (a2 f) vars n)))
+	((wfall f) (step-sk-sym-i2 (a2 f)
+				   (append vars (list (a1 f)))
+				   (+ 1 n)))
+	(t nil)))
+
+(defthm step-sk-without-exists
+  (implies (equal (exists-count f) 0)
+	   (equal (step-sk f vars fsym) f)))
+
+;;---------------------------------------------------------
+;; step-sk-preserves-closedness
+
+(defthm not-var-occurrence-append-list
+  (implies (and (not (var-occurrence-term-list x vars))
+		(variable-term y)
+		(not (equal x y)))
+	   (not (var-occurrence-term-list x (append vars (list y))))))
+
+(defthm not-var-occurrence-subst-term-list
+  (implies (and (variable-term y)
+		(var-list vars)
+		(not (var-occurrence-term-list x l))
+		(not (var-occurrence-term-list x vars)))
+	   (not (var-occurrence-term-list
+		 x
+		 (subst-term-list l y (cons fsym vars))))))
+
+(defthm not-free-occurrence-subst-free
+  (implies (and (variable-term y)
+		(var-list vars)
+		(not (free-occurrence x f))
+		(not (var-occurrence-term-list x vars)))
+	   (not (free-occurrence x (subst-free f y (cons fsym vars)))))
+  :hints (("Goal"
+	   :induct (free-occurrence x f))))
+
+(defthm not-var-ococurrence-list-tm
+  (implies (and (var-list vars)
+		(not (var-occurrence-term-list x vars)))
+	   (not (var-occurrence-term-list x (list (cons fsym vars))))))
+
+(defthm not-free-occurrence-list-tm
+  (implies (and (var-list vars)
+		(not (var-occurrence-term-list x vars)))
+	   (not (free-occurrence x (subst-free f x (cons fsym vars)))))
+  :hints (("Goal"
+	   :induct (free-occurrence x (subst-free f x (cons fsym vars))))))
+
+(defthm step-sk-preserves-closedness-h1
+  (implies (and (not (free-occurrence x f))
+		(var-list vars)
+		(not (var-occurrence-term-list x vars)))
+	   (not (free-occurrence x (step-sk f vars fsym)))))
+
+(defthm step-sk-preserves-closedness-h2
+  (implies (not (free-occurrence x f))
+	   (not (free-occurrence x (step-sk f nil fsym)))))
+
+(defthm step-sk-preserves-closedness-h3
+  (implies (not (member-equal x (free-vars f)))
+	   (not (member-equal x (free-vars (step-sk f nil fsym)))))
+  :hints (("Goal"
+           :use ((:instance free-free)
+		 (:instance free-free (f (step-sk f nil fsym)))))))
+
+(defthm step-sk-preserves-closedness
+  (implies (not (free-vars f))
+	   (not (free-vars (step-sk f nil fsym))))
+  :hints (("Goal"
+	   :do-not-induct t
+           :use ((:instance consp-has-member-equal
+			    (x (free-vars (step-sk f nil fsym))))))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.lisp
new file mode 100644
index 0000000..e58da91
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-useless.lisp
@@ -0,0 +1,89 @@
+(in-package "ACL2")
+
+;; In this book we prove that if a formula lacks a given function
+;; symbol, and if an interpretation has a corresponding function
+;; at the start of its function list, then we can delete the
+;; function from the function list when evaluating the formula.
+
+(include-book "sk-misc-lemmas")
+
+;;------------------------
+
+(defthm eval-term-list-with-useless-function
+  (implies (not (member-equal fsym (funcs-in-term-list l)))
+	   (equal (eval-term-list l (list* i1 i3
+					   (cons (cons fsym n) func)
+					   i4))
+		  (eval-term-list l (list* i1 i3 i4))))
+  :hints (("Goal"
+	   :in-theory (enable domain))))
+
+(defthm not-member-funcs-a
+  (implies (and (consp l)
+		(not (member-equal fsym (funcs-in-term-list l))))
+	   (not (member-equal fsym (funcs-in-term-list (list (car l)))))))
+
+(defthm not-member-funcs-b
+  (implies (not (member-equal fsym (funcs-in-term-list (cons a l))))
+	   (not (member-equal fsym (funcs-in-term-list (list a)))))
+  :hints (("Goal"
+         :use ((:instance not-member-funcs-a (l (cons a l)))))))
+
+(defthm not-member-union-forward-right
+  (implies (not (member-equal x (union-equal a b)))
+	   (not (member-equal x b)))
+  :rule-classes :forward-chaining)
+
+(defthm not-member-funcs-subst-term-list
+  (implies
+   (and (domain-term e)
+	(not (member-equal fsym (funcs-in-term-list l))))
+   (not (member-equal fsym (funcs-in-term-list (subst-term-list l x e))))))
+
+(defthm not-member-funcx-subst
+  (implies (and (domain-term e)
+		(not (member-equal fsym (funcs-in-formula f))))
+	   (not (member-equal fsym (funcs-in-formula (subst-free f x e))))))
+
+;;-----------------------
+;; Here are the 3 versions of the main result of this book.
+;; Prove it with xeval, then use that to get the versions
+;; in terms of feval and feval-d.
+
+(defthm xeval-with-useless-function
+  (implies (and (not (member-equal fsym (funcs-in-formula f)))
+		(domain-term-list (fringe dom)))
+	   (equal (xeval f dom (list* (domain i) (relations i)
+				      (cons (cons fsym n) func)
+				      (functions i)))
+		  (xeval f dom (list* (domain i)
+				      (relations i)
+				      (functions i)))))
+  :hints (("Goal"
+	   :do-not generalize
+	   :in-theory (enable eval-atomic)
+	   :induct (xeval-i f dom i))))
+
+(defthm feval-with-useless-function
+  (implies (not (member-equal fsym (funcs-in-formula f)))
+	   (equal (feval f (list* (domain i) (relations i)
+				  (cons (cons fsym n) func)
+				  (functions i)))
+		  (feval f (list* (domain i)
+				  (relations i)
+				  (functions i)))))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval))))
+
+(defthm feval-d-with-useless-function
+  (implies (and (not (member-equal fsym (funcs-in-formula f)))
+		(domain-term-list (fringe dom))
+		(wfquant f))
+	   (equal (feval-d f dom (list* (domain i) (relations i)
+					(cons (cons fsym n) func)
+					(functions i)))
+		  (feval-d f dom (list* (domain i)
+					(relations i)
+					(functions i)))))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval-d))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.lisp
new file mode 100644
index 0000000..8f55956
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sk-xbuild.lisp
@@ -0,0 +1,966 @@
+(in-package "ACL2")
+
+;; This is a nasty (and slow) book.  Lemmas xeval-append-a and
+;; xeval-append-b below are the what we need in book sk-step-sound.
+;; The need for these arise because of the way build-sk uses the
+;; domain to build a Skolem function.  In particular, the function
+;; is built for the two "halfs" of the domain then appended.
+;; When proving soundness of sk-step, this append shows itself in
+;; an ugly way.
+
+(include-book "sk-useless")
+(include-book "sk-step")
+(set-well-founded-relation e0-ord-<)
+
+;;------------------------------------------------------
+;; Miscellaneus lemmas placed here during a reorganization.
+
+(defthm subst-term-list-append-commute
+  (implies (and (variable-term y)
+		(not (equal y x)))
+	   (equal (subst-term-list (append vars (list y)) x e)
+		  (append (subst-term-list vars x e) (list y)))))
+
+(defthm subst-sk-commute-helper
+ (implies (and (domain-term e)
+	       (function-symbol fsym)
+	       (true-listp args)
+	       (not (equal x y))
+	       (not (member-equal x (quantified-vars f))))
+	  (equal (subst-free (subst-free f x e) y
+			     (cons fsym (subst-term-list args x e)))
+		 (subst-free (subst-free f y (cons fsym args)) x e)))
+ :hints (("goal"
+	  :use ((:instance subst-flip-fix (tm (cons fsym args))))
+	  :do-not-induct t)))
+
+(defthm subst-free-step-sk-commute
+  (implies (and (domain-term e)
+		(true-listp args)
+		(function-symbol fsym)
+		(not (member-equal x (quantified-vars f))))
+	   (equal (subst-free (step-sk f args fsym) x e)
+		  (step-sk (subst-free f x e)
+			   (subst-term-list args x e) fsym)))
+  :hints (("Goal"
+	   :induct (step-sk f args fsym))))
+
+;;------------------------------------------------------------
+;; Here is a non-mutual version of build-sk/build-sk-d.  This
+;; is analogous to the xeval version of feval/feval-d.
+
+(defun xbuild (f vals dom i)
+  (declare (xargs :measure (cons (wff-count f) (acl2-count dom))
+		   :guard (and (wff f)
+			       (nnfp f)
+			       (domain-term-list vals)
+			       (domain-term-list (fringe dom)))
+		   :verify-guards nil
+		   ))
+   (cond ((or (wfand f) (wfor f))
+	  (if (> (exists-count (a1 f)) 0)
+	      (xbuild (a1 f) vals dom i)
+	      (xbuild (a2 f) vals dom i)))
+	 ((wfexists f) (list (cons vals (val-or-0 (a2 f)
+						  (a1 f)
+						  (domain i) i))))
+	 ((wfall f)
+	  (if (atom dom)
+	      (xbuild (subst-free (a2 f) (a1 f) dom)
+			(append vals (list dom)) (domain i) i)
+	      (append (xbuild f vals (car dom) i)
+		      (xbuild f vals (cdr dom) i))))
+	 (t nil)))
+
+(defthm true-listp-xbuild
+  (true-listp (xbuild f vals dom i)))
+
+(verify-guards xbuild)
+
+(defthm xbuild-build-flg
+  (if flg
+      (equal (build-sk f vals i)
+	     (xbuild f vals (domain i) i))
+    (implies (wfall f)
+	     (equal (build-sk-d f vals dom i)
+		    (xbuild f vals dom i))))
+  :hints (("Goal"
+           :do-not generalize
+           :induct (build-sk-i flg f vals dom i)))
+  :rule-classes nil)
+
+(defthm xbuild-build-sk
+  (equal (build-sk f vals i)
+	 (xbuild f vals (domain i) i))
+  :hints (("Goal"
+           :by (:instance xbuild-build-flg (flg t)))))
+
+(defthm xbuild-build-sk-d
+  (implies (wfall f)
+	   (equal (build-sk-d f vals dom i)
+		  (xbuild f vals dom i)))
+  :hints (("Goal"
+           :by (:instance xbuild-build-flg (flg nil)))))
+
+(in-theory (disable xbuild-build-sk xbuild-build-sk-d))
+
+;;------------------------------------
+;; following 3 help sk-subst-commute lemma
+
+(defthm true-listp-append-list
+  (true-listp (append a (list x))))
+
+(defthm subst-term-list-append-list
+  (implies (variable-term x)
+	   (equal (subst-term-list (append lst (list x)) x tm)
+		  (append (subst-term-list lst x tm) (list tm)))))
+
+(defthm subst-term-list-domain-term-list
+  (implies (domain-term-list vals)
+	   (equal (subst-term-list vals x tm)
+		  vals)))
+
+;;------------------------------------
+
+(defun ith-member (lst n)
+  (declare (xargs :guard (integerp n)))
+
+  (cond ((atom lst) nil)
+	((equal n 1) (car lst))
+	(t (ith-member (cdr lst) (- n 1)))))
+
+(defun func-pos-n (func n lst)
+  (declare (xargs :guard (and (integerp n)
+			      (> n 0)
+			      (true-listp lst))))
+  (if (atom func)
+      t
+      (and (if (atom (car func))
+	       t
+	       (member-equal (ith-member (caar func) n) lst))
+	   (func-pos-n (cdr func) n lst))))
+
+(defthm func-pos-n-append-append
+  (implies (and (func-pos-n f1 n l1)
+		(func-pos-n f2 n l2))
+	   (func-pos-n (append f1 f2) n (append l1 l2))))
+
+(defthm func-pos-n-append
+  (implies (and (func-pos-n f1 n lst)
+		(func-pos-n f2 n lst))
+	   (func-pos-n (append f1 f2) n lst)))
+
+(defthm ith-member-append-junk
+  (implies (<= n (len lst))
+	   (equal (ith-member (append lst junk) n)
+		  (ith-member lst n))))
+
+(defun tuple-pos-n (vals n e)
+  (declare (xargs :guard (and (domain-term-list vals)
+			      (natp n)
+			      (domain-term e))))
+  (equal (ith-member vals n) e))
+
+(defthm fapply-append-1
+  (implies (not (fassoc tuple func1))
+	   (equal (fapply (append func1 func2) tuple)
+		  (fapply func2 tuple)))
+  :hints (("Goal"
+           :in-theory (enable fapply))))
+
+(defthm fapply-append-2
+  (implies (not (fassoc tuple func2))
+	   (equal (fapply (append func1 func2) tuple)
+		  (fapply func1 tuple)))
+  :hints (("Goal"
+           :in-theory (enable fapply))))
+
+;;------------------------------------
+
+(defthm func-pos-n-not-fassoc
+  (implies (and (func-pos-n func n lst)
+		(not (member-equal (ith-member vals n) lst))
+		(< 0 n)
+		(<= n (len vals)))
+	   (not (fassoc vals func)))
+  :rule-classes :forward-chaining)
+
+(defthm eval-term-list-append-a  ;; ok
+  (implies
+   (and (variable-term z)
+	(domain-term-list vls)
+	(subsetp-equal vls (fringe (domain i)))
+	(function-symbol fsym)
+	(not (member-equal fsym (funcs-in-term-list lst)))
+	(integerp n)
+	(< 0 n)
+	(<= n (len vls))
+	(domain-term (ith-member vls n))
+	(not (member-equal (ith-member vls n) (fringe dm)))
+	(func-pos-n func1 n (fringe dm))
+	)
+   (equal (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       (append func1 func2))
+				 (functions i)))
+	  (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       func2)
+				 (functions i)))))
+  :hints (("Goal"
+	   :induct (subst-term-list lst z (cons fsym vls))
+	   ))
+  :rule-classes nil)
+
+;; The preceding rule doesn't get applied because of the free
+;; variables n and dm.  Here is a trick.  The function (arg-1-of-3 func n dm)
+;; which just projects out the first argument, is used to plant the
+;; free variables n and dm in the trigger term.  We make a new rule
+;; which is similar to the preceding, but with (arg-1-of-3 func1 n dm)
+;; instead of func1.  Then we disable arg-1-of-3, and the modified rule
+;; gets used automatically as we wish.  (Later on, we get rid of the
+;; arg-1-of-3 term.)
+
+(defun arg-1-of-3 (func n dm)
+  (declare (xargs :guard t)
+	   (ignore n dm))
+  func)
+
+(defthm eval-term-list-append-ax
+  (implies
+   (and (variable-term z)
+	(domain-term-list vls)
+	(subsetp-equal vls (fringe (domain i)))
+	(function-symbol fsym)
+	(not (member-equal fsym (funcs-in-term-list lst)))
+	(integerp n)
+	(< 0 n)
+	(<= n (len vls))
+	(domain-term (ith-member vls n))
+	(not (member-equal (ith-member vls n) (fringe dm)))
+	(func-pos-n func1 n (fringe dm))
+	)
+   (equal (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       (append (arg-1-of-3 func1 n dm) func2))
+				 (functions i)))
+	  (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       func2)
+				 (functions i)))))
+  :hints (("Goal"
+	   :use ((:instance eval-term-list-append-a)))))
+
+(in-theory (disable arg-1-of-3))
+
+(local (include-book "arithmetic"))
+
+(defthm list-car-subst-term-list-car
+  (implies (> (len a) 0)
+	   (equal (list (car (subst-term-list a x tm)))
+		  (subst-term-list (list (car a)) x tm))))
+
+(defthm list-car-subst-term-list-cadr
+  (implies (> (len a) 1)
+	   (equal (list (cadr (subst-term-list a x tm)))
+		  (subst-term-list (list (cadr a)) x tm))))
+
+(defthm not-member-fsym-list-cadr
+  (implies (not (member-equal fsym (funcs-in-term-list (cdr f))))
+	   (not (member-equal fsym (funcs-in-term-list (list (cadr f)))))))
+
+(defthm not-member-fsym-list-caddr
+  (implies (not (member-equal fsym (funcs-in-term-list (cdr f))))
+	   (not (member-equal fsym (funcs-in-term-list (list (caddr f)))))))
+
+(defthm variable-not-in-domain-term-list-a
+  (implies (domain-term-list vals)
+	   (not (var-occurrence-term-list x vals))))
+
+(defthm variable-not-in-domain-term-list-b
+  (implies (domain-term-list vals)
+	   (not (var-occurrence-term-list x (list (cons fsym vals))))))
+
+(defthm xeval-append-a-1  ;; ok, 251 seconds
+  (implies (and (variable-term z)
+		(domain-term-list vls)
+		(subsetp-equal vls (fringe (domain i)))
+		(function-symbol fsym)
+		(not (member-equal fsym (funcs-in-formula f)))
+		(not (member-equal z (quantified-vars f)))
+		(setp (quantified-vars f))
+		(integerp n)
+		(< 0 n)
+		(<= n (len vls))
+		(domain-term (ith-member vls n))
+		(not (member-equal (ith-member vls n) (fringe dm)))
+		(func-pos-n func1 n (fringe dm))
+		(domain-term-list (fringe dom)))
+	   (equal (xeval (subst-free f z (cons fsym vls))
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (len vls))
+				      (append (arg-1-of-3 func1 n dm) func2))
+				(functions i)))
+		  (xeval (subst-free f z (cons fsym vls))
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (len vls))
+				      func2)
+				(functions i)))))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i)
+	   :in-theory (enable eval-atomic)
+	   )))
+
+;;--------------------------------------------------
+
+(defthm subst-free-preserves-step-sk-arity
+  (equal (step-sk-arity (subst-free f x tm) n)
+	 (step-sk-arity f n)))
+
+(defthm xeval-append-a-2  ;; 121 sec
+  (implies (and (function-symbol fsym)
+		(domain-term-list vls)
+		(subsetp-equal vls (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(integerp n) (> n 0) (<= n (len vls))
+		(domain-term e)
+		(not (member-equal e (fringe dm)))
+		(func-pos-n func1 n (fringe dm))
+		(tuple-pos-n vls n e)
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      (append (arg-1-of-3 func1 n dm) func2))
+				(functions i)))
+		  (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      func2)
+				(functions i)))))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (xbuild f vls dom i))))
+
+(defthm xeval-append-a-3  ;; get rid of arg-1-of-3
+  (implies (and (function-symbol fsym)
+		(domain-term-list vls)
+		(subsetp-equal vls (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(integerp n) (> n 0) (<= n (len vls))
+		(domain-term e)
+		(not (member-equal e (fringe dm)))
+		(func-pos-n func1 n (fringe dm))
+		(tuple-pos-n vls n e)
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      (append func1 func2))
+				(functions i)))
+		  (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      func2)
+				(functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-a-2))
+	   :in-theory (enable arg-1-of-3))))
+
+(defthm ith-member-append-list
+  (equal (ith-member (append lst (list e)) (+ 1 (len lst)))
+	 e))
+
+(defthm xeval-append-a-4
+  (implies (and (not (consp dom))
+		(function-symbol fsym)
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f5)))
+		(setp (quantified-vars f5))
+		(not (member-equal dom (fringe dm)))
+		(func-pos-n func1 (+ 1 (len vals))
+			    (fringe dm))
+		(domain-term dom)
+		(member-equal dom (fringe (domain i))))
+	   (equal (xeval (step-sk (subst-free f5 f3 dom)
+				  (append vals (list dom))
+				  fsym)
+			 (domain i)
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym
+					    (step-sk-arity f5 (+ 1
+								 (len vals))))
+				      (append func1 func2))
+				(functions i)))
+		  (xeval (step-sk (subst-free f5 f3 dom)
+				  (append vals (list dom))
+				  fsym)
+			 (domain i)
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym
+					    (step-sk-arity f5 (+ 1
+								 (len vals))))
+				      func2)
+				(functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-a-3
+			    (e dom)
+			    (dom (domain i))
+			    (f (subst-free f5 f3 dom))
+			    (vls (append vals (list dom)))
+			    (n (+ 1 (len vals)))))
+           :do-not-induct t)))
+
+(defthm xeval-append-a-5  ;; 141 sec
+  (implies (and (function-symbol fsym)
+		(< (len vals) (step-sk-arity f (len vals)))
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(disjoint (fringe dom) (fringe dm))
+		(func-pos-n func1 (+ 1 (len vals)) (fringe dm))
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      (append func1
+					      func2))
+
+				(functions i)))
+		  (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      func2)
+				(functions i)))))
+  :hints (("Goal"
+	   :induct (xbuild f vals dom i))))
+
+;;---------------------
+
+(defthm xbuild-pos
+  (implies (and (integerp n)
+		(<= n (len vals)))
+	   (func-pos-n (xbuild f vals dom i)
+		       n
+		       (list (ith-member vals n)))))
+
+(defthm xbuild-pos-last
+  (func-pos-n (xbuild f (append vals (list e)) dom i)
+	      (+ 1 (len vals))
+	      (list e))
+  :hints (("Goal"
+	   :in-theory (disable xbuild-pos)
+	   :use ((:instance xbuild-pos
+			    (vals (append vals (list e)))
+			    (n (+ 1 (len vals))))))))
+
+(defthm xbuild-pos-all
+  (implies (and (wfall f))
+	   (func-pos-n (xbuild f vals dom i)
+		       (+ 1 (len vals))
+		       (fringe dom)))
+  :hints (("goal"
+	   :expand ((xbuild (list 'all f3 f5) vals dom i))
+	   :induct (dom-i dom))))
+
+(defthm step-sk-sym-n-1
+  (implies (step-sk-arity f n)
+	   (<= n (step-sk-arity f n)))
+  :rule-classes nil)
+
+(defthm step-sk-sym-n-2
+  (implies (step-sk-arity f (+ 1 n))
+	   (< n (step-sk-arity f (+ 1 n))))
+  :hints (("Goal"
+	   :use ((:instance step-sk-sym-n-1 (n (+ 1 n)))))))
+
+(defthm step-sk-sym-n-3
+  (implies (and (wfall f)
+		(step-sk-arity f n))
+	   (< n (step-sk-arity f n))))
+
+(defthm xeval-append-a-6
+  (implies (and (wfall f)
+		(function-symbol fsym)
+		(step-sk-arity f (len vals))
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(disjoint (fringe dom) (fringe dm))
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      (append (xbuild f vals dm i)
+					      func2))
+				(functions i)))
+		  (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      func2)
+				(functions i))))))
+
+(defthm xeval-append-a-7
+  (implies
+   (and (variable-term y)
+	(function-symbol fsym)
+	(step-sk-arity g (+ 1 (len vals)))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula g)))
+	(not (member-equal y (quantified-vars g)))
+	(setp (quantified-vars g))
+	(disjoint (fringe dom) (fringe dm))
+	(domain-term-list (fringe dom))
+	(subsetp-equal (fringe dom)
+		       (fringe (domain i))))
+   (equal (xeval (list 'all y (step-sk g (append vals (list y)) fsym))
+		 dom
+		 (list* (domain i)
+			(relations i)
+			(cons (cons fsym (step-sk-arity g (+ 1 (len vals))))
+			      (append (xbuild (list 'all y g) vals dm i)
+				      func2))
+			(functions i)))
+	  (xeval (list 'all y (step-sk g (append vals (list y)) fsym))
+		 dom
+		 (list* (domain i)
+			(relations i)
+			(cons (cons fsym (step-sk-arity g (+ 1 (len vals))))
+			      func2)
+			(functions i)))))
+  :hints (("Goal"
+           :use ((:instance xeval-append-a-6 (f (list 'all y g)))))))
+
+(defthm xeval-append-a
+  (implies
+   (and (variable-term y)
+	(function-symbol fsym)
+	(step-sk-arity f (+ 1 (len vals)))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula f)))
+	(not (member-equal y (quantified-vars f)))
+	(setp (quantified-vars f))
+	(disjoint (fringe dom) (fringe dm))
+	(domain-term-list (fringe dom))
+	(subsetp-equal (fringe dom) (fringe (domain i))))
+   (equal (feval-d (list 'all y (step-sk f (append vals (list y)) fsym))
+		   dom
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym (step-sk-arity f (+ 1 (len vals))))
+				(append (build-sk-d (list 'all y f) vals dm i)
+					func2))
+			  (functions i)))
+	  (feval-d (list 'all y (step-sk f (append vals (list y)) fsym))
+		   dom
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym (step-sk-arity f (+ 1 (len vals))))
+				func2)
+			  (functions i)))))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval-d xbuild-build-sk-d))))
+
+;;------------------------------------
+;; Next, prove the analogous theorem for the other side append.
+;; All of these theorems are similar to preceding ones.
+;;
+;; It probably would be cleaner to prove something like the following,
+;; then use the theorem for the first side.
+;;
+;; (implies
+;;  (disjoint (fringe dom1) (fringe dom2))
+;;  (equal (feval f (list* (domain i)
+;;                          (relations i)
+;;                          (cons sym-arity
+;;                                (append
+;;                                 (build-sk-d (list 'all y f) vals dom1 i)
+;;                                 (build-sk-d (list 'all y f) vals dom2 i)
+;;                                 ))
+;;                          (functions i)))
+;;          (feval f (list* (domain i)
+;;                          (relations i)
+;;                          (cons sym-arity
+;;                                (append
+;;                                 (build-sk-d (list 'all y f) vals dom2 i)
+;;                                 (build-sk-d (list 'all y f) vals dom1 i)
+;;                                 ))
+;;                          (functions i)))))
+;;
+;; In fact, I started to prove this (see work-append-other), but it
+;; wasn't easy, so I did it this way instead.
+
+(defthm eval-term-list-append-b
+  (implies
+   (and (variable-term z)
+	(domain-term-list vls)
+	(subsetp-equal vls (fringe (domain i)))
+	(function-symbol fsym)
+	(not (member-equal fsym (funcs-in-term-list lst)))
+	(integerp n)
+	(< 0 n)
+	(<= n (len vls))
+	(domain-term (ith-member vls n))
+	(not (member-equal (ith-member vls n) (fringe dm)))
+	(func-pos-n func2 n (fringe dm))
+	)
+   (equal (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       (append func1 func2))
+				 (functions i)))
+	  (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       func1)
+				 (functions i)))))
+  :hints (("Goal"
+	   :induct (subst-term-list lst z (cons fsym vls))
+	   ))
+  :rule-classes nil)
+
+(in-theory (enable arg-1-of-3))
+
+(defthm eval-term-list-append-bx
+  (implies
+   (and (variable-term z)
+	(domain-term-list vls)
+	(subsetp-equal vls (fringe (domain i)))
+	(function-symbol fsym)
+	(not (member-equal fsym (funcs-in-term-list lst)))
+	(integerp n)
+	(< 0 n)
+	(<= n (len vls))
+	(domain-term (ith-member vls n))
+	(not (member-equal (ith-member vls n) (fringe dm)))
+	(func-pos-n func2 n (fringe dm))
+	)
+   (equal (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       (append func1 (arg-1-of-3 func2 n dm)))
+				 (functions i)))
+	  (eval-term-list (subst-term-list lst z (cons fsym vls))
+			  (list* (domain i)
+				 (relations i)
+				 (cons (cons fsym (len vls))
+				       func1)
+				 (functions i)))))
+  :hints (("Goal"
+	   :use ((:instance eval-term-list-append-b)))))
+
+(in-theory (disable arg-1-of-3))
+
+(defthm xeval-append-b-1  ;; ok, 251 seconds
+  (implies (and (variable-term z)
+		(domain-term-list vls)
+		(subsetp-equal vls (fringe (domain i)))
+		(function-symbol fsym)
+		(not (member-equal fsym (funcs-in-formula f)))
+		(not (member-equal z (quantified-vars f)))
+		(setp (quantified-vars f))
+		(integerp n)
+		(< 0 n)
+		(<= n (len vls))
+		(domain-term (ith-member vls n))
+		(not (member-equal (ith-member vls n) (fringe dm)))
+		(func-pos-n func2 n (fringe dm))
+		(domain-term-list (fringe dom)))
+	   (equal (xeval (subst-free f z (cons fsym vls))
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (len vls))
+				      (append func1 (arg-1-of-3 func2 n dm)))
+				(functions i)))
+		  (xeval (subst-free f z (cons fsym vls))
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (len vls))
+				      func1)
+				(functions i)))))
+  :hints (("Goal"
+	   :induct (xeval-i f dom i)
+	   :in-theory (enable eval-atomic)
+	   )))
+
+;;--------------------------------------------------
+
+(defthm xeval-append-b-2  ;; 121 sec
+  (implies (and (function-symbol fsym)
+		(domain-term-list vls)
+		(subsetp-equal vls (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(integerp n) (> n 0) (<= n (len vls))
+		(domain-term e)
+		(not (member-equal e (fringe dm)))
+		(func-pos-n func2 n (fringe dm))
+		(tuple-pos-n vls n e)
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      (append func1 (arg-1-of-3 func2 n dm)))
+				(functions i)))
+		  (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      func1)
+				(functions i)))))
+  :hints (("Goal"
+	   :do-not generalize
+	   :induct (xbuild f vls dom i))))
+
+(defthm xeval-append-b-3  ;; get rid of arg-1-of-3
+  (implies (and (function-symbol fsym)
+		(domain-term-list vls)
+		(subsetp-equal vls (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(integerp n) (> n 0) (<= n (len vls))
+		(domain-term e)
+		(not (member-equal e (fringe dm)))
+		(func-pos-n func2 n (fringe dm))
+		(tuple-pos-n vls n e)
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      (append func1 func2))
+				(functions i)))
+		  (xeval (step-sk f vls fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vls)))
+				      func1)
+				(functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-b-2))
+	   :in-theory (enable arg-1-of-3))))
+
+(defthm xeval-append-b-4
+  (implies (and (not (consp dom))
+		(function-symbol fsym)
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f5)))
+		(setp (quantified-vars f5))
+		(not (member-equal dom (fringe dm)))
+		(func-pos-n func2 (+ 1 (len vals))
+			    (fringe dm))
+		(domain-term dom)
+		(member-equal dom (fringe (domain i))))
+	   (equal (xeval (step-sk (subst-free f5 f3 dom)
+				  (append vals (list dom))
+				  fsym)
+			 (domain i)
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym
+					    (step-sk-arity f5 (+ 1
+								 (len vals))))
+				      (append func1 func2))
+				(functions i)))
+		  (xeval (step-sk (subst-free f5 f3 dom)
+				  (append vals (list dom))
+				  fsym)
+			 (domain i)
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym
+					    (step-sk-arity f5 (+ 1
+								 (len vals))))
+				      func1)
+				(functions i)))))
+  :hints (("Goal"
+	   :use ((:instance xeval-append-b-3
+			    (e dom)
+			    (dom (domain i))
+			    (f (subst-free f5 f3 dom))
+			    (vls (append vals (list dom)))
+			    (n (+ 1 (len vals)))))
+           :do-not-induct t)))
+
+(defthm xeval-append-b-5  ;; 141 sec
+  (implies (and (function-symbol fsym)
+		(< (len vals) (step-sk-arity f (len vals)))
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(disjoint (fringe dom) (fringe dm))
+		(func-pos-n func2 (+ 1 (len vals)) (fringe dm))
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      (append func1 func2))
+				(functions i)))
+		  (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      func1)
+				(functions i)))))
+  :hints (("Goal"
+	   :induct (xbuild f vals dom i))))
+
+;;---------------------
+
+(defthm xeval-append-b-6
+  (implies (and (wfall f)
+		(function-symbol fsym)
+		(step-sk-arity f (len vals))
+		(domain-term-list vals)
+		(subsetp-equal vals (fringe (domain i)))
+		(not (member-equal fsym (funcs-in-formula f)))
+		(setp (quantified-vars f))
+		(disjoint (fringe dom) (fringe dm))
+		(domain-term-list (fringe dom))
+		(subsetp-equal (fringe dom) (fringe (domain i)))
+		)
+	   (equal (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      (append func1 (xbuild f vals dm i)))
+
+				(functions i)))
+		  (xeval (step-sk f vals fsym)
+			 dom
+			 (list* (domain i)
+				(relations i)
+				(cons (cons fsym (step-sk-arity f (len vals)))
+				      func1)
+				(functions i))))))
+
+(defthm xeval-append-b-7
+  (implies
+   (and (variable-term y)
+	(function-symbol fsym)
+	(step-sk-arity g (+ 1 (len vals)))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula g)))
+	(not (member-equal y (quantified-vars g)))
+	(setp (quantified-vars g))
+	(disjoint (fringe dom) (fringe dm))
+	(domain-term-list (fringe dom))
+	(subsetp-equal (fringe dom) (fringe (domain i))))
+   (equal (xeval (list 'all y (step-sk g (append vals (list y)) fsym))
+		 dom
+		 (list* (domain i)
+			(relations i)
+			(cons (cons fsym (step-sk-arity g (+ 1 (len vals))))
+			      (append func1
+				      (xbuild (list 'all y g) vals dm i)))
+			(functions i)))
+	  (xeval (list 'all y (step-sk g (append vals (list y)) fsym))
+		 dom
+		 (list* (domain i)
+			(relations i)
+			(cons (cons fsym (step-sk-arity g (+ 1 (len vals))))
+			      func1)
+			(functions i)))))
+  :hints (("Goal"
+           :use ((:instance xeval-append-b-6 (f (list 'all y g)))))))
+
+(defthm xeval-append-b
+  (implies
+   (and (variable-term y)
+	(function-symbol fsym)
+	(step-sk-arity f (+ 1 (len vals)))
+	(domain-term-list vals)
+	(subsetp-equal vals (fringe (domain i)))
+	(not (member-equal fsym (funcs-in-formula f)))
+	(not (member-equal y (quantified-vars f)))
+	(setp (quantified-vars f))
+	(disjoint (fringe dom) (fringe dm))
+	(domain-term-list (fringe dom))
+	(subsetp-equal (fringe dom) (fringe (domain i))))
+   (equal (feval-d (list 'all y (step-sk f (append vals (list y)) fsym))
+		   dom
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym (step-sk-arity f (+ 1 (len vals))))
+				(append
+				 func1
+				 (build-sk-d (list 'all y f) vals dm i)))
+			  (functions i)))
+	  (feval-d (list 'all y (step-sk f (append vals (list y)) fsym))
+		   dom
+		   (list* (domain i)
+			  (relations i)
+			  (cons (cons fsym (step-sk-arity f (+ 1 (len vals))))
+				func1)
+			  (functions i)))))
+  :hints (("Goal"
+	   :in-theory (enable xeval-feval-d xbuild-build-sk-d))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.lisp
new file mode 100644
index 0000000..8873719
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/skolem-top.lisp
@@ -0,0 +1,153 @@
+(in-package "ACL2")
+
+;; We already have the "step" versions step-sk and step-ex,
+;; which operate on the leftmost existential quantifier.
+;; Here, we define the top versions (which call the step
+;; versions) to handle all existential quantifiers.
+
+(include-book "sk-step-sound")
+
+(include-book "permutations")
+
+;;----------------
+;; Therorems to verify skolem guard.
+
+(defthm step-sk-qvars-subbag
+  (subbag (quantified-vars (step-sk f vars fsym))
+	  (quantified-vars f)))
+
+(defthm setp-member-remove1-equal
+  (implies (setp b)
+	   (not (member-equal x (remove1-equal x b)))))
+
+(defthm setp-remove1-equal
+  (implies (setp b)
+	   (setp (remove1-equal x b))))
+
+(defthm setp-not-subbag
+  (implies (and (setp b)
+		(not (setp a)))
+	   (not (subbag a b))))
+
+(defthm step-sk-preserves-setp-qvars
+  (implies (setp (quantified-vars f))
+	   (setp (quantified-vars (step-sk f vars fsym))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance setp-not-subbag
+			    (a (quantified-vars (step-sk f vars fsym)))
+			    (b (quantified-vars f)))))))
+
+(defthm step-sk-reduces-exists-count
+  (implies (and n (step-sk-arity f n))
+	   (< (exists-count (step-sk f vars fsym))
+	      (exists-count f)))
+  :hints (("Goal"
+	   :induct (step-sk-sym-i2 f vars n))))
+
+(defthm step-sk-reduces-exists-count-2
+  (implies (step-sk-arity f 0)
+	   (< (exists-count (step-sk f vars fsym))
+	      (exists-count f)))
+  :hints (("Goal"
+         :use ((:instance step-sk-reduces-exists-count (n 0))))))
+
+;;----------------------------
+;; Full skolemization and extension, unprotected versions.
+
+(include-book "gensym-e")
+
+(defthm union-symbol-listp
+  (implies (and (symbol-listp a)
+		(symbol-listp b))
+	   (symbol-listp (union-equal a b))))
+
+(defthm funcs-in-formula-symbol-listp
+  (symbol-listp (funcs-in-formula f)))
+
+(defun skolem (f)
+  (declare (xargs :measure (exists-count f)
+		  :guard (and (wff f) (ok-for-skolem f))))
+  (if (step-sk-arity f 0)
+      (skolem (step-sk f nil (gen-symbol 'sk (funcs-in-formula f))))
+      f))
+
+(defun skolem-extend (f i)
+  (declare (xargs :measure (exists-count f)
+		  :guard (and (wff f) (ok-for-skolem f))))
+  (if (step-sk-arity f 0)
+      (skolem-extend (step-sk f nil (gen-symbol 'sk (funcs-in-formula f)))
+		     (step-ex f (gen-symbol 'sk (funcs-in-formula f)) nil i))
+      i))
+
+(defthm skolem-fsound
+  (implies (setp (quantified-vars f))
+	   (equal (feval (skolem f) (skolem-extend f i))
+		  (feval f i))))
+
+;;---------------------
+;; Now, the final, protected versions.
+
+(defun skolemize (f)
+  (declare (xargs :guard (and (wff f) (ok-for-skolem f))))
+  (if (ok-for-skolem f)
+      (skolem f)
+      f))
+
+(defun skolemize-extend (f i)
+  (declare (xargs :guard (and (wff f) (ok-for-skolem f))))
+  (if (ok-for-skolem f)
+      (skolem-extend f i)
+      i))
+
+(defthm skolemize-fsound
+  (equal (feval (skolemize f) (skolemize-extend f i))
+	 (feval f i)))
+
+;;---------------------
+;; A few additional properties of the skolemization functions.
+
+(defthm skolemize-preserves-nnfp
+  (implies (nnfp f)
+	   (nnfp (skolemize f))))
+
+(defthm skolemize-preserves-wff
+  (implies (wff f)
+	   (wff (skolemize f))))
+
+(defthm skolemize-preserves-closedness
+  (implies (not (free-vars f))
+	   (not (free-vars (skolemize f)))))
+
+(defthm skolemize-preserves-setp-qvars
+  (implies (setp (quantified-vars f))
+	   (setp (quantified-vars (skolemize f)))))
+
+(defthm skolemize-extend-with-free-vars
+  (implies (free-vars f)
+	   (equal (skolemize-extend f i) i)))
+
+(defthm not-step-sk-arity-exists-count-0
+  (implies (and (nnfp f)
+		n
+		(not (step-sk-arity f n)))
+	   (equal (exists-count f) 0))
+  :hints (("Goal"
+	   :induct (exists-count f)))
+  :rule-classes nil)
+
+(defthm not-step-sk-arity-exists-count-0-2
+  (implies (and (not (step-sk-arity f 0))
+		(nnfp f))
+	   (equal (exists-count f) 0))
+  :hints (("Goal"
+	   :use ((:instance not-step-sk-arity-exists-count-0 (n 0))))))
+
+(defthm skolemize-exists-free
+  (implies (ok-for-skolem f)
+           (equal (exists-count (skolemize f)) 0)))
+
+;;----------------------------------------------------------------
+;; Disable the top skolemization functions, because they are not recursive.
+
+(in-theory (disable skolemize skolemize-extend))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/stage.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/stage.lisp
new file mode 100644
index 0000000..065be6b
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/stage.lisp
@@ -0,0 +1,10 @@
+(in-package "ACL2")
+
+;; This book simply brings together the two books that are
+;; used for many different operations.
+;;
+;; wfftype book: core definitions, basic theorems about formulas
+;; xeval book: alternate evaluation function
+
+(include-book "wfftype")
+(include-book "xeval")
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/substitution.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/substitution.lisp
new file mode 100644
index 0000000..020905b
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/substitution.lisp
@@ -0,0 +1,178 @@
+(in-package "ACL2")
+
+;; Here we define well-formed substitution, then we use
+;; the theorem that one "subst-free" is sound
+;; (instance-gsound-for-1-substitution) to show that sequentially
+;; applying a well-formed substitution is sound.
+;;
+;; The main theorem in this book is instance-gsound-for-subst:
+;;
+;; If (1) f is quantifier-free,
+;;    (2) (universal-closure f) is true, and
+;;    (3) s is a well-formed substitution,
+;; then
+;;    (universal-closure (sequential-apply s f) is true.
+;;
+;; Note that this is sequential substitution.
+
+(include-book "instance-closure")
+
+;; A well-formed substitution is a list of (variable . term) pairs.
+
+(defun wfsubst (s)
+  (declare (xargs :guard t))
+  (if (atom s)
+      (equal s nil)
+      (and (consp (car s))
+	   (variable-term (caar s))
+	   (wft (cdar s))
+	   (wfsubst (cdr s)))))
+
+(defthm wft-list-strip-cdrs-wfsubst
+  (implies (wfsubst s)
+	   (wft-list (strip-cdrs s))))
+
+(defthm var-list-strip-cars-wfsubst
+  (implies (wfsubst s)
+	   (var-list (strip-cars s))))
+
+(defthm cars-of-wfsubst-is-var-list
+  (implies (wfsubst s)
+	   (var-list (cars s))))
+
+(defthm wfsubst-append
+  (implies (and (wfsubst s1)
+		(wfsubst s2))
+	   (wfsubst (append s1 s2))))
+
+;; To apply a wfsubst to a formula, subst-free is called with each member.
+;; Note that this is not simultaneous substitution (the more standard method),
+;; which could be done by visiting each subterm and using assoc.
+
+(defun sequential-apply (s f)
+  (declare (xargs :guard (and (wfsubst s)
+                              (wff f))))
+  (if (atom s)
+      f
+      (sequential-apply (cdr s) (subst-free f (caar s) (cdar s)))))
+
+;;------------------ The main event
+
+(defthm instance-gsound-for-subst
+  (implies (and (quantifier-free f)
+		(xeval (universal-closure f) (domain i) i)
+		(wfsubst s))
+           (xeval (universal-closure (sequential-apply s f)) (domain i) i))
+  :hints (("Goal"
+	   :induct (sequential-apply s f)
+	   )
+	  ("Subgoal *1/2''"
+	   :use ((:instance instance-xsound-for-1-substitution
+			    (x (caar s))
+			    (tm (cdar s)))))
+	  )
+  :rule-classes nil)
+
+;;-----------------------
+;; Sequential-apply, defined above, is nonstandard.  We use it
+;; because it fits with our soundness proof for instantiation
+;; (thm instance-xsound-for-1-substitution).
+;;
+;; Simultaneous substitution is the standard method, and since Otter
+;; proof objects assume simultaneous substitution, they won't work
+;; with sequential-apply.
+;;
+;; Function seqify below transforms a substitution intended
+;; for simultaneous substitution into one that works for
+;; sequential substitution.
+;;
+;; If we had a function simultaneous-apply, then something like
+;;
+;;    (simultaneous-apply f s) = (sequential-apply f (seqify s vars))
+;;
+;; should hold.
+;;
+;; From a soundness point of view, it is not necessary to prove
+;; anything about seqify; it's intended use is to transform Otter
+;; proof objects, and if it screws up a substitution, then check-proof
+;; will fail.
+;;
+;; But it would be nice to prove some things about it.
+
+(include-book "gensym-e")
+
+(defun intersect-equal (a b)  ;; move to sets?
+  (declare (xargs :guard (and (true-listp a)
+			      (true-listp b))))
+  (cond ((atom a) nil)
+	((member-equal (car a) b) (cons (car a) (intersect-equal (cdr a) b)))
+	(t (intersect-equal (cdr a) b))))
+
+(defthm var-list-intersect-equal  ;; move to variables?
+  (implies (and (var-list a)
+		(var-list b))
+	   (var-list (intersect-equal a b))))
+
+;; Apply subst-term to the cdrs of a wfsubst.
+
+(defun subst-cdrs (s x tm)
+  (declare (xargs :guard (and (wfsubst s)
+			      (variable-term x)
+			      (wft tm))))
+  (if (atom s)
+      s
+      (cons (cons (caar s) (subst-term (cdar s) x tm))
+	    (subst-cdrs (cdr s) x tm))))
+
+(defthm wfsubst-subst-cdrs
+  (implies (and (wft tm)
+		(wfsubst s))
+	   (wfsubst (subst-cdrs s x tm))))
+
+(defun seqify-helper (s vars-to-fix all-vars)
+  (declare (xargs :guard (and (wfsubst s)
+			      (var-list vars-to-fix)
+			      (var-list all-vars))
+		  :verify-guards nil))
+  (if (atom vars-to-fix)
+      s
+     (let ((newvar (gen-symbol 'y all-vars)))
+       (append (seqify-helper (subst-cdrs s (car vars-to-fix) newvar)
+			      (cdr vars-to-fix)
+			      (cons newvar all-vars))
+	       (list (cons newvar (car vars-to-fix)))))))
+
+(defthm true-listp-append-2
+  (implies (true-listp a)
+	   (true-listp (append b a))))
+
+(defthm var-list-is-symbol-listp
+  (implies (var-list vars)
+	   (symbol-listp vars)))
+
+(defthm seqify-helper-true-listp
+  (implies (true-listp s)
+	   (true-listp (seqify-helper s x y))))
+
+(verify-guards seqify-helper :otf-flg t)
+
+;; Function seqify transforms a substitution meant for simultaneous
+;; application into one that works with sequential application.
+;; Parameter other-vars contains all variables in terms to which
+;; the substitution will be applied.  (Other-vars helps us to safely
+;; generate new variables.)
+
+(defun seqify (s other-vars)
+  (declare (xargs :guard (and (wfsubst s)
+			      (var-list other-vars))))
+  (seqify-helper s
+		 (intersect-equal (cars s) (vars-in-term-list (cdrs s)))
+		 (union-equal (union-equal (cars s)
+					   (vars-in-term-list (cdrs s)))
+			      other-vars)))
+
+(defthm wfsubst-seqify-helper
+  (implies (and (wfsubst s)
+		(var-list a))
+	   (wfsubst (seqify-helper s a b))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/sugar.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sugar.lisp
new file mode 100644
index 0000000..aa1fb7a
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/sugar.lisp
@@ -0,0 +1,328 @@
+(in-package "ACL2")
+
+;; Conjunctions and disjunctions in wffs must be binary.  But it's not
+;; fair to ask users (i.e., us) to write formulas like that.
+;;
+;; We define a recognizer SWEET-WFF and functions UNSWEETEN
+;; and SWEETEN to translate between SWEET-WFF and WFF.
+;; I expect that sweet formulas will be used only for I/O.
+;; In order to prove that the translations give "equivalent" formulas
+;; we would have to define evaluation for sweet formulas;
+;; I don't see any other use for sweet-feval, so why bother?
+;;
+;; Sweetness is only for conjunctions and disjunctions.  Maybe we
+;; should sweeten quantified formulas as well, so we could write things
+;; like (all x y z (f)), (all x y exists z u all v (f)).
+;;
+;;  1. Define recognizer sweet-wff,
+;;  2. define functions sweeten and unsweeten,
+;;  3. prove that sweeten gives a sweet-wff,
+;;  4. prove that unsweeten gives a wff,
+;;  5. prove one of the invertibility statements:
+;;     (EQUAL (UNSWEETEN (SWEETEN F)) F)
+;;     (The other one won't hold.)
+;;  6. prove that sweetening a sweet-wff formula doesn't change it,
+;;  7. prove that unsweetening a wff doesn't change it.
+
+(include-book "base")
+
+(set-well-founded-relation e0-ord-<)
+
+;;------------------------------------------------------------
+;; A sweet-wff is like a wff, except that conjunctions and
+;; disjunctions can have any number (including 0 or 1) of arguments.
+;; The last argument of AND cannot be an AND formula.  However,
+;; other arguments of AND can be AND formulas.  When we sweeten
+;; formulas below, only the right branches will be sweetened.
+;; For example, (AND (AND a b) (AND c d)) becomes (AND (AND a b) c d).
+;;
+;; If you want more, you can use function right-assoc first.
+;;
+;; There is a tradeoff here.  I think the cleanest sweetening would
+;; change 'FALSE to '(OR) and 'TRUE to '(AND).  But 'FALSE
+;; is nicer than '(OR), and we have made it nice instead of clean.
+;;
+;; This means that (EQUAL (SWEETEN (UNSWEETEN F)) F) won't be a theorem,
+;; because (SWEETEN (UNSWEETEN '(OR))) will be 'FALSE.
+;;
+;; Even if 'FALSE sweetens to '(OR), there will be a problem with
+;; (EQUAL (SWEETEN (UNSWEETEN F)) F), because some simplification may
+;; occur.  For example, '(OR (A) FALSE) would sweeten to '(A).
+;; I think there is a theorem there if F is simplified in some ways.
+
+(defun swfand (p)  ;; sweet version of wfand
+  (declare (xargs :guard t))
+  (and (consp p) (equal (car p) 'and)))
+
+(defun swfor (p)  ;; sweet version of wfor
+  (declare (xargs :guard t))
+  (and (consp p) (equal (car p) 'or)))
+
+(mutual-recursion
+
+ (defun sweet-wff (f)
+   (declare (xargs :guard t))
+   (cond ((equal f 'true) t)
+	 ((equal f 'false) t)
+	 ((wfatom f) t)
+	 ((wfnot f) (sweet-wff (a1 f)))
+	 ((wfiff f) (and (sweet-wff (a1 f)) (sweet-wff (a2 f))))
+	 ((wfimp f) (and (sweet-wff (a1 f)) (sweet-wff (a2 f))))
+	 ((wfquant f) (sweet-wff (a2 f)))
+	 ((swfand f) (sweet-wff-list-and (cdr f)))
+	 ((swfor f)  (sweet-wff-list-or (cdr f)))
+	 (t nil)))
+
+ (defun sweet-wff-list-and (lst)  ;; last cannot be swfand
+   (declare (xargs :guard t))
+   (cond ((atom lst) (null lst))
+	 ((atom (cdr lst)) (and (null (cdr lst))
+				(not (swfand (car lst)))
+				(sweet-wff (car lst))))
+	 (t (and (sweet-wff (car lst))
+		 (sweet-wff-list-and (cdr lst))))))
+
+ (defun sweet-wff-list-or (lst)  ;; last cannot be swfor
+   (declare (xargs :guard t))
+   (cond ((atom lst) (null lst))
+	 ((atom (cdr lst)) (and (null (cdr lst))
+				(not (swfor (car lst)))
+				(sweet-wff (car lst))))
+	 (t (and (sweet-wff (car lst))
+		 (sweet-wff-list-or (cdr lst))))))
+ )
+
+;;--------------------------------------------------------------------
+;; Unsweeten takes a sweet-wff and returns a wff.
+
+(mutual-recursion
+
+ (defun unsweeten (f)
+   (declare (xargs :guard (sweet-wff f)
+		   :measure (acl2-count f)))
+   (cond ((wfnot f) (list 'not (unsweeten (a1 f))))
+	 ((wfbinary f) (list (car f) (unsweeten (a1 f)) (unsweeten (a2 f))))
+	 ((wfquant f) (list (car f) (a1 f) (unsweeten (a2 f))))
+	 ((swfand f) (unsweeten-and (cdr f)))
+	 ((swfor f)  (unsweeten-or  (cdr f)))
+	 (t f)))
+
+ (defun unsweeten-and (lst)
+   (declare (xargs :guard (sweet-wff-list-and lst)
+		   :measure (acl2-count lst)))
+   (cond ((atom lst) 'true)  ;; empty conjunction is 'true
+	 ((atom (cdr lst)) (unsweeten (car lst)))
+	 (t (list 'and
+		  (unsweeten (car lst))
+		  (unsweeten-and (cdr lst))))))
+
+ (defun unsweeten-or (lst)
+   (declare (xargs :guard (sweet-wff-list-or lst)
+		   :measure (acl2-count lst)))
+   (cond ((atom lst) 'false)  ;; empty disjunction is 'false
+	 ((atom (cdr lst)) (unsweeten (car lst)))
+	 (t (list 'or
+		  (unsweeten (car lst))
+		  (unsweeten-or (cdr lst))))))
+ )
+
+;;---------------------------------------------------------------
+;; This is an induction scheme that corresponds to sweet-wff and unsweeten.
+
+(defun unsweeten-i (flg x)
+  (declare (xargs :guard t))
+  (cond ((equal flg 'and) (cond ((atom x) 'junk)
+				((atom (cdr x)) (unsweeten-i 'wff (car x)))
+				(t (cons (unsweeten-i 'wff (car x))
+					 (unsweeten-i 'and (cdr x))))))
+	((equal flg 'or)  (cond ((atom x) 'junk)
+				((atom (cdr x)) (unsweeten-i 'wff (car x)))
+				(t (cons (unsweeten-i 'wff (car x))
+					 (unsweeten-i 'or (cdr x))))))
+	(t (cond ((wfnot x) (unsweeten-i t (a1 x)))
+		 ((wfbinary x) (cons (unsweeten-i t (a1 x))
+				     (unsweeten-i t (a2 x))))
+		 ((wfquant x) (unsweeten-i t (a2 x)))
+		 ((swfand x) (unsweeten-i 'and (cdr x)))
+		 ((swfor x)  (unsweeten-i 'or  (cdr x)))
+		 (t nil)))))
+
+;;------------------------------------------------------------------
+;; Prove that unsweetening a sweet-wff gives a wff.
+
+(defthm unsweeten-wff-flg
+  (cond ((equal flg 'and) (implies (sweet-wff-list-and x)
+				   (wff (unsweeten-and x))))
+	((equal flg 'or)  (implies (sweet-wff-list-or x)
+				   (wff (unsweeten-or x))))
+	(t (implies (sweet-wff x)
+		    (wff (unsweeten x)))))
+  :hints (("Goal"
+	   :induct (unsweeten-i flg x)))
+  :rule-classes nil)
+
+(defthm unsweeten-wff
+  (implies (sweet-wff x)
+	   (wff (unsweeten x)))
+  :hints (("Goal"
+	   :by (:instance unsweeten-wff-flg (flg 'junk)))))
+
+;;---------------------------------------------------------------
+;; Now, we sweeten formulas.  As far as I can see now, this will
+;; only be used for printing formulas.  (The measure is complicated,
+;; because sometimes the argument doesn't get smaller.)
+;;
+;; Note that only right associated conjunctions and disjunctions
+;; are sweetened.  If you want more, you can use function
+;; right-assoc first.
+
+(mutual-recursion
+
+ (defun sweeten (f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f)) 0)))
+   (cond ;; ((equal f 'true)  (list 'and))
+	 ;; ((equal f 'false) (list 'or))
+         ((wfnot f) (list 'not (sweeten (a1 f))))
+	 ((wfquant f) (list (car f) (a1 f) (sweeten (a2 f))))
+	 ((wfand f) (list* 'and (sweeten (a1 f)) (sweeten-and (a2 f))))
+	 ((wfor f) (list* 'or (sweeten (a1 f)) (sweeten-or (a2 f))))
+	 ((wfbinary f) (list (car f) (sweeten (a1 f)) (sweeten (a2 f))))
+	 (t f)))
+
+ (defun sweeten-and (f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f)) 1)))
+   (cond ;; ((equal f 'true) nil)
+         ((not (wfand f)) (list (sweeten f)))
+	 (t (cons (sweeten (a1 f)) (sweeten-and (a2 f))))))
+
+ (defun sweeten-or (f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f)) 1)))
+   (cond ;; ((equal f 'false) nil)
+         ((not (wfor f)) (list (sweeten f)))
+	 (t (cons (sweeten (a1 f)) (sweeten-or (a2 f))))))
+ )
+
+;;------------------------------------------------------------
+;; Now prove that sweeten gives a sweet formula.
+;;
+;; First, another induction scheme, corresponding to
+;; sweeten/sweeten-and/sweeten-or.
+
+(defun sweeten-i (flg f)
+   (declare (xargs :guard (wff f)
+		   :measure (cons (1+ (acl2-count f))
+				  (if (or (equal flg 'and)
+					  (equal flg 'or)) 1 0))))
+   (cond ((equal flg 'and) (cond ;; ((equal f 'true) 'junk)
+				 ((not (wfand f)) (sweeten-i 'wff f))
+				 (t (cons (sweeten-i 'wff (a1 f))
+					  (sweeten-i 'and (a2 f))))))
+	 ((equal flg 'or)  (cond ;; ((equal f 'false) 'junk)
+				 ((not (wfor f)) (sweeten-i 'wff f))
+				 (t (cons (sweeten-i 'wff (a1 f))
+					  (sweeten-i 'or (a2 f))))))
+	 (t (cond ((wfnot f) (sweeten-i 'wff (a1 f)))
+		  ((wfquant f) (sweeten-i 'wff (a2 f)))
+		  ((wfand f) (cons (sweeten-i 'wff (a1 f))
+				   (sweeten-i 'and (a2 f))))
+		  ((wfor f)  (cons (sweeten-i 'wff (a1 f))
+				   (sweeten-i 'or (a2 f))))
+		  ((wfbinary f) (cons (sweeten-i 'wff (a1 f))
+				      (sweeten-i 'wff (a2 f))))
+		  (t 'junk)))))
+
+;;----------------------------------------------------------------------
+;; Prove that sweetening a wff gives a sweet-wff.
+
+(defthm sweeten-car-flg
+  (equal (car (sweeten f)) (car f))
+  :hints (("Goal"
+	   :induct (sweeten-i flg f))))
+
+(defthm sweeten-wff-flg
+  (cond ((equal flg 'and) (implies (wff x)
+				   (sweet-wff-list-and (sweeten-and x))))
+	((equal flg 'or)  (implies (wff x)
+				   (sweet-wff-list-or (sweeten-or x))))
+	(t (implies (wff x)
+		    (sweet-wff (sweeten x)))))
+  :hints (("Goal"
+	   :induct (sweeten-i flg x)))
+  :rule-classes nil)
+
+(defthm sweeten-wff
+  (implies (wff x)
+	   (sweet-wff (sweeten x)))
+  :hints (("Goal"
+	   :by (:instance sweeten-wff-flg (flg 'junk)))))
+
+;;----------------------------------------------------------
+;; An invertibility theorem.
+
+(defthm unsweeten-sweeten-flg
+  (implies (wff f)
+	   (cond ((equal flg 'and) (equal (unsweeten-and (sweeten-and f)) f))
+		 ((equal flg 'or)  (equal (unsweeten-or (sweeten-or f)) f))
+		 (t (equal (unsweeten (sweeten f)) f))))
+  :hints (("Goal"
+	   :induct (sweeten-i flg f)))
+  :rule-classes nil)
+
+(defthm unsweeten-sweeten
+  (implies (wff f)
+	   (equal (unsweeten (sweeten f)) f))
+  :hints (("Goal"
+           :by (:instance unsweeten-sweeten-flg (flg 'junk)))))
+
+;;----------------------------------------------------------
+;; The other invertibility statement
+;;
+;; (defthm sweeten-unsweeten
+;;   (implies (sweet-wff f)
+;;            (equal (sweeten (unsweeten f)) f)))
+;;
+;; is not a theorem.  See comments at the beginning.
+
+;;---------------------------------------------------------------
+;; What happens if we unsweeten an ordinary wff?
+
+(defthm unsweeten-ordinary-wff
+  (implies (wff f)
+	   (equal (unsweeten f) f)))
+
+;; What if we sweeten a sweet formula?
+
+(defthm sweeten-sweet-wff-flg
+  (cond ((equal flg 'and) (implies (and (sweet-wff x)
+					(not (wfand x)))
+				   (equal (sweeten-and x) (list x))))
+	((equal flg 'or)  (implies (and (sweet-wff x)
+					(not (wfor x)))
+				   (equal (sweeten-or x) (list x))))
+	(t (implies (sweet-wff x)
+		    (equal (sweeten x) x))))
+  :hints (("Goal"
+	   :induct (sweeten-i flg x)))
+  :rule-classes nil)
+
+(defthm sweeten-sweet-wff
+  (implies (sweet-wff x)
+	   (equal (sweeten x) x))
+  :hints (("Goal"
+	   :by (:instance sweeten-sweet-wff-flg (flg 'junk)))))
+
+;; The following idempotence theorems are now trivial consequences.
+
+(defthm sweeten-idempotent
+  (implies (wff f)
+	   (equal (sweeten (sweeten f))
+		  (sweeten f))))
+
+(defthm unsweeten-idempotent
+  (implies (sweet-wff f)
+	   (equal (unsweeten (unsweeten f))
+		  (unsweeten f))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/README b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/README
new file mode 100644
index 0000000..70a00f9
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/README
@@ -0,0 +1,9 @@
+To test Ivy, run (while in this directory)
+
+  ./test-all  ../util/ivy
+
+This should run 10 tests, 5 that succeed, and 5 that fail.
+
+Note that you have to have write permission in the
+directory that contains the input files (this directory),
+because Ivy creates intermediate files there.
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p
new file mode 100644
index 0000000..5644e61
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p
@@ -0,0 +1 @@
+(p)
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p-and-not-p b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p-and-not-p
new file mode 100644
index 0000000..9d25ea8
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p-and-not-p
@@ -0,0 +1 @@
+(and (p) (not (p)))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p-implies-p b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p-implies-p
new file mode 100644
index 0000000..e98720e
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/p-implies-p
@@ -0,0 +1 @@
+(imp (p) (p))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/sound-proof b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/sound-proof
new file mode 100644
index 0000000..b4bf5f9
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/sound-proof
@@ -0,0 +1,9 @@
+;; BEGINNING OF PROOF OBJECT
+(
+(1 (input) (P) NIL)
+(2 (input) (not (P)) NIL)
+(3 (instantiate 2 ()) (not (P)) (1))
+(4 (instantiate 1 ()) (P) (2))
+(5 (resolve 3 () 4 ()) false (3))
+)
+;; END OF PROOF OBJECT
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/test-all b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/test-all
new file mode 100755
index 0000000..306a389
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/test-all
@@ -0,0 +1,27 @@
+#!/bin/csh
+
+if ($#argv != 1) then
+    echo "Need 1 arg: ivy or sivy script"
+    exit(1)
+endif
+
+echo ""
+echo "These 5 should succeed:"
+echo ""
+
+$1 prove    p-implies-p      |& egrep "has been|failed"
+$1 refute   p-and-not-p      |& egrep "has been|failed"
+$1 disprove p                |& egrep "has been|failed"
+$1 model    p                |& egrep "has been|failed"
+../util/checker sound-proof  |& egrep "have been|failed"
+
+echo ""
+echo "These 5 should fail:"
+echo ""
+
+$1 prove    p                  |& egrep "has been|failed"
+$1 refute   p                  |& egrep "has been|failed"
+$1 disprove p-implies-p        |& egrep "has been|failed"
+$1 model    p-and-not-p        |& egrep "has been|failed"
+../util/checker unsound-proof  |& egrep "have been|failed"
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/unsound-proof b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/unsound-proof
new file mode 100644
index 0000000..fb48e31
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/test/unsound-proof
@@ -0,0 +1,9 @@
+;; BEGINNING OF PROOF OBJECT
+(
+(1 (input) (P) NIL)
+(2 (input) (not (Q)) NIL)
+(3 (instantiate 2 ()) (not (P)) (1))
+(4 (instantiate 1 ()) (P) (2))
+(5 (resolve 3 () 4 ()) false (3))
+)
+;; END OF PROOF OBJECT
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/top.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/top.lisp
new file mode 100644
index 0000000..6e2e38d
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/top.lisp
@@ -0,0 +1,6 @@
+(in-package "ACL2")
+
+;; Bring together the two major components of Ivy.
+
+(include-book "prover")
+(include-book "modeler")
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.lisp
new file mode 100644
index 0000000..91ca604
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/uc-conj.lisp
@@ -0,0 +1,102 @@
+(in-package "ACL2")
+
+;; The main lemma of this book is that
+;;      (universal-closure (list 'and a b))
+;; is equivalent to
+;;      (list 'and (universal-closure a) (universal-closure b))
+;;
+;; Also, we define a function that separately closes the
+;; parts of a conjunction.
+
+(include-book "stage")
+
+(local (include-book "close"))
+
+;;----------------------------
+
+(local (defthm alls-vars-and-1
+  (implies (and (wfand h)
+                (var-set vars))
+	   (equal (xeval (alls vars h) dom i)
+		  (and (xeval (alls vars (a1 h)) dom i)
+		       (xeval (alls vars (a2 h)) dom i))))
+  :hints (("Goal"
+           :induct (var-induct vars h dom i))
+	  ("Subgoal *1/3"
+           :expand ((alls vars h))))
+  :rule-classes nil))
+
+(local (defthm alls-vars-and-2
+  (implies (var-set vars)
+	   (equal (xeval (alls vars (list 'and f g)) dom i)
+		  (and (xeval (alls vars f) dom i)
+		       (xeval (alls vars g) dom i))))
+  :hints (("Goal"
+           :do-not-induct t
+	   :use ((:instance alls-vars-and-1 (h (list 'and f g))))))))
+
+(defthm uc-conj
+  (equal (xeval (universal-closure (list 'and f g)) (domain i) i)
+	 (and (xeval (universal-closure f) (domain i) i)
+	      (xeval (universal-closure g) (domain i) i)))
+  :hints (("Goal"
+	   :do-not-induct t
+           :use ((:instance xeval-alls-subset
+                            (f f)
+                            (a (free-vars f))
+                            (b (union-equal (free-vars f) (free-vars g))))
+		 (:instance xeval-alls-subset
+                            (f g)
+                            (a (free-vars g))
+                            (b (union-equal (free-vars f) (free-vars g))))
+		 (:instance xeval-alls-subset
+                            (f (list 'and f g))
+                            (a (union-equal (free-vars f) (free-vars g)))
+                            (b (union-equal (free-vars f) (free-vars g))))
+		 ))
+	  ))
+
+;;----------------------------------------------------------------------
+
+(defthm uc-conj-left
+  (implies (xeval (universal-closure (list 'and f g)) (domain i) i)
+	   (xeval (universal-closure f) (domain i) i))
+  :rule-classes nil)
+
+(defthm uc-conj-right
+  (implies (xeval (universal-closure (list 'and f g)) (domain i) i)
+	   (xeval (universal-closure g) (domain i) i))
+  :rule-classes nil)
+
+;;----------------------------------------------------------------------
+;; Here is a version of universal closure that separately closes
+;; the parts of a conjunction.
+
+(defun univ-closure-conj (f)
+  (declare (xargs :guard (wff f)))
+  (if (wfand f)
+      (list 'and
+	    (univ-closure-conj (a1 f))
+	    (univ-closure-conj (a2 f)))
+    (universal-closure f)))
+
+(defthm univ-clossure-conj-ok-x
+  (equal (xeval (univ-closure-conj f) (domain i) i)
+	 (xeval (universal-closure f) (domain i) i))
+  :hints (("Goal"
+	   :induct (univ-closure-conj f))
+	  ("Subgoal *1/1"
+	   :use ((:instance uc-conj (f (a1 f)) (g (a2 f)))))))
+
+(defthm univ-closure-conj-ok
+  (equal (feval (univ-closure-conj f) i)
+	 (feval (universal-closure f) i))
+  :hints (("Goal"
+         :in-theory (enable xeval-feval))))
+
+(defthm univ-closure-conj-closed
+  (not (free-vars (univ-closure-conj f)))
+  :hints (("Subgoal *1/2"
+           :in-theory (disable free-vars))))
+
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/cert b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/cert
new file mode 100755
index 0000000..0a89f41
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/cert
@@ -0,0 +1,26 @@
+#!/bin/tcsh
+
+if ($#argv != 1) then
+	echo "need 1 arg: file name (with .lisp extension)"
+	exit(1)
+endif
+
+set time=10000
+
+set book=$1:r
+
+echo "Output will go to $book.out."
+
+echo "("certify-book \"$book\"")" | acl2 > $book.out
+
+grep "Write the certificate" $book.out > /dev/null
+
+set success=$status
+
+if ($success == 0) then
+   echo "$book has been certified!"
+else
+   echo "certify $book FAILED!"
+endif
+
+exit $success
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/checker.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/checker.lsp
new file mode 100644
index 0000000..77b40a4
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/checker.lsp
@@ -0,0 +1,46 @@
+;; This (common lisp) code is used when checking stand-alone proof objects,
+;; that is, proof objects found independently from Ivy.
+
+(defun read-rest-of-file (fp)
+  (progn (setq x (read fp nil 'end-of-file))
+	 (if (eq x 'end-of-file)
+	     nil
+	   (cons x (read-rest-of-file fp)))))
+
+(defun my-read-file (filename)
+  (with-open-file (fp filename)
+		  (read-rest-of-file fp)))
+
+(defun check-each-proof-object (prfs)
+  (cond ((atom prfs) nil)
+	(t (cons (bcheck (car prfs))
+		 (check-each-proof-object (cdr prfs))))))
+
+(defun lengths (prfs)
+  (cond ((atom prfs) nil)
+	(t (cons (length (car prfs))
+		 (lengths (cdr prfs))))))
+
+(defun checker (filename)
+
+  (progn
+
+    (format t "~%~%We are checking the proof objects in ~a.~%" filename)
+
+    (setq proof-objects (my-read-file filename))
+
+    (setq lengths (lengths proof-objects))
+
+    (setq results (check-each-proof-object proof-objects))
+
+    (format t "~%There are ~a proof objects.~%" (length proof-objects))
+    
+    (format t "~%The lengths of the proof objects are ~a.~%" lengths)
+
+    (format t "~%The result of the check is ~a.~%" results)
+
+    (if (member nil results)
+	(format t "~%At least one check failed.~%" results)
+      (format t "~%All proofs have been checked and are correct!~%" results))
+
+    results))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/ivy.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/ivy.lsp
new file mode 100644
index 0000000..43b9586
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/ivy.lsp
@@ -0,0 +1,75 @@
+;;---------------------------------------------
+;; ivy
+;;
+;;  1. Read a formula (wff or sweet-wff) from a file,
+;;  2. unsweeten it if necessary,
+;;  3. if it is not closed, use the universal closure,
+;;  4. perform an operation (prove, refute, disprove, or model),
+;;  5. print a message about the result,
+;;  6. for otter operations (prove, refute), return t (success) or nil,
+;;     for MACE operations (disprove, model), return a model (success) or nil.
+;;
+;; Messages are output along the way, and no global variables are used.
+
+(defun ivy (operation filename)
+
+  (progn
+
+    (format t "~%~%We are trying to ~a ~a.~%" operation filename)
+
+    (with-open-file (fp filename) (setq in-form (read fp)))
+
+    (format t "~%The input formula:~%")
+    (print in-form)
+
+    (cond ((wff in-form) (setq wff in-form))
+	  ((wff (unsweeten in-form))
+	   (progn (setq wff (unsweeten in-form))
+		  (format t "~%~%Unsweetened formula:~%")
+		  (print wff)))
+	  (t (error "The formula is not a well formed.")))
+    
+    (if (free-vars wff)
+	(progn (format t "~%~%Formula has free variables:~%")
+	       (print (free-vars wff))
+	       (setq closed-wff (univ-closure-conj wff))
+	       (format t "~%~%Using univ-closure-conj:~%")
+	       (print closed-wff)
+	       )
+      (setq closed-wff wff))
+
+    (finish-output)
+
+    (ecase  ;; causes error if nothing is matched
+
+     operation
+
+     ('prove (setq success (proved closed-wff))
+	     (if success
+		 (format t "The conjecture has been proved!")
+	       (format t "The proof attempt failed.")))
+
+     ('refute (setq success (refuted closed-wff))
+	      (if success
+		  (format t "The formula has been refuted!")
+		(format t "The refutation attempt failed.")))
+
+     ('disprove (setq success (countermodel-attempt closed-wff))
+		(if success
+		    (format t "The formula has been disproved!")
+		  (format t "The countermodel attempt failed.")))
+
+     ('model (setq success (model-attempt closed-wff))
+	     (if success
+		 (format t "The formula has been modeled!")
+	       (format t "The model attempt failed.")))
+     )
+
+    ;; Success is  nil       for failure,
+    ;;             t         for successful prove or refute operation,
+    ;;             a model   for successful disprove or model operation.
+
+    success
+
+    )
+  )
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/otter-mace.lsp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/otter-mace.lsp
new file mode 100644
index 0000000..2fe5855
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/util/otter-mace.lsp
@@ -0,0 +1,145 @@
+;; This file is ordinary (non-ACL2) LISP code for the interface between
+;; the ACL2 code and the external theorem provers.
+;;
+;; Since this is loaded after the IVY books, we must make sure that
+;; none of these functions overrides any of the IVY functions (except
+;; external-prover and external-modeler below, which are supposed
+;; to override the IVY defstubs).
+;;
+;;------------------------------------------------------
+
+;; Global variables.
+
+(defvar problem-name nil)  ;; a string used for temporary filenames
+(defvar otter-binary nil)  ;; Otter binary
+(defvar mace-binary nil)   ;; MACE binary
+(defvar mace-parms "6 60 -m1 -I -c")
+
+;; The default MACE parameters:
+;; domainsize<=6, 60 sec, 1 model, IVY format, unique constants.
+
+;;------------------------------------------------------
+
+(defun cat-2-strings (s1 s2)
+  (coerce (append (coerce s1 'list) (coerce s2 'list)) 'string))
+
+(defun cat-strings (lst)
+  (if (atom lst)
+      ""
+      (cat-2-strings (car lst) (cat-strings (cdr lst)))))
+
+;;------------------------------------------------
+;; Function external-prover takes an initial proof object which
+;; represents a set of input clauses for a theorem prover.
+;;
+;; external-prover is a defstub in the ACL2 code, and this function takes its place.
+;;
+;; This uses global variables problem-name and otter-binary.
+
+(defun external-prover (initial-proof-object)
+
+  (progn
+
+    ;; Problem-name is a global variable, used here for temporary filenames.
+    ;; If problem-name is nil, use "otter" instead.
+
+    (setq pname (or problem-name "otter"))
+    (setq otter-in-filename (cat-strings (list pname ".in")))
+    (setq otter-obj-filename (cat-strings (list pname ".proof-obj")))
+
+    ;; Build an Otter input file.
+
+    (with-open-file (fp otter-in-filename :direction :output)
+		    (format fp "set(auto).~%")
+		    (format fp "set(build_proof_object_2).~%")
+		    (format fp "clear(sigint_interact).~%")
+		    (format fp "assign(max_seconds, 10).~%")
+		    (format fp "initial_proof_object(junk).~%")
+		    (format fp "~%")
+		    (print initial-proof-object fp)
+		    (format fp "~%")
+		    )
+
+    ;; Run Otter and look for a proof object in the output.
+
+    (setq unix-command
+	  (cat-strings
+	   (list
+	    otter-binary
+	    " < "
+	    otter-in-filename
+	    " | awk '/BEGINNING OF PROOF OBJECT/,/END OF PROOF OBJECT/' > "
+	    otter-obj-filename)))
+
+    (format t "~%~%The initial proof object:~%")
+    (print initial-proof-object)
+    (format t "~%~%Starting Otter search ...~%")
+    (finish-output)
+    
+    (LISP::system unix-command)
+
+    ;; We're supposed to return a proof object.  If Otter didn't produce
+    ;; one, we can return either NIL (the empty proof object), or the
+    ;; initial proof object.  At this point in the project, it doesn't
+    ;; matter which.
+
+    (with-open-file (fp otter-obj-filename)
+		    (if (equal (file-length fp) 0)
+			nil
+		      (read fp)))))
+
+;;------------------------------------------------
+;; Function external-modeler takes an initial proof object which
+;; represents a set of input clauses.
+;;
+;; external-modeler is a defstub in the ACL2 code, and this
+;; function takes its place.
+;;
+;; This uses global variables problem-name, mace-binary, and mace-parms.
+
+(defun external-modeler (initial-proof-object)
+
+  (progn
+
+    ;; Problem-name is a global variable, used here for temporary filenames.
+    ;; If problem-name is nil, use "mace" instead.
+
+    (setq pname (or problem-name "mace"))
+    (setq mace-in-filename (cat-strings (list pname ".in")))
+    (setq mace-model-filename (cat-strings (list pname ".model")))
+
+    ;; Build a MACE input file.
+
+    (with-open-file (fp mace-in-filename :direction :output)
+		    (format fp "set(build_proof_object_2).~%")
+		    (format fp "clear(sigint_interact).~%")
+		    (format fp "initial_proof_object(junk).~%")
+		    (format fp "~%")
+		    (print initial-proof-object fp)
+		    (format fp "~%")
+		    )
+
+    ;; Run MACE and look for a model in the output.
+
+    (setq system-command
+	  (cat-strings
+	   (list
+	    mace-binary
+	    " "
+	    mace-in-filename
+	    " "
+	    mace-parms
+	    " | awk '/BEGINNING OF IVY MODEL/,/END OF IVY MODEL/' > "
+	    mace-model-filename)))
+
+    (format t "~%~%The input clauses:~%")
+    (print initial-proof-object)
+    (format t "~%~%Starting MACE search ...~%~%")
+    (finish-output)
+    
+    (LISP::system system-command)
+
+    (with-open-file (fp mace-model-filename)
+		    (if (equal (file-length fp) 0)
+			nil
+		      (read fp)))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/variables.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/variables.lisp
new file mode 100644
index 0000000..b8d2e1c
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/variables.lisp
@@ -0,0 +1,454 @@
+(in-package "ACL2")
+
+;; This book contain definitions and theorems about bound variables,
+;; free variables, and substituting terms for variables.
+
+(include-book "base")
+
+(defthm domain-term-is-not-cons
+  (not (domain-term (cons x y)))
+  :hints (("Goal"
+           :in-theory (enable domain-term))))
+
+(defthm variable-term-is-not-domain-term
+  (implies (variable-term x)
+	   (not (domain-term x)))
+  :hints (("Goal"
+	   :in-theory (enable domain-term))))
+
+(defun var-list (l)
+  (declare (xargs :guard t))
+  (cond ((atom l) (null l))
+	(t (and (variable-term (car l))
+		(var-list (cdr l))))))
+
+(defthm var-list-union
+  (implies (and (var-list a)
+		(var-list b))
+	   (var-list (union-equal a b))))
+
+(defmacro var-set (vars)
+  (list 'and (list 'var-list vars) (list 'setp vars)))
+
+;;------------------------------------------------
+;;  Extract the set of variables from a term.
+
+(defun vars-in-term-list (l)
+  (declare (xargs :guard (wft-list l)
+		  :verify-guards nil))
+  (if (atom l)
+      nil
+      (union-equal (cond ((variable-term (car l)) (list (car l)))
+			 ((domain-term (car l)) nil)
+			 ((wf-ap-term-top (car l))
+			  (vars-in-term-list (cdar l)))
+			 (t nil))  ;; non-term
+		   (vars-in-term-list (cdr l)))))
+
+(defmacro vars-in-term (tm)
+  (list 'vars-in-term-list (list 'list tm)))
+
+(defthm vars-in-term-list-true-listp
+  (true-listp (vars-in-term-list l)))
+
+(verify-guards vars-in-term-list)
+
+(defthm vars-in-term-list-returns-var-list
+  (var-list (vars-in-term-list l)))
+
+(defthm setp-vars-in-term-list
+  (setp (vars-in-term-list l)))
+
+;; ------------------------------------------------------------
+;; Function free-vars returns the set of free variables in a formula.
+
+(defun free-vars (f)
+  (declare (xargs :guard (wff f)
+		  :verify-guards nil))
+  (cond ((wfnot f) (free-vars (a1 f)))
+	((wfbinary f) (union-equal (free-vars (a1 f))
+				   (free-vars (a2 f))))
+	((wfquant f) (remove-equal (a1 f) (free-vars (a2 f))))
+	((wfatomtop f) (vars-in-term-list (cdr f)))
+	(t nil)))
+
+(defthm free-vars-true-listp
+  (true-listp (free-vars f)))
+
+(verify-guards free-vars)
+
+(defthm free-vars-returns-var-list
+  (var-list (free-vars f)))
+
+(defthm setp-free-vars
+  (setp (free-vars f)))
+
+;;=================
+;; When I changed the definition of remove-equal so that it doesn't
+;; always return a true-listp, the type of free-vars was no longer
+;; deduced during definition.  The next two events seem to fix things.
+
+(defthm true-listp-is-either-consp-or-nil
+  (implies (true-listp a)
+	   (or (consp a)
+	       (equal a nil)))
+  :rule-classes nil)
+
+(defthm free-vars-type
+  (or (consp (free-vars f))
+      (equal (free-vars f) nil))
+  :hints (("Goal"
+	   :use ((:instance true-listp-is-either-consp-or-nil
+			    (a (free-vars f))))))
+  :rule-classes :type-prescription)
+
+;;=================
+
+(defun var-occurrence-term-list (x l)
+  (declare (xargs :guard (and (variable-term x)
+			      (wft-list l))))
+  (if (atom l)
+      nil
+    (or (cond ((variable-term (car l)) (equal (car l) x))
+	      ((domain-term (car l)) nil)
+	      ((wf-ap-term-top (car l)) (var-occurrence-term-list x (cdar l)))
+	      (t nil))  ;; non-term
+	(var-occurrence-term-list x (cdr l)))))
+
+(defmacro var-occurrence (x tm)
+  (list 'var-occurrence-term-list x (list 'list tm)))
+
+;; Function free-occurrence (x f) checks if formula f contains
+;; x as a free variable.
+
+(defun free-occurrence (x f)
+  (declare (xargs :guard (and (variable-term x) (wff f))))
+  (cond ((wfnot f) (free-occurrence x (a1 f)))
+	((wfbinary f) (or (free-occurrence x (a1 f))
+			  (free-occurrence x (a2 f))))
+	((wfquant f) (if (equal x (a1 f))
+			 nil
+		         (free-occurrence x (a2 f))))
+	((wfatomtop f) (var-occurrence-term-list x (cdr f)))
+	(t nil)))
+
+(defun bound-occurrence (x f)
+  (declare (xargs :guard (and (variable-term x) (wff f))))
+  (cond ((wfnot f) (bound-occurrence x (a1 f)))
+	((wfbinary f) (or (bound-occurrence x (a1 f))
+			  (bound-occurrence x (a2 f))))
+	((wfquant f) (if (equal (a1 f) x)
+			 t
+		         (bound-occurrence x (a2 f))))
+	(t nil)))
+
+(defthm free-occurrence-remove-free-vars
+  (implies (not (free-occurrence x f))
+	   (equal (remove-equal x (free-vars f))
+		  (free-vars f)))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm true-listp-append-rewrite  ; move to sets?
+  (implies (and (true-listp a)
+		(true-listp b))
+	   (true-listp (append a b))))
+
+(defun quantified-vars (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfnot f) (quantified-vars (a1 f)))
+        ((wfbinary f) (append (quantified-vars (a1 f))
+                              (quantified-vars (a2 f))))
+        ((wfquant f) (cons (a1 f) (quantified-vars (a2 f))))
+        (t nil)))
+
+(defthm true-listp-quantified-vars
+  (true-listp (quantified-vars f)))
+
+(defthm var-list-quantified-vars
+  (var-list (quantified-vars f)))
+
+(defun quantifier-free (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfnot f) (quantifier-free (a1 f)))
+        ((wfbinary f) (and (quantifier-free (a1 f))
+                           (quantifier-free (a2 f))))
+        ((wfquant f) nil)
+        (t t)))
+
+(defthm quant-free-subst
+  (implies (quantifier-free f)
+	   (quantifier-free (subst-free f x tm))))
+
+;;----------- general theorems about bound, free, subst.
+
+(defthm free-free
+  (iff (member-equal x (free-vars f))
+       (free-occurrence x f))
+  :rule-classes nil)
+
+(defthm free-is-free
+  (implies (member-equal x (free-vars f))
+	   (free-occurrence x f))
+  :hints (("Goal"
+	   :use ((:instance free-free)))))
+
+(defthm not-free-is-not-free
+  (implies (not (member-equal x (free-vars f)))
+	   (not (free-occurrence x f)))
+  :hints (("Goal"
+	   :use ((:instance free-free)))))
+
+(in-theory (disable free-is-free not-free-is-not-free))
+
+(defthm quantified-iff-bound
+  (iff (member-equal x (quantified-vars f))
+       (bound-occurrence x f))
+  :rule-classes nil)
+
+(defthm quantified-is-bound
+  (implies (member-equal x (quantified-vars f))
+	   (bound-occurrence x f))
+  :hints (("Goal"
+	   :use ((:instance quantified-iff-bound)))))
+
+(defthm not-quantified-is-not-bound
+  (implies (not (member-equal x (quantified-vars f)))
+	   (not (bound-occurrence x f)))
+  :hints (("Goal"
+	   :use ((:instance quantified-iff-bound)))))
+
+(in-theory (disable quantified-is-bound not-quantified-is-not-bound))
+
+;;---------------------
+
+(defthm not-integerp-subst-term-list
+  (implies (wft-list l)
+	   (not (integerp (subst-term-list l x tm)))))
+
+(defthm not-integerp-subst-term-list-2
+  (implies (not (integerp l))
+	   (not (integerp (subst-term-list l x tm)))))
+
+(defthm not-wft-list-subst-term-list
+  (implies (not (wft-list l))
+	   (not (wft-list (subst-term-list l x e))))
+  :hints (("Goal"
+	   :do-not generalize)))
+
+(defthm not-var-occurrence-subst
+  (implies (and (not (var-occurrence-term-list y l))
+                (domain-term e))
+           (not (var-occurrence-term-list y (subst-term-list l x e)))))
+
+(defthm not-free-subst
+  (implies (and (not (free-occurrence y f))
+                (domain-term e))
+           (not (free-occurrence y (subst-free f x e)))))
+
+(defthm var-occurrence-subst
+  (implies (and (var-occurrence-term-list y l)
+                (not (equal x y)))
+           (var-occurrence-term-list y (subst-term-list l x tm))))
+
+(defthm free-subst
+  (implies (and (free-occurrence y f)
+		(not (equal x y)))
+           (free-occurrence y (subst-free f x tm))))
+
+;;------------------
+
+(defthm not-var-occurrence-not-change-term-list
+  (implies (not (var-occurrence-term-list x l))
+	   (equal (subst-term-list l x y) l)))
+
+(defthm not-free-not-change
+  (implies (not (free-occurrence x f))
+	   (equal (subst-free f x tm) f)))
+
+(defthm not-free-not-change-2
+  (implies (not (member-equal x (free-vars f)))
+           (equal (subst-free f x tm) f))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :in-theory (enable not-free-is-not-free))))
+
+;; The preceding three cause rewrite explosions, so disable them.
+
+(in-theory (disable not-var-occurrence-not-change-term-list
+		    not-free-not-change
+		    not-free-not-change-2))
+
+;;-------------------------
+
+(defthm not-bound-occurrence-subst
+  (implies (not (bound-occurrence x f))
+	   (not (bound-occurrence x (subst-free f y tm)))))
+
+(defthm unique-vars-bound-not-bound
+  (implies (and (setp (quantified-vars f))
+		(wfquant f))
+	   (not (bound-occurrence (a1 f) (a2 f))))
+  :hints (("Goal"
+           :in-theory (enable not-quantified-is-not-bound))))
+
+(defthm subst-free-preserves-quantifiers
+  (equal (quantified-vars (subst-free f x tm))
+	 (quantified-vars f)))
+
+;;----------------------
+
+(defthm subst-subst-term-list
+  (implies (and (variable-term x)
+		(variable-term y)
+		(not (var-occurrence-term-list y l)))
+	   (equal (subst-term-list (subst-term-list l x y) y tm)
+		  (subst-term-list l x tm))))
+
+(defthm subst-subst-free
+  (implies (and (variable-term x)
+		(variable-term y)
+	        (not (bound-occurrence y f))
+		(not (free-occurrence y f)))
+	   (equal (subst-free (subst-free f x y) y tm)
+		  (subst-free f x tm)))
+  :hints (("Goal"
+	   :in-theory (enable not-free-not-change))))
+
+(defthm subst-free-preserves-bound-vars
+  (equal (bound-occurrence x (subst-free f y e))
+	 (bound-occurrence x f)))
+
+(defthm subst-term-list-eliminates-var
+  (implies (not (var-occurrence-term-list x (list y)))
+	   (not (var-occurrence-term-list x (subst-term-list l x y)))))
+
+(defthm another-subst-does-nothing
+  (implies (not (var-occurrence-term-list x (list tm)))
+	   (equal (subst-free (subst-free f x tm) x d)
+		  (subst-free f x tm)))
+  :hints (("Goal"
+           :in-theory (enable not-var-occurrence-not-change-term-list))))
+
+(defthm subst-term-list-ident
+  (equal (subst-term-list l x x) l))
+
+(defthm subst-term-list-different
+  (implies (and (not (equal x y))
+		(not (var-occurrence-term-list y (list a)))
+		(not (var-occurrence-term-list x (list b))))
+	   (equal (subst-term-list (subst-term-list l x a) y b)
+		  (subst-term-list (subst-term-list l y b) x a)))
+  :hints (("Goal"
+	   :in-theory (enable not-var-occurrence-not-change-term-list))))
+
+(defthm subst-different
+  (implies (and (not (equal x y))
+		(not (var-occurrence-term-list y (list a)))
+		(not (var-occurrence-term-list x (list b))))
+	   (equal (subst-free (subst-free f x a) y b)
+		  (subst-free (subst-free f y b) x a))))
+
+(defthm x-not-in-e
+  (implies (domain-term e)
+	   (not (var-occurrence-term-list x (list e)))))
+
+(defthm x-not-in-y
+  (implies (and (variable-term y)
+		(not (equal x y)))
+	   (not (var-occurrence-term-list x (list y)))))
+
+(defthm subst-different-special-case
+  (implies (and (not (equal x y))
+		(variable-term a)
+		(not (equal a y))
+		(domain-term e))
+	   (equal (subst-free (subst-free f x a) y e)
+		  (subst-free (subst-free f y e) x a))))
+
+(defthm not-var-subst-term-list
+  (implies (and (not (var-occurrence-term-list y l))
+		(not (var-occurrence-term-list y (list d))))
+	   (not (var-occurrence-term-list y (subst-term-list l x d)))))
+
+;;-----------------------
+
+(defthm subst-free-doesnt-introduce-vars
+  (implies (and (domain-term e)
+		(not (member-equal y (free-vars f))))
+	   (not (member-equal y (free-vars (subst-free f x e)))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance free-is-free (x y) (f (subst-free f x e)))
+		 (:instance not-free-is-not-free (x y))))))
+
+(defthm remove-equal-not-member  ; move to sets?
+  (implies (and (not (remove-equal x a))
+		(not (equal y x)))
+	   (not (member-equal y a)))
+  :rule-classes nil)
+
+(defthm not-member-x-subst-x
+  (implies (domain-term e)
+           (not (member-equal x (free-vars (subst-free f x e))))))
+
+(defthm vars-alls-free-almost
+  (implies (and (domain-term e)
+		(not (remove-equal x (free-vars f))))
+	   (not (member-equal y (free-vars (subst-free f x e)))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance not-member-x-subst-x)
+		 (:instance subst-free-doesnt-introduce-vars)
+		 (:instance remove-equal-not-member (a (free-vars f))))
+	   :in-theory (disable not-member-x-subst-x
+			       subst-free-doesnt-introduce-vars)
+	   :do-not generalize)))
+
+;;---------------------------
+;; This theorem turns out to be very useful.
+
+(defthm vars-alls-free
+  (implies (and (domain-term e)
+		(not (remove-equal x (free-vars f))))
+	   (not (free-vars (subst-free f x e))))
+  :hints (("Goal"
+	   :do-not-induct t
+	   :use ((:instance consp-has-member-equal
+			    (x (free-vars (subst-free f x e))))))))
+
+;;--------------------------
+
+(defthm member-vars-subst-term-list
+  (implies (and (not (equal x z))
+		(member-equal x (vars-in-term-list l)))
+	   (member-equal x (vars-in-term-list (subst-term-list l z tm)))))
+
+(defthm not-member-vars-subst-term-list
+  (implies (and (variable-term u)
+		(not (equal x u))
+		(not (member-equal x (vars-in-term-list l))))
+	   (not (member-equal x (vars-in-term-list (subst-term-list l z u))))))
+
+(defthm remove-vars-subst-term-list
+  (implies (and (variable-term u)
+		(not (equal z u))
+		(not (var-occurrence-term-list u l)))
+	   (equal (remove-equal u (vars-in-term-list (subst-term-list l z u)))
+		  (remove-equal z (vars-in-term-list l)))))
+
+;;-------------------------
+
+(defthm subst-term-list-flip-fix
+  (implies (and (not (equal x y))
+		(domain-term e))
+	   (equal
+	    (subst-term-list (subst-term-list l x e) y (subst-term tm x e))
+	    (subst-term-list (subst-term-list l y tm) x e))))
+
+(defthm subst-flip-fix
+  (implies (and (not (equal x y))
+		(domain-term e)
+		(not (member-equal x (quantified-vars f))))
+	   (equal (subst-free (subst-free f x e) y (subst-term tm x e))
+		  (subst-free (subst-free f y tm) x e))))
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.lisp
new file mode 100644
index 0000000..774d5e1
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/wfftype.lisp
@@ -0,0 +1,205 @@
+(in-package "ACL2")
+
+;; This book is about syntactic properties of formulas.
+;; As the formula goes through the preprocessing
+;; steps, it has various properties along the way.
+;; Most of these functions are recognizers for those properties.
+
+(include-book "alls")
+
+(defmacro noncomplex-formula (f)
+  (list 'not (list 'or
+		   (list 'wfnot f)
+		   (list 'wfbinary f)
+		   (list 'wfquant f))))
+
+(defmacro simple-formula (f)
+  (list 'or
+	(list 'equal f ''true)
+	(list 'equal f ''false)
+	(list 'wfatom f)))
+
+;; Function nnfp (f) checks if a formula is in negation normal form.
+
+(defun nnfp (f)
+  (declare (xargs :guard t))
+  (cond ((wfnot f) (noncomplex-formula (a1 f)))
+	((wfbinary f)
+	 (cond ((equal (car f) 'and) (and (nnfp (a1 f)) (nnfp (a2 f))))
+	       ((equal (car f) 'or)  (and (nnfp (a1 f)) (nnfp (a2 f))))
+	       (t nil)))  ; imp, iff not allowed
+	((wfquant f) (nnfp (a2 f)))
+	((noncomplex-formula f) t)
+	(t nil)))
+
+;; Prove that subst-free preserves nnfp.
+
+(defthm subst-free-preserves-car
+  (equal (car (subst-free f x tm)) (car f)))
+
+(defthm subst-free-preserves-nnfp
+  (implies (nnfp f)
+           (nnfp (subst-free f x tm))))
+
+;; Function cnfp (f) checks if a formula is in conjunctive normal form.
+;; Note the handling of quantified formulas: the superformula treats
+;; it as an atomic formula, and the subformula must be cnfp.
+
+(defun cnfp (f)
+  (declare (xargs :guard t))
+  (cond ((noncomplex-formula f) t)
+	((wfnot f) (noncomplex-formula (a1 f)))
+	((wfbinary f)
+	 (cond ((wfor f) (and (cnfp (a1 f))
+			      (cnfp (a2 f))
+			      (not (wfand (a1 f)))
+			      (not (wfand (a2 f)))))
+	       ((wfand f) (and (cnfp (a1 f))
+			       (cnfp (a2 f))))
+	       (t nil))) ; imp, iff not allowed
+	((wfquant f) (cnfp (a2 f)))
+	(t nil)))
+
+;; Prove that subst-free preserves cnfp.
+
+(defthm subst-free-preserves-cnfp
+  (implies (cnfp f)
+           (cnfp (subst-free f x tm))))
+
+;; Prove that cnfp formulas are always nnfp.
+
+(defthm cnfp-nnfp
+  (implies (cnfp f) (nnfp f)))
+
+(in-theory (disable cnfp-nnfp))
+
+;;----------------------
+;; Universal-prefix-nnf means that there is a sequence of universal
+;; quantifiers at the top, and the rest of the formula is quantifier-free nnf.
+;; The other functions are analogous.
+
+(defun universal-prefix-nnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfall f) (universal-prefix-nnf (a2 f)))
+	(t (and (nnfp f) (quantifier-free f)))))
+
+(defun universal-prefix-cnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfall f) (universal-prefix-cnf (a2 f)))
+	(t (and (cnfp f) (quantifier-free f)))))
+
+(defun quant-prefix-nnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfquant f) (quant-prefix-nnf (a2 f)))
+	(t (and (nnfp f) (quantifier-free f)))))
+
+(defun quant-prefix-cnf (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfquant f) (quant-prefix-cnf (a2 f)))
+	(t (and (cnfp f) (quantifier-free f)))))
+
+;;------------------------------------------------------------
+;; Right-assoc-p checks if all of the conjunctions and disjunctions
+;; are right associated.
+
+(defun right-assoc-p (f)  ;; no 'and has and 'and as left child; same for 'or.
+  (declare (xargs :guard (and (wff f))))
+  (cond ((wfand f) (and (not (wfand (a1 f)))
+			(right-assoc-p (a1 f))
+			(right-assoc-p (a2 f))))
+	((wfor f) (and (not (wfor (a1 f)))
+		       (right-assoc-p (a1 f))
+		       (right-assoc-p (a2 f))))
+	((wfbinary f) (and (right-assoc-p (a1 f))
+			   (right-assoc-p (a2 f))))
+	((wfnot f) (right-assoc-p (a1 f)))
+	((wfquant f) (right-assoc-p (a2 f)))
+	(t t)))
+
+;;------------------------------------------------------------
+;; Acceptable input for Skolemization.
+
+(defun funcs-in-term-list (l)
+  (declare (xargs :guard (wft-list l)
+		  :verify-guards nil))
+  (if (atom l)
+      nil
+      (union-equal (cond ((domain-term (car l)) nil)
+			 ((variable-term (car l)) nil)
+			 ((wf-ap-term-top (car l))
+			  (union-equal (list (caar l))
+				       (funcs-in-term-list (cdar l))))
+			 (t nil)) ;; non-term
+		   (funcs-in-term-list (cdr l)))))
+
+(defthm true-listp-funcs-in-term-list ; for verifying guards
+  (true-listp (funcs-in-term-list l)))
+
+(verify-guards funcs-in-term-list)
+
+(defun funcs-in-formula (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfnot f) (funcs-in-formula (a1 f)))
+	((wfbinary f) (union-equal (funcs-in-formula (a1 f))
+				   (funcs-in-formula (a2 f))))
+	((wfquant f) (funcs-in-formula (a2 f)))
+	((wfatomtop f) (funcs-in-term-list (cdr f)))
+	(t nil)))
+
+(defthm true-listp-funcs-in-formula
+  (true-listp (funcs-in-formula f)))
+
+(defun ok-for-skolem (f)
+  (declare (xargs :guard (wff f)))
+  (and (nnfp f)
+       (not (free-vars f))
+       (setp (quantified-vars f))))
+
+;; Skolemization should produce a formula without existential quantifiers.
+
+(defun exists-count (f)
+  (declare (xargs :guard (wff f)))
+  (cond ((wfnot f)    (exists-count (a1 f)))
+        ((wfbinary f) (+ (exists-count (a1 f)) (exists-count (a2 f))))
+        ((wfexists f) (+ 1 (exists-count (a2 f))))
+        ((wfall f)    (exists-count (a2 f)))
+        (t 0)))
+
+;;--------------------
+;; odds and ends
+
+(defthm quant-free-cnf-is-universal-prefix-cnf
+  (implies (and (cnfp f)
+		(quantifier-free f))
+	   (universal-prefix-cnf f))
+  :hints (("Goal"
+	   :induct (universal-prefix-cnf f))))
+
+(defthm universal-prefix-exists-free
+  (implies (and (quant-prefix-nnf f)
+		(equal (exists-count f) 0))
+	   (universal-prefix-nnf f)))
+
+(defthm qfree-remq-quant-prefix-nnf
+  (implies (and (nnfp f)
+		(quantifier-free (remove-leading-quants f)))
+	   (quant-prefix-nnf f))
+  :hints (("Goal"
+	   :induct (quant-prefix-nnf f))))
+
+;;------------------------------------------------------------
+;; Functions (cdrs l) is different from (strip-cdrs l) in that
+;; the argument does not have to be an alistp.  Same for (cdrs l).
+
+(defun cars (l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((atom l) nil)
+	((consp (car l)) (cons (caar l) (cars (cdr l))))
+	(t (cars (cdr l)))))
+
+(defun cdrs (l)
+  (declare (xargs :guard (true-listp l)))
+  (cond ((atom l) nil)
+	((consp (car l)) (cons (cdar l) (cdrs (cdr l))))
+	(t (cdrs (cdr l)))))
+
diff --git a/books/workshops/1999/ivy/ivy-v2/ivy-sources/xeval.lisp b/books/workshops/1999/ivy/ivy-v2/ivy-sources/xeval.lisp
new file mode 100644
index 0000000..4fe36a1
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/ivy-sources/xeval.lisp
@@ -0,0 +1,103 @@
+(in-package "ACL2")
+
+;; This little book contains another evaluation function called xeval.
+;; Xeval is similar to feval/feval-d, but it does not use explicit mutual
+;; recursion.  Also, there is an important difference in the handling
+;; of the domain argument.
+;;
+;; Feval gets a fresh copy of the domain when it STARTS to evaluate
+;; a quantified formula, and xeval restores the domain with a fresh
+;; copy AFTER evaluating a quantified formula.  This difference is
+;; independent of the mutual-nonmutual difference, and I think xeval
+;; would be more useful if it handled domains in the same way as feval.
+;;
+;; As things are, xeval is more convenient for many proofs, because
+;; we don't have to prove a separate theorem for the "flg" case,
+;; and the proofs are quicker.
+;;
+;; However, because of the weird way xeval handles domains, we have
+;; to use feval in some cases.
+;;
+;; Historical Note.  The first evaluation function for this project
+;; (geval) was essentially the same as xeval.  That's why xeval
+;; is so widespread.
+;;
+;; Feval and xeval are proved equal below.
+
+(include-book "base")
+(include-book "../../../../../ordinals/e0-ordinal")
+(set-well-founded-relation e0-ord-<)
+
+(defun xeval (f dom i)
+  (declare (xargs :measure (cons (wff-count f) (acl2-count dom))
+		  :guard (and (wff f)
+			      (domain-term-list (fringe dom))
+			      ;; (not (free-vars f))
+			      (subsetp-equal (fringe dom)
+					     (fringe (domain i))))))
+  (cond ((equal f 'true) t)
+	((equal f 'false) nil)
+	((wfnot f) (not (xeval (a1 f) dom i)))
+	((wfand f) (and (xeval (a1 f) dom i)
+			(xeval (a2 f) dom i)))
+	((wfor  f) (or  (xeval (a1 f) dom i)
+			(xeval (a2 f) dom i)))
+	((wfimp f) (implies (xeval (a1 f) dom i)
+			    (xeval (a2 f) dom i)))
+	((wfiff f) (iff (xeval (a1 f) dom i)
+			(xeval (a2 f) dom i)))
+	((wfquant f)
+	 (cond ((atom dom) (xeval (subst-free (a2 f) (a1 f) dom) (domain i) i))
+	       ((wfall f)    (and (xeval f (car dom) i)
+				  (xeval f (cdr dom) i)))
+	       ((wfexists f) (or  (xeval f (car dom) i)
+				  (xeval f (cdr dom) i)))
+	       (t nil)))
+	(t (eval-atomic f i))))
+
+;; Show that (xeval f (domain i) i) is equal to (feval f dom i)
+
+(defthm xeval-feval-flg
+  (if flg
+      (equal (feval f i)
+	     (xeval f (domain i) i))
+    (implies (wfquant f)
+	     (equal (feval-d f dom i)
+		    (xeval f dom i))))
+  :hints (("Goal"
+           :do-not generalize
+           :induct (feval-i flg f dom i)))
+  :rule-classes nil)
+
+(defthm xeval-feval
+  (equal (feval f i)
+	 (xeval f (domain i) i))
+  :hints (("Goal"
+	   :by (:instance xeval-feval-flg (flg t)))))
+
+(defthm xeval-feval-d
+  (implies (wfquant f)
+	   (equal (feval-d f dom i)
+		  (xeval f dom i)))
+  :hints (("Goal"
+	   :by (:instance xeval-feval-flg (flg nil)))))
+
+(in-theory (disable xeval-feval xeval-feval-d))
+
+;; This is the induction scheme to use with xeval.
+
+(defun xeval-i (f dom i)
+  (declare (xargs :measure (cons (wff-count f) (acl2-count dom))
+		  :guard (and (wff f)
+			      (domain-term-list (fringe dom)))))
+  (cond ((equal f 'true)   'junk)
+	((equal f 'false)  'junk)
+	((wfnot f) (xeval-i (a1 f) dom i))
+
+	((wfbinary f) (cons (xeval-i (a1 f) dom i)
+			    (xeval-i (a2 f) dom i)))
+	((wfquant f) (if (atom dom)
+			 (xeval-i (subst-free (a2 f) (a1 f) dom) (domain i) i)
+		       (cons (xeval-i f (car dom) i)
+			     (xeval-i f (cdr dom) i))))
+	(t 'junk)))
diff --git a/books/workshops/1999/ivy/ivy-v2/mace-1.3.4.tar.gz b/books/workshops/1999/ivy/ivy-v2/mace-1.3.4.tar.gz
new file mode 100644
index 0000000..d06c979
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/mace-1.3.4.tar.gz
diff --git a/books/workshops/1999/ivy/ivy-v2/otter-3.0.6.tar.gz b/books/workshops/1999/ivy/ivy-v2/otter-3.0.6.tar.gz
new file mode 100644
index 0000000..7419b26
--- /dev/null
+++ b/books/workshops/1999/ivy/ivy-v2/otter-3.0.6.tar.gz